Latin Square

Author

Eric W. Weisstein
March 2, 2024

This notebook downloaded from http://mathworld.wolfram.com/notebooks/Combinatorics/LatinSquare.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/LatinSquare.html.

©2024 Wolfram Research, Inc. except for portions noted otherwise

Code

LatinSquareQ[l_List?MatrixQ]:=SameQ@@Flatten[{{Range[Length[l]]},Sort/@l,Sort/@Transpose[l]},1]
LatinRectangleQ[l_List?MatrixQ]:=Length[Union[Flatten[l]]]==Dimensions[l][[2]]&&And@@Flatten[Map[UniqueElementsQ,{l,Transpose[l]},{2}]]
NormalQ[l_List?MatrixQ]:=SameQ[First[l],First[Transpose[l]],Range[Length[l]]]
HalfNormalQ[l_List?MatrixQ]:=First[l]===Range[Length[l]]
FixedDiagonalQ[l_List?MatrixQ]:=Tr[l,List]===Table[1,{Length[l]}]
OrthogonalQ[l_List?MatrixQ,m_List?MatrixQ]:=UniqueElementsQ[Flatten[MapThread[List,{l,m},2],1]]

UniqueElementsQ[l_List]:=Equal@@(Length/@{l,Union[l]})

Simple but highly inefficient:

LatinSquares0[n_Integer?Positive]:=Select[Tuples[Permutations[Range[n]],n],LatinSquareQ]
NormalizedLatinSquares[n_?Positive]:=Select[Prepend[#,Range[n]]&/@Tuples[Rest[Permutations[Range[n]]],n-1],First[Transpose[#]]==Range[n]&&LatinSquareQ[#]&]

Latin square code adapted from
Rolh, J.S.  Recursion via Pascal.  Cambridge, England: Cambridge University Press, pp. 162–165, 1984.
by Hans Michel
2 Aug 2000

LatinSquares1[n_Integer?Positive]:=LatinSquares[n]=Module[{s,ss,l={},i,j},
s=Table[j,{i,n},{j,n}];
ss=Table[{},{i,n}];
Choose[ro_,cl_]:=Module[{e1,e2,i},e1=s[[ro,cl]];
For[i=cl,i≤n,i++,e2=s[[ro,i]];
If[!MemberQ[ss[[cl]],e2],s[[ro,cl]]=e2;s[[ro,i]]=e1;AppendTo[ss[[cl]],e2];
If[cl≠n,Choose[ro,cl+1],If[ro≠n,Choose[ro+1,1],AppendTo[l,s]];
];(*End If cl not eq n*)
s[[ro,i]]=e2;ss[[cl]]=DeleteCases[ss[[cl]],e2];
];(*End If Member*)
];
(*End For*)
s[[ro,cl]]=e1;
];
Choose[1,1];
l
]

LatinSquares[n_]:=ResourceFunction["FindProperColorings"][RookGraph[n,n],n]

Counts

A002860

BFileSequence[002860]

Do[Print[{n,Length[LatinSquares[n]]//Timing}],{n,5}]

Do[Print[{n,Length[LatinSquares1[n]]//Timing}],{n,5}]

Do[Print[{n,Length[LatinSquares0[n]]//Timing}],{n,4}]

Graphic

g2=GraphicsGrid[Partition[With[{g=RookGraph[2,2]},VertexColoredGraph[g,#,VertexSize->Small]&/@ResourceFunction["FindProperColorings"][g,2]],UpTo[6]]]

g3=GraphicsGrid[Partition[With[{g=RookGraph[3,3]},VertexColoredGraph[g,#,VertexSize->Medium]&/@ResourceFunction["FindProperColorings"][g,3]],UpTo[6]]]

Column[Show[#,ImageSize->{400}]&/@{g2,g3}]

Graphs

RecognizeGraph/@Table[LatinSquareGraph[n,n],{n,10}]

Enumeration

2×2

MatrixForm/@LatinSquares[2]

LatinRectangleQ/@LatinSquares[2]

3×3

{LatinSquaresInefficient[3];//Timing,LatinSquares[3];//Timing}

Equal@@Sort/@{LatinSquares[3],LatinSquaresInefficient[3]}

MatrixForm/@LatinSquares[3]

LatinRectangleQ/@LatinSquares[3]

4×4

MatrixForm/@LatinSquares[4]

Normalized Latin Squares

MapIndexed[#1  #2!(#2-1)!&,{1,1,1,4,56,9408}]//Flatten

Table[Count[LatinSquares[n],_?NormalQ],{n,4}]//Timing

Table[Count[NormalizedLatinSquares[n],_?NormalQ],{n,4}]//Timing

Table[Count[NormalizedLatinSquares[n],_?NormalQ],{n,5}]//Timing

...out of memory...

Table[Count[LatinSquares[n],_?NormalQ],{n,5}]//Timing

MatrixForm/@NormalizedLatinSquares[4]

l={1,1,1,4,56,9408,16942080,535281401856,377597570964258816,7580721483160132811489280,5363937773277371298119673540771840};

ListPlot[Log[l],PlotJoined->True,PlotStyle->Red]

Orthogonal  Latin Squares

OrthogonalLatinSquaresQ[
{{3,2,1},{2,1,3},{1,3,2}},
{{2,3,1},{1,2,3},{3,1,2}}
]

Table[Length@Select[Subsets[LatinSquares[n],{2}],OrthogonalQ@@#&],{n,4}]//Timing

Table[Length@Select[Subsets[LatinSquares[n],{2}],OrthogonalQ@@#&],{n,5}]//Timing

Subsets[Range[161280],{2}];//Timing

((161280!)/(2!(161280-2)!))

Developer`$MaxMachineInteger

Fixed Diagonal Latin Squares = Half Normal Latin Squares

Fixed Diagonal

Count[#,_?FixedDiagonalQ]&/@LatinSquares/@Range[5]//Timing

The number of fixed diagonal Latin squares is the same as the number of Latin squares with first row {1, ..., n}.

MatrixForm/@(l1=Select[LatinSquares[4],FixedDiagonalQ])

Half Normal

Count[#,_?HalfNormalQ]&/@LatinSquares/@Range[5]//Timing

MatrixForm/@(l2=Select[LatinSquares[4],HalfNormalQ])