Générer un carré gréco-latin

24

Avertissement: je ne connais aucune solution non bruteforce

Un carré gréco-latin est, pour deux ensembles de même longueur , un arrangement de cellules, chacune contenant une paire unique (sur l'ensemble du carré) d'un élément du premier ensemble et d'un élément du deuxième ensemble, de telle sorte que tous les premiers éléments et tous les seconds éléments des paires sont uniques dans leur ligne et leur colonne. Les ensembles les plus couramment utilisés sont, comme on pourrait le deviner, les premières lettres des alphabets grec et latin.nn×nn

Voici une photo d'un carré gréco-latin 4x4:entrez la description de l'image ici

Les carrés gréco-latins sont aussi utiles qu'ils le paraissent ( l'article de Wikipédia mentionne "la conception d'expériences, la programmation de tournois et la construction de carrés magiques"). Votre tâche est, étant donné un entier positif n , de générer un carré gréco-latin n×n .

Contribution

Un entier positif n>2 ; il est garanti qu'il existe carré gréco-latin (c'est-à-dire ).n×nn6

Sortie

Un carré gréco-latin de longueur latérale n sous forme de tableau à deux dimensions, un tableau de tableaux, un tableau aplati ou directement émis.

Remarques

  • Vous n'êtes pas obligé d'utiliser spécifiquement les alphabets grec et latin; par exemple, la sortie de paires d'entiers positifs est également autorisée.
  • Si vous choisissez d'utiliser un alphabet qui ne peut pas être étendu arbitrairement, vous devez (théoriquement; votre code n'a pas à se terminer avant la mort thermique de l'univers) supporter une longueur de côté maximale d'au moins 20.

C'est le , donc le code le plus court gagne!

mon pronom est monicareinstate
la source
Lien Sandbox
mon pronom est monicareinstate
Doit-on sortir un seul carré, ou est-ce correct de sortir tous les carrés possibles sous forme de liste?
Nick Kennedy

Réponses:

2

Gelée ,  21  20 octets

-1 grâce à Nick Kennedy (l'option de sortie plate permet une sauvegarde d'octets de ż"þ`ẎẎQƑ$Ƈ F€p`Z€QƑƇ )

Œ!ṗ⁸Z€Q€ƑƇF€p`Z€QƑƇḢ

Essayez-le en ligne! (Trop lent pour4dans les années 60 sur TIO, mais si nous remplaçons la puissance cartésienne, avec des combinaisonsœc, cela se terminera - bien que 5 ne le sera certainement pas!)

Comment?

Œ!ṗ⁸Z€Q€ƑƇF€p`Z€QƑƇḢ - Link: integer, n
Œ!                   - all permutations of [1..n]
   ⁸                 - chain's left argument, n
  ṗ                  - Cartesian power (that is, all ways to pick n of those permutations, with replacement, not ignoring order)
    Z€               - transpose each
         Ƈ           - filter, keeping those for which:
        Ƒ            -   invariant under:
      Q€             -     de-duplicate each
          F€         - flatten each  
             `       - use this as both arguments of:
            p        -   Cartesian product
              Z€     - transpose each
                  Ƈ  - filter, keeping those for which:
                 Ƒ   -   invariant under:   
                Q    -     de-duplicate (i.e. contains all the possible pairs)
                   Ḣ - head (just one of the Latin-Greaco squares we've found)
Jonathan Allan
la source
Voici un 20 . À l'origine, j'ai écrit cela indépendamment du vôtre, mais j'ai fini par quelque chose de assez similaire, puis je me suis inspiré de votre utilisation du pouvoir cartésien à la place d'une dyade de permutation, il est donc probablement préférable de l'utiliser pour améliorer le vôtre. Notez que vous avez mal orthographié Graeco dans votre explication.
Nick Kennedy
Merci Nick, je n'ai pas remarqué que nous étions autorisés à sortir une version aplatie.
Jonathan Allan
3

05AB1E , 26 23 22 octets

-3 octets grâce à Emigna

-1 octet grâce à Kevin Cruijssen

Lãœ.ΔIôDζ«D€í«ε€нÙgQ}P

Essayez-le en ligne!

Grimmy
la source
1
n<ÝI‰peut être<Ýã
Emigna
... et peut l'être L. Merci!
Grimmy
1
ê}DIùQpeut être ÙgQ}Pde sauvegarder un octet.
Kevin Cruijssen
@KevinCruijssen merci! Je l'ai édité.
Grimmy
3

R , 164 148 octets

-de nombreux octets grâce à Giuseppe.

n=scan()
`!`=function(x)sd(colSums(2^x))
m=function()matrix(sample(n,n^2,1),n)
while(T)T=!(l=m())|!(g=m())|!t(l)|!t(g)|1-all(1:n^2%in%(n*l+g-n))
l
g

Essayez-le en ligne!

Dramatiquement inefficace - je pense que c'est encore pire que les autres approches par force brute. Même pour n=3, il s'arrêtera probablement sur TIO. Voici une version alternative (155 octets) qui fonctionne n=3en environ 1 seconde.

m1nnlg

  1. all(1:n^2%in%(n*l+g-n))n2l × g
  2. sont let gcarrés latins?

!nlg2^l2n+12lt(l)lgsdn=0n=1

Une dernière note: comme souvent en R code golf, j'ai utilisé la variable T, qui est initialisée comme TRUE, pour gagner quelques octets. Mais cela signifie que lorsque j'ai eu besoin de la valeur réelle TRUEdans la définition de m(paramètre replacedans sample), j'ai dû utiliser à la 1place de T. De même, comme je redéfinis !comme une fonction différente de la négation, j'ai dû utiliser à la 1-all(...)place de !all(...).

Robin Ryder
la source
2

JavaScript (ES6),  159 147  140 octets

n×n

Il s'agit d'une simple recherche par force brute, et donc très lente.

n=>(g=(m,j=0,X=n*n)=>j<n*n?!X--||m.some(([x,y],i)=>(X==x)+(Y==y)>(j/n^i/n&&j%n!=i%n),g(m,j,X),Y=X/n|0,X%=n)?o:g([...m,[X,Y]],j+1):o=m)(o=[])

Essayez-le en ligne! (avec sortie prettifiée)

Commenté

n => (                      // n = input
  g = (                     // g is the recursive search function taking:
    m,                      //   m[] = flattened matrix
    j = 0,                  //   j   = current position in m[]
    X = n * n               //   X   = counter used to compute the current pair
  ) =>                      //
    j < n * n ?             // if j is less than n²:
      !X-- ||               //   abort right away if X is equal to 0; decrement X
      m.some(([x, y], i) => //   for each pair [x, y] at position i in m[]:
        (X == x) +          //     yield 1 if X is equal to x OR Y is equal to y
        (Y == y)            //     yield 2 if both values are equal
                            //     or yield 0 otherwise
        >                   //     test whether the above result is greater than:
        ( j / n ^ i / n &&  //       - 1 if i and j are neither on the same row
          j % n != i % n    //         nor the same column
        ),                  //       - 0 otherwise
                            //     initialization of some():
        g(m, j, X),         //       do a recursive call with all parameters unchanged
        Y = X / n | 0,      //       start with Y = floor(X / n)
        X %= n              //       and X = X % n
      ) ?                   //   end of some(); if it's falsy (or X was equal to 0):
        o                   //     just return o[]
      :                     //   else:
        g(                  //     do a recursive call:
          [...m, [X, Y]],   //       append [X, Y] to m[]
          j + 1             //       increment j
        )                   //     end of recursive call
    :                       // else:
      o = m                 //   success: update o[] to m[]
)(o = [])                   // initial call to g with m = o = []
Arnauld
la source
144 ? (Sur mon téléphone, donc pas tout à fait sûr que cela fonctionne)
Shaggy
Je ne pense pas que vous ayez besoin onon plus; vous pouvez simplement revenir mà la fin pour 141
Shaggy
n=5
2

Haskell , 207 143 233 octets

(p,q)!(a,b)=p/=a&&q/=b
e=filter
f n|l<-[1..n]=head$0#[(c,k)|c<-l,k<-l]$[]where
	((i,j)%p)m|j==n=[[]]|1>0=[q:r|q<-p,all(q!)[m!!a!!j|a<-[0..i-1]],r<-(i,j+1)%e(q!)p$m]
	(i#p)m|i==n=[[]]|1>0=[r:o|r<-(i,0)%p$m,o<-(i+1)#e(`notElem`r)p$r:m]

Essayez-le en ligne!

OK, je pense que j'ai finalement compris cette fois. Cela fonctionne très bien pour n = 5, n = 6 fois sur TIO mais je pense que cela pourrait être juste parce que ce nouvel algorithme est INCROYABLEMENT inefficace et vérifie essentiellement toutes les possibilités jusqu'à ce qu'il en trouve une qui fonctionne. J'exécute n = 6 sur mon ordinateur portable maintenant pour voir s'il se termine avec un peu plus de temps.

Merci encore à @someone d'avoir signalé les bugs dans mes versions précédentes

user1472751
la source
1
Je ne connais pas Haskell, mais cela semble me déranger lorsque je change le "4" dans le pied de page en 5. Suis-je en train d'invoquer cela correctement?
mon pronom est monicareinstate
@someone Bonne prise, j'aurais dû tester ça.Je ne sais pas vraiment ce qui ne va pas ici, cela peut prendre un certain temps à déboguer
user1472751
1
Je pense que cela a encore un bug; lorsqu'il est exécuté pour n = 5, le tuple (1,1) apparaît deux fois.
mon pronom est monicareinstate
@someone Man, ce problème est beaucoup plus difficile que je ne le pensais. Je ne peux tout simplement pas trouver un moyen fiable de bloquer toutes les contraintes à la fois. Dès que je me concentre les uns sur les autres, on me échappe. Je vais marquer comme non compétitif pour l'instant jusqu'à ce que je puisse trouver un peu plus de temps pour y travailler. Désolé de ne pas avoir testé aussi complètement que j'aurais dû
user1472751
1

C #, 520 506 494 484 octets

class P{static void Main(string[]a){int n=int.Parse(a[0]);int[,,]m=new int[n,n,2];int i=n,j,k,p,I,J;R:for(;i-->0;)for(j=n;j-->0;)for(k=2;k-->0;)if((m[i,j,k]=(m[i,j,k]+ 1) % n)!=0)goto Q;Q:for(i=n;i-->0;)for(j=n;j-->0;){for(k=2;k-->0;)for(p=n;p-->0;)if(p!=i&&m[i,j,k]==m[p,j,k]||p!=j&&m[i,j,k]==m[i,p,k])goto R;for(I=i;I<n;I++)for(J=0;J<n;J++)if(I!=i&&J!=j&&m[i,j,0]==m[I,J,0]&&m[i,j,1]==m[I,J,1])goto R;}for(i=n;i-->0;)for(j=n;j-->0;)System.Console.Write(m[i,j,0]+"-"+m[i,j,1]+" ");}}

L'algorithme de recherche d'un carré est très simple. C'est ... bruteforce. Ouais, c'est stupide, mais le golf de code ne concerne pas la vitesse d'un programme, non?

Le code avant de le raccourcir:

using System;

public class Program
{
    static int[,,] Next(int[,,] m, int n){
        for (int i = 0; i < n; i++)
        {
            for (int j = 0; j < n; j++)
            {
                for (int k = 0; k < 2; k++)
                {
                    if ((m[i, j, k] = (m[i, j, k] + 1) % n) != 0)
                    {
                        return m;
                    }
                }
            }
        }
        return m;
    }
    static bool Check(int[,,] m, int n)
    {
        for (int i = 0; i < n; i++)
        {
            for (int j = 0; j < n; j++)
            {
                for (int k = 0; k < 2; k++)
                {
                    for (int p = 0; p < n; p++)
                    {
                        if (p != i)
                            if (m[i, j, k] == m[p, j, k])
                                return false;
                    }
                    for (int p = 0; p < n; p++)
                    {
                        if (p != j)
                            if (m[i, j, k] == m[i, p, k])
                                return false;
                    }
                }
            }
        }

        for (int i_1 = 0; i_1 < n; i_1++)
        {
            for (int j_1 = 0; j_1 < n; j_1++)
            {
                int i_2 = i_1;
                for (int j_2 = j_1 + 1; j_2 < n; j_2++)
                {
                    if (m[i_1, j_1, 0] == m[i_2, j_2, 0] && m[i_1, j_1, 1] == m[i_2, j_2, 1])
                        return false;
                }
                for (i_2 = i_1 + 1; i_2 < n; i_2++)
                {
                    for (int j_2 = 0; j_2 < n; j_2++)
                    {
                        if (m[i_1, j_1, 0] == m[i_2, j_2, 0] && m[i_1, j_1, 1] == m[i_2, j_2, 1])
                            return false;
                    }
                }
            }
        }
        return true;
    }
    public static void Main()
    {
        int n = 3;
        Console.WriteLine(n);
        int maxi = (int)System.Math.Pow((double)n, (double)n*n*2);
        int[,,] m = new int[n, n, 2];
        Debug(m, n);
        do
        {
            m = Next(m, n);
            if (m == null)
            {
                Console.WriteLine("!");
                return;
            }
            Console.WriteLine(maxi--);
        } while (!Check(m, n));


        Debug(m, n);
    }

    static void Debug(int[,,] m, int n)
    {
        for (int i = 0; i < n; i++)
        {
            for (int j = 0; j < n; j++)
            {
                Console.Write(m[i, j, 0] + "-" + m[i, j, 1] + " ");
            }
            Console.WriteLine();
        }
        Console.WriteLine();
    }
}

Maintenant, si vous voulez le tester avec n = 3, vous devrez attendre environ une heure, alors voici une autre version:

public static void Main()
{
    int n = 3;
    Console.WriteLine(n);
    int maxi = (int)System.Math.Pow((double)n, (double)n*n*2);        
    int[,,] result = new int[n, n, 2];
    Parallel.For(0, n, (I) =>
    {
        int[,,] m = new int[n, n, 2];
        for (int i = 0; i < n; i++)
            for (int j = 0; j < n; j++)
            {
                m[i, j, 0] = I;
                m[i, j, 1] = I;
            }
        while (true)
        {
            m = Next(m, n);
            if (Equals(m, n, I + 1))
            {
                break;
            }
            if (Check(m, n))
            {
                Debug(m, n);
            }
        }
    });
}

Mise à jour: oublié de supprimer "public".

Mise à jour: utilisé "Système". au lieu de "utiliser System;"; Merci également à Kevin Cruijssen d'avoir utilisé "a" au lieu de "args".

Mise à jour: merci à gastropner et à quelqu'un .

ettudagny
la source
argspeut être a:)
Kevin Cruijssen
Chaque boucle for pourrait être transformée de for(X = 0; X < Y; X++)en for(X = Y; X-->0; ), ce qui devrait économiser un octet par boucle.
gastropner
1
Avez-vous essayé le compilateur interactif Visual C # ? Il peut économiser des octets. Vous pouvez également soumettre une fonction anonyme. Vous pouvez également affecter i = 0et définir iun octet.
mon pronom est monicareinstate
405 octets basés sur la suggestion de @ quelqu'un. Bien sûr, il expire après 60 secondes sur TIO, mais il enregistre des octets en utilisant un lambda et le compilateur interactif avec implicite System. , Aussi if((m[i,j,k]=(m[i,j,k]+ 1) % n)!=0)peut être if((m[i,j,k]=-~m[i,j,k]%n)>0).
Kevin Cruijssen
@Kevin Je n'ai pas vraiment envie de lire ce code en essayant de le jouer au golf. Êtes-vous sûr que la partie d'impression fonctionne correctement? Il semble qu'il devrait utiliser Writeou pourrait économiser des octets en ajoutant \nà la chaîne à l'intérieur de l'appel ou est autrement cassé. Je pense que vous pouvez également retourner un tableau directement.
mon pronom est monicareinstate
1

Octave , 182 octets

Méthode de la force brute, TIO continue de temporiser et j'ai dû l'exécuter plusieurs fois pour obtenir une sortie pour n = 3, mais théoriquement, cela devrait être bien. Au lieu de paires comme (1,2), il produit une matrice de conjugués complexes comme 1 + 2i. Cela pourrait étirer un peu la règle, mais à mon avis, cela correspond toujours aux exigences de sortie. Il doit y avoir un meilleur moyen de faire les deux lignes sous la déclaration functino, mais je ne suis pas sûr pour le moment.

function[c]=f(n)
c=[0,0]
while(numel(c)>length(unique(c))||range([imag(sum(c)),imag(sum(c.')),real(sum(c)),real(sum(c.'))])>0)
a=fix(rand(n,n)*n);b=fix(rand(n,n)*n);c=a+1i*b;
end
end

Essayez-le en ligne!

OrangeCherries
la source
0

Wolfram Language (Mathematica) , 123 octets

P=Permutations
T=Transpose
g:=#&@@Select[T[Intersection[x=P[P@Range@#,{#}],T/@x]~Tuples~2,2<->4],DuplicateFreeQ[Join@@#]&]&

Essayez-le en ligne!

J'utilise la TwoWayRulenotationTranspose[...,2<->4] pour permuter les 2e et 4e dimensions d'un tableau; sinon, c'est assez simple.

Non golfé:

(* get all n-tuples of permutations *)
semiLSqs[n_] := Permutations@Range@n // Permutations[#, {n}] &;

(* Keep only the Latin squares *)
LSqs[n_] := semiLSqs[n] // Intersection[#, Transpose /@ #] &;

isGLSq[a_] := Join @@ a // DeleteDuplicates@# == # &;

(* Generate Graeco-Latin Squares from all pairs of Latin squares *)
GLSqs[n_] := 
  Tuples[LSqs[n], 2] // Transpose[#, 2 <-> 4] & // Select[isGLSq];
lirtosiast
la source
0

Python 3 , 271 267 241 octets

Approche par force brute: générer toutes les permutations des paires jusqu'à ce qu'un carré gréco-latin soit trouvé. Trop lent pour générer quelque chose de plus grand quen=3 sur TIO.

Merci à alexz02 pour avoir joué au golf 26 octets et à plafond pour jouer au golf 4 octets.

Essayez-le en ligne!

from itertools import*
def f(n):
 s=range(n);l=len
 for r in permutations(product(s,s)):
  if all([l({x[0]for x in r[i*n:-~i*n]})*l({x[1]for x in r[i*n:-~i*n]})*l({r[j*n+i][0]for j in s})*l({r[j*n+i][1]for j in s})==n**4for i in s]):return r

Explication:

from itertools import *  # We will be using itertools.permutations and itertools.product
def f(n):  # Function taking the side length as a parameter
 s = range(n)  # Generate all the numbers from 0 to n-1
 l = len  # Shortcut to compute size of sets
 for r in permutations(product(s, s)):  # Generate all permutations of all pairs (Cartesian product) of those numbers, for each permutation:
  if all([l({x[0] for x in r[i * n : (- ~ i) * n]})  # If the first number is unique in row i ...
        * l({x[1] for x in r[i * n:(- ~ i) * n]})  # ... and the second number is unique in row i ...
        * l({r[j * n + i][0] for j in s})  # ... and the first number is unique in column i ...
        * l({r[j * n + i][1] for j in s})  # ... and the second number is unique in column i ...
        == n ** 4 for i in s]):  # ... in all columns i:
   return r  # Return the square
OOBalance
la source
-26 octets
alexz02