Randomizing using Jacobson and Matthews' technique

# 20210729 Raku programming solution 

#!/usr/bin/env raku

sub makeCube(\from, Int \n) {  
   my @c = [[[ 0 xx n ] xx n ] xx n ]; 
   from.Bool ?? do race for ^n X ^n -> (\i,\j) { @c[i;j; { from[i;j]-1 } ] = 1 }
             !! do race for ^n X ^n -> (\i,\j) { @c[i;j; {   (i+j)%n   } ] = 1 }
   return @c                   
}

sub shuffleCube(@c) {
   my ($rx, $ry, $rz); my \n = +@c; my Bool \proper = $ = True;

   repeat { ($rx ,$ry, $rz) = (^n).roll: 3 } until @c[$rx;$ry;$rz] == 0;
   loop { 
      my ($ox, $oy, $oz); 
      for ^n { last if @c[ $ox = $_ ;$ry;$rz] == 1 }
      if !proper and (^3).roll==0 { 
         for $ox^…^n { last if @c[ $ox = $_ ;$ry;$rz] == 1 } 
      }
      for ^n { last if @c[$rx; $oy = $_ ;$rz] == 1 }
      if !proper and (^3).roll==0 {
         for $oy^…^n { last if @c[$rx; $oy = $_ ;$rz] == 1 }
      } 
      for ^n { last if @c[$rx;$ry;  $oz = $_ ] == 1 }
      if !proper and (^3).roll==0 {
         for $oz^…^n { last if @c[$rx;$ry; $oz = $_ ] == 1 }
      }

      (@c[$rx;$ry;$rz],@c[$rx;$oy;$oz],@c[$ox;$ry;$oz],@c[$ox;$oy;$rz]) »+=»1;
      (@c[$rx;$ry;$oz],@c[$rx;$oy;$rz],@c[$ox;$ry;$rz],@c[$ox;$oy;$oz]) »-=»1; 
      
      @c[$ox;$oy;$oz] < 0 ?? (($rx,$ry,$rz) = ($ox,$oy,$oz)) !! last ;
      proper = False 
   }        
}

sub toMatrix(@c) {
   my \n = +@c;  
   my @m = [[0 xx n] xx n]; 
   for ^n X ^n -> (\i,\j) { 
      for ^n -> \k { if @c[i;j;k] != 0 { @m[i;j] = k and last } }
   }
   return @m
}

sub toReduced(@m is copy) { 
   my \n = +@m; 
   for 0…(n-2) -> \j {
      if ( @m[0;j] != j ) { 
         for j^…^n -> \k {
            if ( @m[0;k] == j ) { 
               for 0…^n -> \i { (@m[i;j], @m[i;k]) = (@m[i;k], @m[i;j]) }
               last 
            } 
         } 
      } 
   }   
   for 1…(n-2) -> \i {
      if ( @m[i;0] != i ) {
         for i^…^n -> \k { 
            if ( @m[k;0] == i ) { 
               for 0…^n -> \j { (@m[i;j], @m[k;j]) = (@m[k;j], @m[i;j]) }     
               last      
            }
         }
      } 
   } 
   return @m
}

sub printAs1based { say ($_ »+» 1).Str for @_.rotor: @_.elems.sqrt }

my (%freq, @c, @in);

say "Part 1: 10,000 latin Squares of order 4 in reduced form:\n";
@in = [[1, 2, 3, 4], [2, 1, 4, 3], [3, 4, 1, 2], [4, 3, 2, 1]];
@c = makeCube(@in, 4); 
for ^10_000 {
   shuffleCube @c ; 
   %freq{@c.&toMatrix.&toReduced».List.flat.Str}++
}    
for %freq.kv -> $k, $v { 
   printAs1based $k.split(' ');   
   say "\nOccurs $v times.\n"
}

say "Part 2: 10,000 latin Squares of order 5 in reduced form:\n";
@in = [ [1,2,3,4,5], [2,3,4,5,1], [3,4,5,1,2], [4,5,1,2,3], [5,1,2,3,4] ];
%freq = ();
@c = makeCube(@in, 5);
for ^10_000 { 
   shuffleCube @c ; 
   %freq{@c.&toMatrix.&toReduced».List.flat.Str}++ 
}
for %freq.values.kv -> $i, $j { printf "%2d(%3d)%s", $i+1, $j, ' ' }

say "\n\nPart 3: 750 latin squares of order 42, showing the last one:\n";
@c = makeCube([], 42); # (1..42).pick(*)
( for ^750 { shuffleCube @c } ) and printAs1based @c.&toMatrix».List.flat ;

say "\nPart 4: 100 latin squares of order 256:\n";
my $snapshot = now;
@c = makeCube([], 256);
for ^100 { shuffleCube @c } # without hyper, will do only 100 cycles 
say "Generated in { now - $snapshot } seconds."

Output:

Part 1: 10,000 latin Squares of order 4 in reduced form:

1 2 3 4
2 1 4 3
3 4 1 2
4 3 2 1

Occurs 2442 times.

1 2 3 4
2 4 1 3
3 1 4 2
4 3 2 1

Occurs 2705 times.

1 2 3 4
2 3 4 1
3 4 1 2
4 1 2 3

Occurs 2548 times.

1 2 3 4
2 1 4 3
3 4 2 1
4 3 1 2

Occurs 2305 times.

Part 2: 10,000 latin Squares of order 5 in reduced form:

 1(210)  2(191)  3(186)  4(158)  5(219)  6(164)  7(147)  8(160)  9(196) 10(188) 11(193) 12(168) 13(195) 14(173) 15(151) 16(184) 17(211) 18(171) 19(185) 20(155) 21(157) 22(191) 23(195) 24(177) 25(157) 26(191) 27(165) 28(178) 29(191) 30(180) 31(193) 32(176) 33(196) 34(178) 35(156) 36(168) 37(155) 38(152) 39(155) 40(223) 41(159) 42(165) 43(210) 44(175) 45(195) 46(188) 47(178) 48(154) 49(172) 50(176) 51(178) 52(164) 53(175) 54(196) 55(187) 56(189) 

Part 3: 750 latin squares of order 42, showing the last one:

26 27 4 41 31 10 28 13 3 29 21 42 14 39 19 8 5 7 6 40 17 37 35 33 1 38 22 34 18 11 12 2 32 36 9 24 25 23 16 15 30 20
16 40 6 11 22 14 41 42 20 7 24 8 29 27 28 4 26 19 21 39 37 9 2 32 36 15 12 13 38 5 31 33 34 3 17 1 23 35 30 18 10 25
31 15 11 3 5 22 13 10 14 24 41 18 6 16 17 29 36 37 12 28 23 39 34 8 27 40 4 35 7 19 32 26 21 1 2 33 20 9 38 30 25 42
13 37 31 38 42 9 11 2 10 36 22 34 18 23 12 39 25 20 19 26 8 41 16 6 21 32 5 4 33 17 40 24 30 29 27 3 28 14 1 7 35 15
41 7 17 28 24 12 29 8 31 22 1 3 11 42 23 26 39 13 25 19 36 18 33 37 6 5 20 15 2 16 14 4 27 35 38 10 30 32 9 21 34 40
5 19 12 32 20 30 6 33 17 16 27 13 8 9 2 37 21 18 39 4 7 40 1 15 3 35 11 24 10 31 36 23 29 41 22 25 26 28 34 14 42 38
11 14 20 5 3 32 19 27 42 18 12 41 34 6 24 21 38 26 10 35 33 28 9 22 23 39 17 40 31 15 30 37 16 2 36 4 8 1 13 25 29 7
20 6 22 16 34 26 33 23 2 11 29 7 4 13 21 42 9 24 14 41 15 31 5 3 25 18 19 30 1 10 37 36 17 12 39 27 40 38 28 32 8 35
4 25 32 8 28 17 40 19 22 15 23 2 35 5 34 16 18 39 38 24 30 13 41 1 20 3 36 33 42 12 26 29 10 31 6 21 14 37 7 9 11 27
21 2 35 39 26 28 36 16 7 37 19 32 33 1 38 27 4 8 23 6 5 34 40 30 29 42 14 10 9 22 11 12 25 15 13 31 17 18 41 24 20 3
30 28 3 12 6 8 31 32 40 42 25 38 9 33 16 14 13 27 26 17 4 19 20 24 15 36 37 18 11 23 10 22 1 39 21 5 34 41 2 35 7 29
8 34 26 6 16 33 15 28 41 38 40 24 30 21 22 17 20 35 32 23 42 25 11 5 12 1 31 2 13 3 39 27 14 9 18 7 19 29 36 4 37 10
1 22 2 7 39 23 14 18 11 30 15 17 26 10 6 28 16 12 24 31 35 36 37 21 40 29 13 8 3 41 34 38 4 32 25 42 5 27 20 19 33 9
25 32 1 9 35 6 42 34 37 10 13 20 5 19 30 41 17 36 7 15 40 38 26 31 2 23 18 28 24 33 21 11 22 4 14 39 27 8 3 29 16 12
17 12 18 30 11 4 10 5 28 8 33 31 19 22 36 13 6 9 34 42 29 1 27 39 38 21 25 23 26 24 7 15 2 16 41 14 32 40 35 20 3 37
27 36 39 37 18 13 34 14 19 5 32 26 38 12 3 23 1 30 17 11 6 35 21 16 24 41 7 9 28 20 2 31 40 10 4 29 22 25 33 42 15 8
36 24 28 2 32 11 37 12 29 33 16 9 40 3 10 34 7 15 4 27 22 20 25 18 13 26 42 39 17 14 5 8 41 21 23 30 35 31 6 38 19 1
32 30 36 34 14 7 22 9 35 23 6 21 37 2 5 15 31 33 3 16 25 17 4 27 19 13 24 29 40 39 28 1 20 38 10 11 42 12 8 41 26 18
2 41 8 20 29 35 25 4 6 1 17 19 3 18 42 33 12 34 5 32 11 15 30 38 39 14 23 31 21 37 22 9 26 27 16 28 36 7 40 10 13 24
39 1 27 14 2 20 9 26 4 25 18 33 41 28 29 32 34 38 13 7 21 8 10 35 31 17 16 19 23 30 15 5 6 40 37 12 3 36 42 22 24 11
3 13 9 24 15 21 8 41 33 32 20 1 25 40 27 22 29 31 18 36 10 11 17 2 37 28 39 42 14 4 16 35 7 30 34 26 38 6 12 23 5 19
6 33 37 26 30 15 20 35 21 39 14 27 7 4 32 36 2 5 9 18 34 23 22 17 42 24 28 11 8 1 38 3 12 25 31 41 29 10 19 13 40 16
33 16 21 29 40 38 24 7 30 27 11 25 2 32 37 5 35 4 22 9 31 42 18 36 10 34 1 14 12 13 8 41 23 17 3 19 15 20 39 6 28 26
14 17 24 31 19 27 26 6 38 3 9 36 12 41 15 18 37 22 40 33 16 32 29 42 11 4 10 7 34 25 23 28 35 13 20 8 2 5 21 1 39 30
18 31 29 22 37 25 3 24 26 28 8 4 20 36 9 30 33 42 27 38 1 7 13 10 32 11 2 16 19 21 35 14 5 23 40 15 41 39 17 12 6 34
34 9 15 19 23 41 5 39 24 31 26 30 13 25 11 10 40 1 16 22 2 33 28 12 14 37 38 32 29 8 3 7 42 20 35 6 18 4 27 17 21 36
24 42 5 23 10 37 35 17 18 13 7 39 21 29 8 1 32 40 20 14 12 4 15 26 22 25 9 6 41 36 27 34 3 19 28 16 11 30 31 2 38 33
7 23 41 10 17 24 21 22 36 14 30 16 42 34 18 19 11 3 1 37 39 12 38 40 8 33 35 25 4 32 20 6 9 5 15 13 31 26 29 28 27 2
23 18 25 42 27 5 1 38 34 12 31 15 32 20 40 6 19 10 28 30 13 3 8 7 4 2 29 26 36 9 17 21 24 37 33 35 39 22 11 16 14 41
28 11 40 35 36 42 16 25 13 19 4 5 39 26 20 12 15 41 37 34 38 14 31 9 17 7 30 27 6 2 29 10 8 24 1 18 21 33 32 3 22 23
40 38 23 1 21 19 32 29 12 4 2 35 31 11 26 7 28 16 41 10 3 22 24 20 33 27 8 37 15 42 25 39 13 14 30 36 6 34 18 5 9 17
19 26 34 27 8 29 7 20 16 41 36 14 10 15 4 25 3 6 33 5 9 21 23 13 35 30 32 22 37 38 18 17 31 11 12 40 1 42 24 39 2 28
35 29 10 33 13 31 39 1 9 21 38 11 36 30 14 40 42 17 2 20 41 27 6 19 18 22 3 12 5 26 24 16 28 7 8 23 37 15 25 34 4 32
10 35 33 21 4 3 2 30 25 40 39 12 1 37 31 20 24 28 42 8 14 26 32 23 9 16 6 38 22 34 41 19 11 18 29 17 7 13 15 27 36 5
15 5 13 25 9 2 17 40 27 35 42 37 16 8 39 31 41 23 36 1 32 10 7 28 30 19 33 21 20 29 4 18 38 6 11 34 24 3 22 26 12 14
22 39 16 4 41 1 38 11 5 26 10 23 15 14 35 3 8 29 30 13 28 6 12 25 7 20 40 17 32 27 9 42 18 34 19 2 33 24 37 36 31 21
9 3 38 15 25 34 12 21 1 20 5 40 17 24 33 2 27 14 8 29 18 30 19 41 16 10 26 36 35 28 6 32 37 42 7 22 13 11 4 31 23 39
37 10 14 40 12 36 18 3 39 6 35 29 24 38 41 9 23 25 31 21 19 2 42 34 26 8 27 1 30 7 33 13 15 28 32 20 4 16 5 11 17 22
29 20 7 13 38 18 30 37 23 17 34 22 28 31 25 11 14 2 15 12 24 16 36 4 5 9 21 3 27 35 1 40 39 8 42 32 10 19 26 33 41 6
12 21 42 18 7 39 27 36 8 34 37 28 23 17 13 24 30 32 35 3 20 29 14 11 41 31 15 5 16 6 19 25 33 22 26 38 9 2 10 40 1 4
42 4 30 36 1 16 23 15 32 9 3 10 27 35 7 38 22 21 11 2 26 24 39 29 28 6 34 41 25 40 13 20 19 33 5 37 12 17 14 8 18 31
38 8 19 17 33 40 4 31 15 2 28 6 22 7 1 35 10 11 29 25 27 5 3 14 34 12 41 20 39 18 42 30 36 26 24 9 16 21 23 37 32 13

Part 4: 100 latin squares of order 256:

Generated in 76.816295878 seconds.

Last updated