Random Latin squares: Difference between revisions
added RPL
m (→{{header|jq}}: uses) |
(added RPL) |
||
| (17 intermediate revisions by 6 users not shown) | |||
Line 2:
A Latin square of size <code>n</code> is an arrangement of <code>n</code> symbols in an <code>n-by-n</code> square in such a way that each row and column has each symbol appearing exactly once.<br>
For the purposes of this task, a random Latin square of size <code>n</code> is a Latin square constructed or generated by a probabilistic procedure such that the probability of any particular Latin square of size <code>n</code> being produced is non-zero.
;Example n=4 randomised Latin square:
Line 15:
;Note:
Strict ''
;Related tasks:
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#}}==
This solution uses functions from [[Factorial_base_numbers_indexing_permutations_of_a_collection#F.23]] and [[Latin_Squares_in_reduced_form#F.23]].
<syntaxhighlight lang="fsharp">
// Generate 2 Random Latin Squares of order 5. Nigel Galloway: July 136th., 2019
Line 823 ⟶ 1,011:
=={{header|Factor}}==
A brute force method for generating
<syntaxhighlight lang="factor">USING: arrays combinators.extras fry io kernel math.matrices
prettyprint random sequences sets ;
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,561 ⟶ 1,828:
'''Also works with gojq, the Go implementation of jq.'''
This entry presents two jq programs for generating Latin Squares of order n
(LS(n)) in accordance with the requirements.
The first program uses a "brute-force" algorithm (with simple optimizations) to
generate Latin Squares of order n as though drawing with
replacement from the population of all such Latin Squares.
The chi-squared statistics show good agreement
with the theoretical uniformity.
The second program uses a much faster algorithm for generating Latin Squares
in accordance with the requirements, but with bias away from
uniformity, as also illustrated by chi-squared statistics.
Both algorithms use /dev/random as a source of entropy. They also
both use the Knuth shuffle to generate the first row, and rely on
backtracking using the jq idiom:
`first( repeat( _) )`
The first algorithm incrementally adds rows, backtracking to the
point immediately after the selection of the first row. For n larger
than about 4, this algorithm is quite slow, though in a fairly predictable way.
The second algorithm incrementally adds cells, backtracking to the
last cell. It is much faster but the running time can be quite
variable, as suggested by this table:
<pre>
n Typical range of u+s times on 3GHz machine
10 0.11 to 0.14 s
15 0.15 to 0.21 s
20 0.36 to 0.94 s
30 0.5 to 29 seconds
40 80 seconds to 21 minutes
45 8 to 39 minutes
</pre>
An interesting variant of the second algorithm can be obtained by
a trivial modification of just one line (see the comment with "n.b."):
backtracking to the last full row is slightly faster while maintaining
randomness, at the cost of a greater departure from uniform
randomness, as confirmed by these two runs using the same `stats`
function as defined in the first program.
<pre>
# Using `ext` (i.e., backtrack to point after selection of first row)
Number of LS(4): 5760
Of 576 possibilities, only 575 were generated.
Chi-squared statistic (df=575): 2128.6
# u+s 5.5s
# Using `extend` (i.e. backtrack to point of most recent row extension - faster but more biased)
Number of LS(4): 5760
All 576 possibilities have been generated.
Chi-squared statistic (df=575): 3055.8
# u+s 4.7s
</pre>
<syntaxhighlight lang=sh>
#!/bin/bash
< /dev/random tr -cd '0-9' | fold -w 1 |
</syntaxhighlight>
=== Common Functions ===
<syntaxhighlight lang=sh>
'''Generic Utility Functions'''
# For inclusion using jq's `include` directive:
# Output: a PRN in range(0;$n) where $n is .
def prn:
Line 1,609 ⟶ 1,918:
def lpad($len): tostring | ($len - length) as $l | (" " * $l)[:$l] + .;
# If the input array is not rectangular, let nulls fall where they may
def column($j):
[.[] | .[$j]];
# Emit a stream of [value, frequency] pairs
def histogram(stream):
reduce stream as $s ({};
($s|type) as $t
| (if $t == "string" then $s else ($s|tojson) end) as $y
| .[$t][$y][0] = $s
| .[$t][$y][1] += 1 )
| .[][] ;
def ss(s): reduce s as $x (0; . + ($x * $x));
def chiSquared($expected): ss( .[] - $expected ) / $expected;
</syntaxhighlight>
===Latin Squares selected at random uniformly===
<syntaxhighlight lang=sh>
# Include the utilities e.g. by
# include "random-latin-squares.utilities" {search: "."};
# Determine orthogonality of two arrays, confining attention
# to the first $n elements in each:
def orthogonal($a; $b; $n):
first( (range(0; $n) | if $a[.] == $b[.] then 0 else empty end) // 1) | . == 1;
# Are the two arrays orthogonal up to the length of the shorter?
def orthogonal($a; $b):
([$a, $b | length] | min) as $min
| orthogonal($a; $b; $min);
# Is row $i orthogonal to all the previous rows?
def orthogonal($i):
. as $in
| .[$i] as $row
| all(range(0;$i); orthogonal($row; $in[.]));
# verify columnwise orthogonality
def columnwise:
length as $n
| transpose as $t
| all( range(1;$n); . as $i | $t | orthogonal($i)) ;
def addLast:
(.[0] | length) as $n
| [range(0; $n)] as $range
| [range(0; $n) as $i
| ($range - column($i))[0] ] as $last
| . + [$last] ;
# input: an array being a permutation of [range(0;$n)] for some $n
# output: a Latin Square selected at random from all the candidates
def extend:
(.[0] | length) as $n
| if length >= $n then .
elif length == $n - 1 then addLast
else ([range(0; $n)] | knuthShuffle) as $row
| (. + [$row] )
| if orthogonal(length - 1) and columnwise then extend else empty end
end ;
# Generate a Latin Square.
# The input should be an integer specifying its size.
def latinSquare:
. as $n
| if $n <= 0 then []
else
[ [range(0; $n)] | knuthShuffle]
| first(repeat(extend))
# | (if columnwise then . else debug end) # internal check
end ;
# If the input is a positive integer, $n, generate and print an $n x $n Latin Square.
# If it is not number, echo it.
def printLatinSquare:
if type == "number"
then latinSquare
| .[] | map(lpad(3)) | join(" ")
else .
end;
# $order should be in 1 .. 5 inclusive
# If $n is null, then use 10 * $counts[$order]
def stats($order; $n):
# table of counts:
[0,1,2,12,576,161280] as $counts
| $counts[$order] as $possibilities
| (if $n then $n else 10 * $possibilities end) as $n
| reduce range(0;$n) as $i ({};
($order|latinSquare|flatten|join("")) as $row
| .[$row] += 1)
| # ([histogram(.[])] | sort[] | join(" ")),
"Number of LS(\($order)): \($n)",
(if length == $possibilities
then "All \($possibilities) possibilities have been generated."
else "Of \($possibilities) possibilities, only \(length) were generated."
end),
"Chi-squared statistic (df=\($possibilities-1)): \( [.[]] | chiSquared( $n / $possibilities))";
stats(3;null), "",
stats(4;5760), ""
stats(4;5760)
</syntaxhighlight>
{{output}}
<pre>
Number of LS(3): 120
All 12 possibilities have been generated.
Chi-squared statistic (df=11): 18.8
Number of LS(4): 5760
All 576 possibilities have been generated.
Chi-squared statistic (df=575): 572.2
Number of LS(4): 5760
All 576 possibilities have been generated.
Chi-squared statistic (df=575): 517.2
</pre>
=== Random Latin Squares ===
This is the (much) faster program that meets the task
requirements while deviating from uniform randomness
as suggested by the Chi-squared statistics presented in the preamble.
<syntaxhighlight lang=sh>
# Include the utilities e.g. by
# include "random-latin-squares.utilities" {search: "."};
# Select an element at random from [range(0;$n)] - column($j)
Line 1,637 ⟶ 2,071:
# if we can complete the row, then there is no need for another backtrack point!
| if $cl == 1 and ($last|length) == $n - 1
then ($good + [ $last + $candidates]) |
else
if $cl == 1 then ($good + [ $last + $candidates]) | ext
Line 2,805 ⟶ 3,239:
4 10 9 0 3 7 2 5 1 11 6 8
0 6 11 9 1 3 5 10 2 7 8 4</pre>
=={{header|Quackery}}==
<code>transpose</code> is defined at [[Matrix transposition#Quackery]].
<syntaxhighlight lang="Quackery"> [ [] []
rot times
[ i join ]
dup size times
[ tuck
nested join
swap
behead join ]
drop
shuffle
transpose
shuffle ] is rls ( n --> [ )
2 times
[ 5 rls
witheach
[ witheach
[ echo sp ]
cr ]
cr ]</syntaxhighlight>
{{out}}
<pre>2 4 0 1 3
0 2 3 4 1
1 3 4 0 2
4 1 2 3 0
3 0 1 2 4
1 2 3 0 4
3 4 0 2 1
2 3 4 1 0
0 1 2 4 3
4 0 1 3 2
</pre>
=={{header|Raku}}==
Line 3,278 ⟶ 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,319 ⟶ 3,818:
{{trans|Go}}
===Restarting Row method===
<syntaxhighlight lang="
var rand = Random.new()
Line 3,411 ⟶ 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()
| |||