Random Latin squares: Difference between revisions
added RPL
(→{{header|jq}}: add algorithm for uniform distribution) |
(added RPL) |
||
| (6 intermediate revisions by 5 users not shown) | |||
Line 238:
1 2 0 3 4
0 4 2 1 3
</pre>
=={{header|ALGOL 68}}==
{{Trans|Nim}}
Uses the Knuth Shuffle routine from the Algol 68 sample in the Knuth Shuffle task - modified to shuffle a row in a CHAR matrix.
<br>
Generating largish squares can take some time...
<syntaxhighlight lang="algol68">
BEGIN # generate random latin squares #
# Knuth Shuffle routine from the Knuth Shuffle Task #
# modified to shufflw a row of a [,]CHAR array #
PROC knuth shuffle = (REF[,]CHAR a, INT row)VOID:
(
PROC between = (INT a, b)INT :
(
ENTIER (random * ABS (b-a+1) + (a<b|a|b))
);
FOR i FROM LWB a TO UPB a DO
INT j = between(LWB a, UPB a);
CHAR t = a[row, i];
a[row, i] := a[row, j];
a[row, j] := t
OD
);
# generates a random latin square #
PROC latin square = ( INT n )[,]CHAR:
BEGIN
[ 1 : n ]CHAR letters;
[ 1 : n, 1 : n ]CHAR result;
FOR col TO n DO
letters[ col ] := REPR ( ABS "A" + ( col - 1 ) )
OD;
FOR row TO n DO
result[ row, : ] := letters
OD;
knuth shuffle( result, 1 );
FOR row FROM 2 TO n - 1 DO
BOOL ok := FALSE;
WHILE
knuth shuffle( result, row );
BOOL all different := TRUE;
FOR prev TO row - 1 WHILE all different DO
FOR col TO n
WHILE all different :=
result[ row, col ] /= result[ prev, col ]
DO SKIP OD
OD;
NOT all different
DO SKIP OD
OD;
# the final row, there is only one possibility for each column #
FOR col TO n DO
[ 1 : n ]CHAR free := letters;
FOR row TO n - 1 DO
free[ ( ABS result[ row, col ] - ABS "A" ) + 1 ] := REPR 0
OD;
BOOL found := FALSE;
FOR row FROM 1 LWB result TO 1 UPB result WHILE NOT found DO
IF free[ row ] /= REPR 0 THEN
found := TRUE;
result[ n, col ] := free[ row ]
FI
OD
OD;
result
END # latin suare # ;
# prints a latin square #
PROC print square = ( [,]CHAR square )VOID:
FOR row FROM 1 LWB square TO 1 UPB square DO
IF 2 LWB square <= 2 UPB square THEN
print( ( square[ row, 2 LWB square ] ) );
FOR col FROM 2 LWB square + 1 TO 2 UPB square DO
print( ( " ", square[ row, col ] ) )
OD;
print( ( newline ) )
FI
OD # print square # ;
next random;
print square( latin square( 5 ) );
print( ( newline ) );
print square( latin square( 5 ) );
print( ( newline ) );
print square( latin square( 10 ) )
END
</syntaxhighlight>
{{out}}
<pre>
A C D B E
C A B E D
D E A C B
E B C D A
B D E A C
A B E C D
B E D A C
E C B D A
D A C E B
C D A B E
A C D J F G I B E H
D F H G E A B J C I
H E C I B J A F G D
B I G A C H J D F E
E J I F H C D G B A
I D B C G F H E A J
C H F B J I E A D G
G B J D A E F I H C
J G A E D B C H I F
F A E H I D G C J B
</pre>
Line 774 ⟶ 888:
[7, 0, 6, 2, 5, 4, 3, 8, 1, 9]
[9, 7, 5, 4, 1, 3, 0, 6, 2, 8]</pre>
=={{header|EasyLang}}==
{{trans|Kotlin}}
<syntaxhighlight>
proc shuffle . a[] .
for i = len a[] downto 2
r = randint i
swap a[r] a[i]
.
.
proc prsquare . lat[][] .
n = len lat[][]
for i to n
for j to n
write lat[i][j] & " "
.
print ""
.
print ""
.
proc square n . .
for i to n
lat[][] &= [ ]
for j to n
lat[i][] &= j
.
.
shuffle lat[1][]
for i = 2 to n - 1
repeat
shuffle lat[i][]
for k to i - 1
for j to n
if lat[k][j] = lat[i][j]
break 2
.
.
.
until k = i
.
.
len used0[] n
for j to n
used[] = used0[]
for i to n - 1
used[lat[i][j]] = 1
.
for k to n
if used[k] = 0
lat[n][j] = k
break 1
.
.
.
prsquare lat[][]
.
square 5
square 5
</syntaxhighlight>
{{out}}
<pre>
1 5 4 2 3
3 4 2 1 5
2 1 5 3 4
5 3 1 4 2
4 2 3 5 1
3 5 1 4 2
2 1 4 3 5
5 2 3 1 4
4 3 2 5 1
1 4 5 2 3
</pre>
=={{header|F_Sharp|F#}}==
Line 849 ⟶ 1,037:
3 1 2 4 0
</pre>
=={{header|FreeBASIC}}==
{{trans|Wren}}
====Restarting Row method====
<syntaxhighlight lang="vbnet">Randomize Timer
Sub printSquare(latin() As Integer, n As Integer)
For i As Integer = 0 To n - 1
Print "[";
For j As Integer = 0 To n - 1
Print latin(i, j); ",";
Next j
Print Chr(8); " ]"
Next i
Print
End Sub
Sub latinSquare(n As Integer)
Dim As Integer i, j, k
If n <= 0 Then
Print "[]"
Exit Sub
End If
Dim latin(n - 1, n - 1) As Integer
For i = 0 To n - 1
For j = 0 To n - 1
latin(i, j) = j
Next j
Next i
' first row
For i = 0 To n - 1
Dim j As Integer = Int(Rnd * n)
Swap latin(0, i), latin(0, j)
Next i
' middle row(s)
For i = 1 To n - 2
Dim shuffled As Integer = 0
While shuffled = 0
For j = 0 To n - 1
Dim k As Integer = Int(Rnd * n)
Swap latin(i, j), latin(i, k)
Next j
shuffled = 1
For k As Integer = 0 To i - 1
For j = 0 To n - 1
If latin(k, j) = latin(i, j) Then
shuffled = 0
Exit For
End If
Next j
If shuffled = 0 Then Exit For
Next k
Wend
Next i
' last row
For j = 0 To n - 1
Dim used(n - 1) As Integer
For i = 0 To n - 2
used(latin(i, j)) = 1
Next i
For k = 0 To n - 1
If used(k) = 0 Then
latin(n - 1, j) = k
Exit For
End If
Next k
Next j
printSquare(latin(), n)
End Sub
latinSquare(5)
latinSquare(5)
latinSquare(10) ' for good measure
Sleep</syntaxhighlight>
=={{header|Go}}==
Line 1,670 ⟶ 1,937:
</syntaxhighlight>
===
<syntaxhighlight lang=sh>
# Include the utilities e.g. by
Line 1,727 ⟶ 1,994:
# If the input is a positive integer, $n, generate and print an $n x $n Latin Square.
#
def printLatinSquare:
if type == "number"
Line 1,758 ⟶ 2,025:
stats(4;5760)
</syntaxhighlight>
{{output}}
<pre>
Line 3,486 ⟶ 3,752:
[https://www.mediafire.com/file/6fruvfgydnbmtyj/RandomLatinSquares.jpg/file Random Latin Squares - image]
=={{header|RPL}}==
{{trans|Quackery}}
{{works with|RPL|HP49-C}}
<code>SHUFL</code> is defined at [[Knuth shuffle#RPL|Knuth shuffle]]
« → n
« « k » 'k' 0 n 1 - 1 SEQ
2 n '''START'''
DUP TAIL LASTARG HEAD +
'''NEXT'''
n →LIST
<span style="color:blue">SHUFL</span> AXL
TRAN AXL
<span style="color:blue">SHUFL</span> AXL
» '<span style="color:blue">RLS</span>' STO
5 <span style="color:blue">RLS</span>
{{out}}
<pre>
1: [[ 3 1 4 2 0 ]
[ 4 2 0 3 1 ]
[ 2 0 3 1 4 ]
[ 0 3 1 4 2 ]
[ 1 4 2 0 3 ]]
</pre>
=={{header|Ruby}}==
Line 3,527 ⟶ 3,818:
{{trans|Go}}
===Restarting Row method===
<syntaxhighlight lang="
var rand = Random.new()
Line 3,619 ⟶ 3,910:
{{libheader|Wren-fmt}}
{{libheader|Wren-math}}
<syntaxhighlight lang="
import "./sort" for Sort
import "./fmt" for Fmt
import "./math" for Int
var rand = Random.new()
| |||