^{Descargo de responsabilidad: no conozco ninguna solución que no sea de fuerza bruta}

Un cuadrado greco-latino es, para dos conjuntos de la misma longitud $n$ , una disposición de celdas $n \times n$ , cada una de las cuales contiene un par único (en todo el cuadrado) de un elemento del primer conjunto y un elemento del segundo conjunto, como que todos los primeros elementos y todos los segundos elementos de los pares son únicos en su fila y columna. Los conjuntos más comunes utilizados son, como se podría adivinar, las primeras letras de los alfabetos griego y latino.$n$

Aquí hay una foto de un cuadrado greco-latino 4x4:

Los cuadrados greco-latinos son tan útiles como parecen (el artículo de Wikipedia menciona "diseño de experimentos, programación de torneos y construcción de cuadrados mágicos"). Su tarea es, dado un entero positivo , generar un cuadrado greco-latino.$n$$n\times n$

Entrada

Un entero positivo ; se garantiza que existe un cuadrado greco-latino (es decir, ).$n > 2$$n\times n$$n \ne 6$

Salida

Un cuadrado greco-latino con longitud lateral n como una matriz bidimensional, una matriz de matrices, una matriz aplanada o con salida directa.

Notas

• No tiene que usar los alfabetos griego y latino específicamente; por ejemplo, también se permite generar pares de enteros positivos.
• Si elige usar un alfabeto que no se puede extender arbitrariamente, debe (en teoría; su código no tiene que terminar antes de la muerte por calor del universo) admitir una longitud lateral máxima de al menos 20.

Este es el código de golf , por lo que gana el código más corto.

Jalea ,  21  20 bytes

-1 gracias a Nick Kennedy (la opción de salida plana permite guardar un byte de ż"þ`ẎẎQƑ$Ƈ $\rightarrow$ F€p`Z€QƑƇ )

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

Pruébalo en línea! (Demasiado lento para los460 en TIO, pero si reemplazamos el poder cartesianoṗ, con Combinacionesœc, se completará , ¡aunque 5 ciertamente no lo harán!)

¿Cómo?

Œ!ṗ⁸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)

05AB1E , 26 23 22 bytes

-3 bytes gracias a Emigna

-1 byte gracias a Kevin Cruijssen

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

Pruébalo en línea!

R , 164148 bytes

-muchos bytes gracias a 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

Pruébalo en línea!

Dramáticamente ineficiente: creo que es aún peor que otros enfoques de fuerza bruta. Incluso para n=3, probablemente caducará en TIO. Aquí hay una versión alternativa (155 bytes) que funciona n=3en aproximadamente 1 segundo.

m$1$$n$$n$lg

1. all(1:n^2%in%(n*l+g-n))$n^2$l $\times$ g
2. son ly gcuadrados latinos?

!$n$lg2^l$2^{n+1}-2$lt(l)lgsd$n=0$$n=1$

Una nota final: con tanta frecuencia en el golf de código R, utilicé la variable T, que se inicializa como TRUE, para ganar algunos bytes. Pero esto significa que cuando necesitaba el valor real TRUEen la definición de m(parámetro replaceen sample), tenía que usar en 1lugar de T. Del mismo modo, como estoy redefiniendo !como una función diferente de la negación, tuve que usar en 1-all(...)lugar de !all(...).

JavaScript (ES6),  159 147  140 bytes

$n\times n$

Esta es una simple búsqueda de fuerza bruta, y por lo tanto muy lenta.

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=[])

Pruébalo en línea! (con salida prettified)

Comentado

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 = []

Haskell , 207 143 233 bytes

(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]

Pruébalo en línea!

OK, creo que finalmente lo entendí esta vez. Funciona bien para n = 5, n = 6 veces en TIO, pero creo que eso podría deberse a que este nuevo algoritmo es INCREÍBLEMENTE ineficiente y básicamente verifica todas las posibilidades hasta que encuentre uno que funcione. Estoy ejecutando n = 6 en mi computadora portátil ahora para ver si termina con algo más de tiempo.

Gracias de nuevo a @someone por señalar los errores en mis versiones anteriores

C #, 520 506 494 484 bytes

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]+" ");}}

El algoritmo de encontrar un cuadrado es muy simple. Es ... fuerza bruta. Sí, es estúpido, pero el código de golf no se trata de la velocidad de un programa, ¿verdad?

El código antes de hacerlo más corto:

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();
    }
}

Ahora, si quieres probarlo con n = 3, tendrás que esperar como una hora, así que aquí hay otra versión:

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);
            }
        }
    });
}

Actualización: olvidé eliminar "público".

Actualización: utiliza "Sistema". en lugar de "usar el sistema"; Además, gracias a Kevin Cruijssen , usó "a" en lugar de "args".

Actualización: gracias a gastropner y alguien .

Octava , 182 bytes

Método de fuerza bruta, TIO mantiene el tiempo de espera y tuve que ejecutarlo varias veces para obtener la salida para n = 3, pero en teoría esto debería estar bien. En lugar de pares como (1,2), genera una matriz de conjugados complejos como 1 + 2i. Esto podría estar estirando un poco la regla, pero en mi opinión, todavía se ajusta a los requisitos de salida. Sin embargo, debe haber una mejor manera de hacer las dos líneas bajo la declaración de functino, pero no estoy seguro en este momento.

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

Pruébalo en línea!

Wolfram Language (Mathematica) , 123 bytes

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

Pruébalo en línea!

Utilizo la TwoWayRulenotación Transpose[...,2<->4]para intercambiar las dimensiones segunda y cuarta de una matriz; de lo contrario, esto es bastante sencillo.

Sin 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];

Python 3 , 271 267 241 bytes

Enfoque de fuerza bruta: genere todas las permutaciones de los pares hasta que se encuentre un cuadrado greco-latino. Demasiado lento para generar algo más grande que n=3en TIO.

Gracias a alexz02 por jugar al golf 26 bytes y a ceilingcat por jugar al golf 4 bytes.

Pruébalo en línea!

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

Explicación:

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