Anonymous user
Random Latin squares: Difference between revisions
Pascal implementation of Jacobson-Matthews algorithm.
(Pascal implementation of Jacobson-Matthews algorithm.) |
|||
Line 1,954:
J A I C G B D H E F
E G F D C J B A H I</pre>
=={{header|Pascal}}==
Jacobson-Matthews algorithm. Generates uniformly distributed random Latin squares (if used PRNG is good - Delphi/Pascal built-in PRNG is '''not''').
Slightly modified translation of C code from https://brainwagon.org/2016/05/17/code-for-generating-a-random-latin-square/
Algorithm source:
Jacobson, M. T.; Matthews, P. (1996). "Generating uniformly distributed random latin squares". Journal of Combinatorial Designs. 4 (6): 405–437.
<lang pascal>
{$APPTYPE CONSOLE}
const
Alpha = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
Type
IncidenceCube = Array of Array Of Array of Integer;
Var
Cube : IncidenceCube;
DIM : Integer;
Procedure InitIncidenceCube(Var c:IncidenceCube; const Size:Integer);
var i, j, k : integer;
begin
DIM := Size;
SetLength(c,DIM,DIM,DIM);
for i := 0 to DIM-1 do
for j := 0 to DIM-1 do
for k := 0 to DIM-1 do c[i,j,k] := 0 ;
for i := 0 to DIM-1 do
for j := 0 to DIM-1 do c[i,j,(i+j) mod DIM] := 1;
end;
Procedure FreeIncidenceCube(Var c:IncidenceCube);
begin
Finalize(c);
end;
procedure PrintIncidenceCube(var c:IncidenceCube);
var i, j, k : integer;
begin
for i := 0 to DIM-1 do begin
for j := 0 to DIM-1 do begin
for k := 0 to DIM-1 do begin
if (c[i,j,k]=1) then begin
write(Alpha[k+1],' ');
break;
end;
end;
end;
Writeln;
end;
Writeln;
WriteLn;
end;
procedure ShuffleIncidenceCube(var c:IncidenceCube);
var i, j, rx, ry, rz, ox, oy, oz : integer;
begin
for i := 0 to (DIM*DIM*DIM)-1 do begin
repeat
rx := Random(DIM);
ry := Random(DIM);
rz := Random(DIM);
until (c[rx,ry,rz]=0);
for j := 0 to DIM-1 do begin
if (c[j,ry,rz]=1) then ox := j;
if (c[rx,j,rz]=1) then oy := j;
if (c[rx,ry,j]=1) then oz := j;
end;
Inc(c[rx,ry,rz]);
Inc(c[rx,oy,oz]);
Inc(c[ox,ry,oz]);
Inc(c[ox,oy,rz]);
Dec(c[rx,ry,oz]);
Dec(c[rx,oy,rz]);
Dec(c[ox,ry,rz]);
Dec(c[ox,oy,oz]);
while (c[ox,oy,oz] < 0) do begin
rx := ox ;
ry := oy ;
rz := oz ;
if (random(2)=0) then begin
for j := 0 to DIM-1 do begin
if (c[j,ry,rz]=1) then ox := j;
end;
end else begin
for j := DIM-1 downto 0 do begin
if (c[j,ry,rz]=1) then ox := j;
end;
end;
if (random(2)=0) then begin
for j := 0 to DIM-1 do begin
if (c[rx,j,rz]=1) then oy := j;
end;
end else begin
for j := DIM-1 downto 0 do begin
if (c[rx,j,rz]=1) then oy := j;
end;
end;
if (random(2)=0) then begin
for j := 0 to DIM-1 do begin
if (c[rx,ry,j]=1) then oz := j;
end;
end else begin
for j := DIM-1 downto 0 do begin
if (c[rx,ry,j]=1) then oz := j;
end;
end;
Inc(c[rx,ry,rz]);
Inc(c[rx,oy,oz]);
Inc(c[ox,ry,oz]);
Inc(c[ox,oy,rz]);
Dec(c[rx,ry,oz]);
Dec(c[rx,oy,rz]);
Dec(c[ox,ry,rz]);
Dec(c[ox,oy,oz]);
end;
end;
end;
begin
Randomize;
InitIncidenceCube(cube, 5); ShuffleIncidenceCube(cube); PrintIncidenceCube(cube); FreeIncidenceCube(Cube);
InitIncidenceCube(cube, 5); ShuffleIncidenceCube(cube); PrintIncidenceCube(cube); FreeIncidenceCube(Cube);
InitIncidenceCube(cube,10); ShuffleIncidenceCube(cube); PrintIncidenceCube(cube); FreeIncidenceCube(Cube);
InitIncidenceCube(cube,26); ShuffleIncidenceCube(cube); PrintIncidenceCube(cube); FreeIncidenceCube(Cube);
end.
</lang>
{{out}}
<pre>
B A E D C
D B C A E
C D A E B
A E B C D
E C D B A
A C D B E
B E C D A
D A B E C
E D A C B
C B E A D
E F G C D A H B I J
B J A H F D C E G I
F I J A C E G H D B
J A E D G F B I C H
C E D I H G A J B F
I D H E A B F C J G
H G B J E C I D F A
G C F B J I D A H E
D H I F B J E G A C
A B C G I H J F E D
W D X Q V Z S A O T P K C Y M H J L F R U B I E N G
E J R T D G P U C H F Y B Q W V I Z K L S X O N M A
Y E B A W I T J U Z H F N G P L X M R K D Q C V S O
H V F W Y S E P A N X M R O Q K B C L G J U T Z I D
C Y E I G Q D X T S J L U M K B V P Z H N A F O R W
L G J R O X F Q Y K C E W U V S A B D P H N Z I T M
B M G D N F I R Z E L H Q K J U O T V C X Y A P W S
G Z H S U L Q C K X Y V F I A O W J B M P R N T D E
K O W L C T U I P V R A J N S E Z H X D M F G B Q Y
D R A H X C K E W L S N V Z O P F Q Y T G M B J U I
V Q Y O R D G B X U Z T H J E F K S C N I W M A P L
U C M B A R Z F J O T G K X D N P I Q W L S V Y E H
Z F N U T V M H R Q I B S P X D C A W E O L Y G K J
J N D V M B X Z F C G O I S Y R L E P A W T K U H Q
N T L Y S P J O B G D W E C Z I R F U X V H Q M A K
A I C P J H B W Q D E S M R L Z G N T V Y K U F O X
R K S N E W A V L M Q D G H T C Y U I F B O P X J Z
O W I M F K R Y H B A Q X D U T N V G J Z P E S L C
P B T X Q U N L S Y M I O W F J H K E Z A G D C V R
X L U K I E H M N A B Z P V G W D Y S O R C J Q F T
M H Z C K J Y T I F O P D A B X U W N S Q E R L G V
Q S P G H Y O N V W U R A L C M T D J I E Z X K B F
I A O F P M L K D J W U Z E N G Q X H Y T V S R C B
T P K E B A V D G I N X L F R Y S O M Q C J H W Z U
S U V Z L O C G M P K J Y T I Q E R A B F D W H X N
F X Q J Z N W S E R V C T B H A M G O U K I L D Y P
</pre>
=={{header|Perl}}==
| |||