^{Отказ от ответственности: я не знаю ни о каких решениях, не брутфорс}

Греко-латинский квадрат, для двух наборов той же длины , А расположение ячеек, каждая из которых содержит уникальный (по всей площади) пары элемента из первого набора и элемент второго набора, так что все первые элементы и все вторые элементы пар являются уникальными в своих строках и столбцах. Как можно догадаться, наиболее часто используемые наборы - это первые букв греческого и латинского алфавитов.$n$$n \times n$$n$

Вот изображение греко-латинского квадрата 4х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ƑƇḢ

Попробуйте онлайн! (Слишком медленно в течение460-х годов на 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 байта благодаря Emigna

-1 байт благодаря Кевину Круйссену

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

Обновление: забыл удалить "публичный".

Обновление: используется «Система». вместо «использования системы»; Также, благодаря Кевину Круйссену , использовали «а» вместо «args».

Обновление: спасибо гастропнеру и кому-то .

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

Методом грубой силы TIO сохраняет время ожидания, и мне приходилось запускать его несколько раз, чтобы получить результат при n = 3, но теоретически это должно быть хорошо. Вместо пар, подобных (1,2), она выводит матрицу комплексных сопряжений, таких как 1 + 2i. Это может немного растягивать правило, но, на мой взгляд, оно соответствует требованиям к выходу. Должен быть лучший способ сделать две строки в декларации functino, но в данный момент я не уверен.

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

Попробуйте онлайн!

Wolfram Language (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]чтобы поменять 2-е и 4-е измерения массива; в противном случае это довольно просто.

Ungolfed:

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

Подход грубой силы: генерируйте все перестановки пар, пока не будет найден греко-латинский квадрат. Слишком медленно, чтобы генерировать что-то большее, чем n=3на TIO.

Благодаря alexz02 для игры в гольф 26 байт и потолку catcat для игры в гольф 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