^{zrzeczenie się odpowiedzialności: nie znam żadnych rozwiązań innych niż bruteforce}

Kwadrat Graeco-Latin to, dla dwóch zestawów tej samej długości $n$ , układ komórek $n \times n$ , z których każdy zawiera unikalną (przez cały kwadrat) parę elementu pierwszego zestawu i element drugiego zestawu, takie jak że wszystkie pierwsze elementy i wszystkie drugie elementy par są unikalne w swoim rzędzie i kolumnie. Najczęściej stosowanymi zestawami są, jak można się domyślić, pierwsze $n$ liter alfabetu greckiego i łacińskiego.

Oto zdjęcie kwadratu Graeco-Latin 4x4:

Kwadraty grecko-łacińskie są tak przydatne, jak się wydaje ( artykuł w Wikipedii wspomina o „projektowaniu eksperymentów, planowaniu turniejów i konstruowaniu magicznych kwadratów”). Twoim zadaniem jest, biorąc pod uwagę dodatnią liczbę całkowitą , wygenerowanie kwadratu Graeco-Latin.$n$$n\times n$

Wkład

Dodatnia liczba całkowita ; gwarantowane jest istnienie kwadratu grecko-łacińskiego (to znaczy n ≠ 6 ).$n > 2$$n\times n$$n \ne 6$

Wydajność

Kwadrat grecko-łaciński o długości boku n jako tablica dwuwymiarowa, tablica tablic, tablica spłaszczona lub wyprowadzana bezpośrednio.

Notatki

• Nie musisz specjalnie używać alfabetu greckiego i łacińskiego; na przykład dozwolone jest także wyprowadzanie par dodatnich liczb całkowitych.
• Jeśli zdecydujesz się użyć alfabetu, którego nie można dowolnie rozszerzyć, musisz (teoretycznie; twój kod nie musi kończyć się przed śmiercią wszechświata) utrzymywać maksymalną długość boku co najmniej 20.

To jest golf golfowy , więc wygrywa najkrótszy kod!

Galaretka ,  21  20 bajtów

-1 dzięki Nickowi Kennedy'emu (opcja wyjścia płaskiego pozwala na zapis bajtów ż"þ`ẎẎQƑ$Ƈ $\rightarrow$ F€p`Z€QƑƇ )

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

Wypróbuj online! (Zbyt wolno, by4w latach 60. na TIO, ale jeśli zastąpimy moc kartezjańskąṗkombinacjamiœc, to się skończy - chociaż 5 na pewno nie!)

W jaki sposób?

Œ!ṗ⁸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 bajtów

-3 bajty dzięki Emignie

-1 bajt dzięki Kevin Cruijssen

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

Wypróbuj online!

R , 164 148 bajtów

- wiele bajtów dzięki 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

Wypróbuj online!

Dramatycznie nieefektywny - myślę, że jest nawet gorzej niż w przypadku innych brutalnych sił. Nawet jeśli n=3, prawdopodobnie upłynie limit czasu na TIO. Tutaj alternatywna wersja (155 bajtów), która działa przez n=3około 1 sekundę.

Działa przez odrzucenie. Funkcjam$1$$n$$n$lg . Następnie sprawdzamy:

1. all(1:n^2%in%(n*l+g-n))$n^2$l $\times$ g ?
2. są lig łacińskie kwadraty?

!$n$lg2^l$2^{n+1}-2$lt(l)lgsd$n=0$$n=1$ , co jest zgodne z OP.

Ostatnia uwaga: tak często w golfie kodu R używałem zmiennej T, która jest inicjalizowana jako TRUE, aby uzyskać kilka bajtów. Ale to oznacza, że ​​kiedy potrzebowałem rzeczywistej wartości TRUEw definicji m(parametr replacew sample), musiałem użyć 1zamiast T. Podobnie, ponieważ redefiniuję !jako funkcję inną niż negacja, musiałem użyć 1-all(...)zamiast !all(...).

JavaScript (ES6),  159 147  140 bajtów

$n\times n$ par liczb całkowitych nieujemnych.

Jest to proste wyszukiwanie brutalnej siły, a zatem bardzo powolne.

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

Wypróbuj online! (z zachowanym wyjściem)

Skomentował

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 bajty

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

Wypróbuj online!

OK, myślę, że w końcu to dostałem. Działa dobrze dla n = 5, n = 6 razy na TIO, ale myślę, że może tak być, ponieważ ten nowy algorytm jest NIESAMOWICIE nieskuteczny i w zasadzie sprawdza wszystkie możliwości, aż znajdzie taki, który działa. Korzystam teraz z n = 6 na moim laptopie, aby sprawdzić, czy upłynie trochę więcej czasu.

Jeszcze raz dziękuję @someone za wskazanie błędów w moich poprzednich wersjach

C #, 520 506 494 484 bajtów

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

Algorytm znajdowania kwadratu jest bardzo prosty. To jest ... brutalność. Tak, to głupie, ale w golfie kodowym nie chodzi o szybkość programu, prawda?

Kod, zanim zostanie skrócony:

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

Teraz, jeśli chcesz przetestować za pomocą n = 3, musisz poczekać godzinę, więc oto inna wersja:

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

Aktualizacja: zapomniałem usunąć „public”.

Aktualizacja: używany „System”. zamiast „using System;”; Również dzięki Kevin Cruijssen , użyłem „a” zamiast „args”.

Aktualizacja: dzięki gastropnerowi i komuś .

Oktawa , 182 bajty

Metoda Brute Force, TIO utrzymuje limit czasu i musiałem uruchomić go kilka razy, aby uzyskać wynik dla n = 3, ale teoretycznie powinno to być w porządku. Zamiast par takich jak (1,2) generuje macierz złożonych koniugatów, takich jak 1 + 2i. Może to nieco rozciągać regułę, ale moim zdaniem będzie to pasować do wymagań wyjściowych. Musi być jednak lepszy sposób na wykonanie dwóch wierszy w deklaracji funkoino, ale w tej chwili nie jestem pewien.

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

Wypróbuj online!

Wolfram Language (Mathematica) , 123 bajty

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

Wypróbuj online!

Używam TwoWayRulenotacjiTranspose[...,2<->4] aby zamienić drugi i czwarty wymiar tablicy; w przeciwnym razie jest to dość proste.

Nie golfowany:

(* 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 bajtów

Podejście brutalnej siły: Wygeneruj wszystkie kombinacje par, aż do znalezienia kwadratu grecko-łacińskiego. Zbyt wolno, aby wygenerować coś większego niż n=3w TIO.

Dzięki alexz02 za grę w golfa 26 bajtów i pułapkę za grę w golfa 4 bajty.

Wypróbuj online!

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

Wyjaśnienie:

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