|
=={{header|Factor}}==
A brute force method for generating uniformly random Latin squares. Select a random permutation of (0, 1,...n-1) and add it as the next row of the square. If at any point the rules for being a Latin square are violated, start the entire process over again from the beginning.
The initial approach is simple: generate a random permutation, one row at a time. If a row conflicts with any of the rows above it, generate a new random permutation for that row. The upside is that this is easy to understand and generates uniformly-random Latin squares. The downside is that it is an exponential time algorithm.
<lang factor>USING: arrays combinators.extras fry io kernel locals math math.matrices prettyprint▼
prettyprint random sequences sets vectors ; ▼
If larger sizes are desired, non-uniform approaches may be used. The Koscielny product is one such approach that "multiplies" two Latin squares together to produce a larger one. The algorithm is described [https://www.academia.edu/29890346/Comparison_of_Seven_Techniques_for_Generating_Random_Latin_Squares here]. The two initial order-5 squares are multiplied using this method to produce an order-25 square.
▲<lang factor>USING: arrays io kernel locals math math.matrices prettyprint
▲random sequences sets vectors ;
IN: rosetta-code.random-latin-squares
: rand-permutation ( n [-- seq ) <iota> >array randomize 1vector ] [;▼
: add-row ( matrix -- matrix' )
: ls? ( n -- ? ) [ all-unique? ] column-map t [ and ] reduce ;
dup last clone suffix!
: (ls) ( n [-- m ) dup '[ all-unique?_ ] columnrand-map [ f =permutation ] any?replicate ];
: ls ( n [-- [m length) 1dup -(ls) ]dup [ls? [ [ randomizenip ] change-nth[ ]drop keepls ] biif ];
: random-latin-squares ( -- ) [ 5 ls simple-table. nl ] twice ;▼ while ;
! Small optimization: there is only 1 choice for the last row.
: add-last-row ( matrix -- matrix' )
dup dim second <iota> over [ diff first ] with column-map
suffix! ;
: last-row? ( matrix -- ? ) dim first2 = ;
: latin ( n -- matrix )
▲ [ <iota> >array randomize 1vector ] [
1 - [ dup last-row? [ add-last-row ] [ add-row ] if ]
times
] bi ;
:: koscielny-product ( ls1 ls2 -- prod )
ls1 ls2 [ dim first ] bi@ :> ( n1 n2 )
n1 n2 [ sq ] bi@ zero-matrix :> prod
n1 n2 * <iota> [
:> i n1 n2 * <iota> [
:> j
n2 i n2 /i j n2 /i ls1 nth nth *
i n2 mod j n2 mod ls2 nth nth +
{ i j } prod set-index
] each
] each prod ;
▲: random-latin-squares ( -- )
"Random Latin squares via \"restarting row\" method:"
print 5 5 [ latin dup simple-table. nl ] bi@
"Koscielny product of previous squares:" print
koscielny-product simple-table. ;
MAIN: random-latin-squares</lang>
{{out}}
<pre>
Random Latin squares via "restarting row" method:
2 4 1 3 0
3 0 2 1 4
4 3 0 2 1 3 0
1 2 1 4 0 3
1 3 0 4 2
Koscielny product of previous squares:
7 5 8 9 6 17 15 18 19 16 12 10 13 14 11 22 20 23 24 21 2 0 3 4 1
9 6 5 8 7 19 16 15 18 17 14 11 10 13 12 24 21 20 23 22 4 1 0 3 2
6 8 7 5 9 16 18 17 15 19 11 13 12 10 14 21 23 22 20 24 1 3 2 0 4
8 9 6 7 5 18 19 16 17 15 13 14 11 12 10 23 24 21 22 20 3 4 1 2 0
5 7 9 6 8 15 17 19 16 18 10 12 14 11 13 20 22 24 21 23 0 2 4 1 3
2 0 3 4 1 12 10 13 14 11 22 20 23 24 21 17 15 18 19 16 7 5 8 9 6
4 1 0 3 2 14 11 10 13 12 24 21 20 23 22 19 16 15 18 17 9 6 5 8 7
1 3 2 0 4 11 13 12 10 14 21 23 22 20 24 16 18 17 15 19 6 8 7 5 9
3 4 1 2 0 13 14 11 12 10 23 24 21 22 20 18 19 16 17 15 8 9 6 7 5
0 2 4 1 3 10 12 14 11 13 20 22 24 21 23 15 17 19 16 18 5 7 9 6 8
12 10 13 14 11 22 20 23 24 21 7 5 8 9 6 2 0 3 4 1 17 15 18 19 16
14 11 10 13 12 24 21 20 23 22 9 6 5 8 7 4 1 0 3 2 19 16 15 18 17
11 13 12 10 14 21 23 22 20 24 6 8 7 5 9 1 3 2 0 4 16 18 17 15 19
13 14 11 12 10 23 24 21 22 20 8 9 6 7 5 3 4 1 2 0 18 19 16 17 15
10 12 14 11 13 20 22 24 21 23 5 7 9 6 8 0 2 4 1 3 15 17 19 16 18
17 15 18 19 16 7 5 8 9 6 2 0 3 4 1 12 10 13 14 11 22 20 23 24 21
19 16 15 18 17 9 6 5 8 7 4 1 0 3 2 14 11 10 13 12 24 21 20 23 22
16 18 17 15 19 6 8 7 5 9 1 3 2 0 4 11 13 12 10 14 21 23 22 20 24
18 19 16 17 15 8 9 6 7 5 3 4 1 2 0 13 14 11 12 10 23 24 21 22 20
15 17 19 16 18 5 7 9 6 8 0 2 4 1 3 10 12 14 11 13 20 22 24 21 23
22 20 23 24 21 2 0 3 4 1 17 15 18 19 16 7 5 8 9 6 12 10 13 14 11
24 21 20 23 22 4 1 0 3 2 19 16 15 18 17 9 6 5 8 7 14 11 10 13 12
21 23 22 20 24 1 3 2 0 4 16 18 17 15 19 6 8 7 5 9 11 13 12 10 14
23 24 21 22 20 3 4 1 2 0 18 19 16 17 15 8 9 6 7 5 13 14 11 12 10
20 22 24 21 23 0 2 4 1 3 15 17 19 16 18 5 7 9 6 8 10 12 14 11 13
</pre>
|