^{відмова від відповідальності: мені невідомі будь-які рішення, що не стосуються грубої сили}

Греко-латинський квадрат - це два набори однакової довжини $n$ , $n \times n$ розташування комірок, кожна з яких містить унікальну (по всьому квадрату) пару елемента першого набору та елемент другого набору, наприклад що всі перші елементи та всі другі елементи пар є унікальними у своєму рядку та стовпці. Як можна було здогадатися, найпоширенішими множинами є перші $n$ літери грецького та латинського алфавітів.

Ось малюнок 4-меткового греко-латинського квадрата:

Грако-латинські квадрати настільки ж корисні, як і звучать (у статті у Вікіпедії згадується «дизайн експериментів, планування турніру та побудова магічних квадратів»). Ваше завдання, задане цілим числом $n$ , створити $n\times n$ Греко-латинський квадрат.

Вхідні дані

Додатне ціле число $n > 2$ ; гарантується існування $n\times n$ греко-латинського квадрата (тобто $n \ne 6$ ).

Вихідні дані

Греко-латинський квадрат із довжиною сторони n як двовимірний масив, масив масивів, сплющений масив або виведений безпосередньо.

Примітки

• Вам не потрібно спеціально використовувати грецький та латинський алфавіти; наприклад, дозволено також виведення пар натуральних чисел.
• Якщо ви вирішили використовувати алфавіт, який неможливо розширити довільно, вам доведеться (теоретично, ваш код не повинен закінчуватися до теплової смерті Всесвіту) підтримувати максимальну довжину сторони не менше 20.

Це код-гольф , тому найкоротший код виграє!

Желе ,  21  20 байт

-1 завдяки Ніку Кеннеді (опція плоского виводу дозволяє зберегти байт ż"þ`ẎẎQƑ$Ƈ $\rightarrow$ F€p`Z€QƑƇ )

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

Спробуйте в Інтернеті! (Занадто повільно4в 60-х роках на TIO, але якщо ми замінимо декартову потужністьṗ, на "Комбінації"œc, вона завершиться - хоча 5 точно не буде!)

Як?

Œ!ṗ⁸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 байт

-3 байти завдяки Еміньї

-1 байт завдяки Kevin Cruijssen

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

Спробуйте в Інтернеті!

R , 164 148 байт

-багато байтів завдяки Джузеппе.

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

Спробуйте в Інтернеті!

Вкрай неефективно - я думаю, що це навіть гірше, ніж інші підходи. Навіть для n=3, це, ймовірно, вичерпається на TIO. Ось альтернативна версія (155 байт), яка працює n=3приблизно за 1 секунду.

Працює шляхом відхилення. Функція mмалює випадкову матрицю цілих чисел між $1$ і $n$ (не змушуючи кожне ціле число відображатися точно$n$lg

1. all(1:n^2%in%(n*l+g-n)): чи є $n^2$ різних пар значень уl $\times$ g
2. є lі gлатинські квадрати?

!$n$lg2^l$2^{n+1}-2$lt(l)lgsd$n=0$$n=1$ , що відповідно до ОП.

Остаточне зауваження: як часто в гольф R-коду, я використовував змінну T, ініціалізовану як TRUE, щоб отримати кілька байт. Але це означає, що коли мені потрібно було фактичне значення TRUEу визначенні m(параметр replaceв sample), мені довелося використовувати 1замість T. Так само, оскільки я переосмислюю !функцію, відмінну від заперечення, мені довелося використовувати 1-all(...)замість !all(...).

JavaScript (ES6),  159 147  140 байт

$n\times n$ пар невід’ємних цілих чисел.

Це простий пошук грубої сили, і тому дуже повільний.

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

Спробуйте в Інтернеті!(з попередньо визначеним результатом)

Прокоментував

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 байт

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

Спробуйте в Інтернеті!

Гаразд, я думаю, що цього разу я нарешті дістався. Він працює чудово за n = 5, n = 6 разів на TIO, але я думаю, що це може бути просто тому, що цей новий алгоритм НЕВЕРДАЛЬНО неефективний і в основному перевіряє всі можливості, поки не знайде той, який працює. Я зараз працюю n = 6 на своєму ноутбуці, щоб побачити, чи закінчується це ще деякий час.

Ще раз дякую @someone за вказівку на помилки в моїх попередніх версіях

C #, 520 506 494 484 байт

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

Алгоритм пошуку квадрата дуже простий. Це ... груба сила. Так, це дурно, але код-гольф - це не швидкість програми, правда?

Код перед тим, як скоротити його:

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

Тепер, якщо ви хочете перевірити його з n = 3, вам доведеться почекати як годину, ось ось інша версія:

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

Оновлення: забули видалити "public".

Оновлення: використовується "Система". замість "використання системи;"; Також спасибі Кевіну Крейсейну використано "а" замість "арг".

Оновлення: дякую гастропнеру та комусь .

Октава , 182 байти

Метод грубої сили, TIO вимикає тайм-аут, і мені довелося запустити це купу разів, щоб отримати вихід за n = 3, але теоретично це повинно бути добре. Замість пар типу (1,2) він виводить матрицю складних кон'югатів типу 1 + 2i. Це може трохи розтягнути правило, але, на мій погляд, воно відповідає вимогам виходу. Має бути кращий спосіб зробити два рядки під декларацією функтино, але на даний момент я не впевнений.

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

Спробуйте в Інтернеті!

Мова Вольфрама (Mathematica) , 123 байти

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

Спробуйте в Інтернеті!

Я використовую TwoWayRuleпозначенняTranspose[...,2<->4] для заміни другого та четвертого розмірів масиву; інакше це досить просто.

Безголівки:

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

Пітон 3 , 271 267 241 байт

Підхід грубої сили: генеруйте всі перестановки пар, поки не знайдеться греко-латинський квадрат. Надто повільно, щоб створювати щось більше, ніж n=3у TIO.

Завдяки alexz02 для гри в гольф 26 байтів і до стельової кішки для гри в гольф 4 байти.

Спробуйте в Інтернеті!

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

Пояснення:

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