Latin Squares in reduced form/Randomizing using Jacobson and Matthews’ Technique: Difference between revisions
Latin Squares in reduced form/Randomizing using Jacobson and Matthews’ Technique (view source)
Revision as of 18:23, 29 July 2021
, 2 years agoadded Raku programming solution
(added Raku programming solution) |
|||
Line 1,333:
</pre>
Unfortunately the last part of this task exposes the relatively poor performance of subscripting in phix.
=={{header|Raku}}==
{{trans|Go}}
<lang perl6># 20210729 Raku programming solution
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 is copy) {
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
}
return @c
}
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 {
@c = shuffleCube @c;
my @m = toMatrix @c;
my @rm = toReduced @m;
%freq{@rm».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 {
@c = shuffleCube @c;
my @m = toMatrix @c;
my @rm = toReduced @m;
%freq{@rm».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(*)
# printAs1based ( toMatrix ( shuffleCube(@c) xx * )[749] )».List.flat ;
my @m42;
for ^750 { $_==749 ?? (@m42 = toMatrix(shuffleCube @c)) !! shuffleCube(@c) }
printAs1based @m42».List.flat ;
say "\nPart 4: 1000 latin squares of order 256:\n";
@c = makeCube([], 256);
my $snapshot = now;
race for ^1000 { shuffleCube @c } # ; say "$_\t", now - $snapshot }
say "Generated in { now - $snapshot } seconds."
</lang>
{{out}}
<pre>
Part 1: 10,000 latin Squares of order 4 in reduced form:
1 2 3 4
2 4 1 3
3 1 4 2
4 3 2 1
Occurs 2564 times.
1 2 3 4
2 1 4 3
3 4 1 2
4 3 2 1
Occurs 2512 times.
1 2 3 4
2 1 4 3
3 4 2 1
4 3 1 2
Occurs 2406 times.
1 2 3 4
2 3 4 1
3 4 1 2
4 1 2 3
Occurs 2518 times.
Part 2: 10,000 latin Squares of order 5 in reduced form:
1(172) 2(172) 3(179) 4(169) 5(157) 6(189) 7(182) 8(165) 9(170) 10(147) 11(149) 12(198) 13(171) 14(212) 15(167) 16(205) 17(170) 18(199) 19(189) 20(179) 21(196) 22(184) 23(216) 24(218) 25(149) 26(191) 27(163) 28(240) 29(164) 30(182) 31(179) 32(192) 33(173) 34(154) 35(169) 36(145) 37(180) 38(173) 39(168) 40(182) 41(150) 42(150) 43(187) 44(212) 45(190) 46(180) 47(167) 48(163) 49(222) 50(170) 51(181) 52(186) 53(162) 54(171) 55(175) 56(175)
Part 3: 750 latin squares of order 42, showing the last one:
3 9 29 34 30 27 19 22 41 36 13 28 42 21 32 10 8 35 16 31 24 15 33 5 37 6 39 26 1 11 7 4 25 38 17 20 2 14 23 40 12 18
13 21 32 12 2 14 42 36 8 19 15 30 23 37 34 24 9 4 6 38 40 1 7 10 3 26 17 20 22 16 18 33 35 25 31 28 39 41 29 5 27 11
41 37 12 26 23 32 24 5 31 9 14 1 38 36 28 11 39 20 29 42 13 27 35 8 21 22 2 30 34 17 15 25 6 10 18 33 4 40 7 3 19 16
15 4 37 42 7 22 27 35 30 23 29 16 19 8 40 34 20 3 5 39 31 41 26 28 36 10 25 14 17 38 9 13 11 33 6 2 24 18 32 21 1 12
35 40 14 11 32 42 3 25 26 24 39 31 1 12 29 9 22 18 17 16 38 10 36 33 2 37 30 34 4 28 8 19 21 5 13 23 15 27 6 7 41 20
6 33 34 20 19 2 22 10 15 14 26 38 21 41 42 1 17 32 4 8 11 28 29 9 40 16 23 18 31 5 27 35 37 13 25 24 12 7 3 30 36 39
40 16 36 2 3 20 17 18 9 1 6 7 34 31 4 39 10 12 22 24 25 35 8 30 26 14 37 33 42 15 11 21 41 23 38 32 29 28 27 19 5 13
4 6 17 21 29 15 38 24 33 42 1 9 22 26 7 35 41 10 11 14 37 40 27 39 30 31 8 25 23 36 13 3 32 28 16 12 19 5 20 2 18 34
19 27 16 6 11 3 39 34 36 38 10 5 17 24 21 42 14 29 41 22 9 2 37 26 18 30 31 23 20 4 32 12 28 15 33 7 13 1 25 35 8 40
10 26 11 9 25 31 23 13 35 2 40 22 6 1 39 5 36 42 37 34 20 18 30 14 28 12 21 38 33 32 16 41 3 27 24 17 7 29 15 8 4 19
33 32 5 40 38 28 34 12 10 6 18 13 2 9 11 3 35 24 15 25 19 8 23 17 27 20 14 41 7 26 29 30 1 39 37 36 31 16 42 4 21 22
20 17 7 15 28 24 30 26 12 39 4 41 8 3 35 16 37 13 19 23 36 29 11 2 31 18 32 27 14 6 33 34 5 42 1 10 25 22 40 38 9 21
2 34 18 35 33 19 5 20 6 26 24 10 37 38 8 28 29 41 3 7 1 17 31 42 14 25 9 39 36 22 23 40 30 32 12 4 16 11 21 13 15 27
24 10 31 13 1 35 7 41 34 8 17 29 16 39 23 19 3 26 9 21 14 30 22 4 38 40 11 6 12 42 28 15 33 2 32 27 20 25 36 18 37 5
26 18 2 19 21 23 35 16 1 7 3 25 4 17 33 29 12 39 20 41 22 11 42 13 6 28 34 32 10 31 24 27 38 36 14 37 5 8 30 9 40 15
12 7 4 37 35 34 18 2 13 20 32 27 5 29 22 40 31 19 21 11 10 26 6 15 16 33 41 28 25 24 14 42 23 1 30 8 17 38 39 36 3 9
23 15 28 4 20 7 16 9 11 32 19 17 26 6 12 2 24 1 36 40 30 13 38 25 5 27 33 21 3 39 34 18 14 22 29 42 8 10 37 31 35 41
5 36 6 28 18 41 33 1 25 16 38 20 7 10 24 37 42 11 23 26 21 12 2 32 9 4 27 13 30 19 40 39 34 8 22 3 14 35 17 15 29 31
36 11 15 25 40 5 2 7 39 34 41 24 35 30 10 31 27 21 42 17 26 38 4 1 19 32 13 37 8 20 12 9 22 16 23 18 3 6 33 29 28 14
28 3 1 8 17 12 9 42 38 4 22 32 40 16 30 27 5 7 18 33 41 37 39 23 20 29 19 31 15 21 6 2 10 24 11 34 36 13 35 14 26 25
18 13 42 30 12 10 29 19 21 28 31 36 3 4 17 20 40 9 24 37 27 6 34 11 39 8 7 15 35 23 22 32 2 14 5 25 38 26 41 1 16 33
37 39 26 5 4 29 41 14 16 31 27 15 20 13 3 38 6 25 2 18 23 24 32 12 11 35 36 1 9 40 21 7 17 34 28 19 10 30 8 33 22 42
17 24 38 32 14 39 15 8 22 25 42 11 30 23 13 12 4 36 27 3 5 33 19 7 41 1 16 29 28 10 35 6 20 31 21 40 9 2 18 37 34 26
16 25 9 29 39 37 8 27 24 18 20 40 33 15 31 14 21 34 1 6 2 23 5 36 4 13 35 22 32 12 41 38 7 3 19 26 30 17 11 42 10 28
7 5 22 41 31 36 11 29 28 15 8 35 32 18 19 30 26 2 38 1 3 14 20 27 25 21 42 4 40 13 17 24 9 37 39 16 34 23 12 6 33 10
22 23 13 17 24 9 10 11 29 33 16 12 36 32 37 6 1 40 31 15 18 25 21 3 34 2 28 35 39 41 5 14 27 19 4 30 26 42 38 20 7 8
29 1 19 27 5 21 26 23 37 30 7 18 14 25 6 17 33 16 12 32 15 22 13 40 24 39 10 11 38 9 3 8 31 4 20 35 41 36 34 28 42 2
9 2 27 39 10 1 36 17 40 22 12 33 29 11 25 13 7 28 34 30 32 3 14 20 8 23 15 5 19 18 38 31 4 21 42 41 37 24 26 16 6 35
27 8 40 7 13 33 25 6 4 37 9 2 39 20 16 26 34 15 10 28 12 21 41 38 29 5 24 42 11 35 36 17 18 30 3 14 22 19 1 32 31 23
25 35 41 31 9 11 21 40 17 5 2 6 12 34 14 36 23 30 26 29 8 20 18 19 10 42 4 16 37 33 1 22 13 7 27 39 32 15 28 24 38 3
30 38 35 10 6 26 12 37 20 13 28 14 25 27 9 15 2 31 40 5 33 39 3 16 22 7 1 19 18 8 42 23 29 41 34 11 21 4 24 17 32 36
42 41 20 14 37 18 13 21 27 40 30 23 11 2 15 25 38 22 28 12 29 7 1 31 17 19 26 10 16 3 4 36 8 9 35 6 33 32 5 34 39 24
1 22 8 38 42 6 28 30 7 17 23 3 9 14 2 4 13 5 33 10 39 36 24 41 35 34 40 12 29 27 37 11 16 26 15 21 18 31 19 25 20 32
21 19 3 24 34 4 32 28 5 29 25 26 27 7 1 18 15 23 13 36 42 16 40 22 33 17 20 2 41 14 30 37 39 6 8 31 35 9 10 12 11 38
39 29 21 23 36 38 4 33 32 3 5 34 41 40 20 8 16 27 7 13 28 19 25 35 15 24 18 17 6 30 31 1 26 11 2 9 42 12 22 10 14 37
31 14 39 16 15 40 37 32 42 11 36 8 24 22 41 7 18 6 35 19 34 5 17 21 23 9 38 3 26 29 2 28 12 20 10 13 1 33 4 27 25 30
34 30 23 18 8 17 6 4 2 27 35 21 15 33 38 32 11 14 39 20 7 9 16 37 42 36 12 40 24 25 26 10 19 29 41 5 28 3 31 22 13 1
11 20 24 1 27 8 40 31 14 21 34 19 10 35 26 22 30 33 32 9 4 42 28 18 13 38 3 7 2 37 25 5 15 12 36 29 6 39 16 41 23 17
32 42 25 33 26 16 31 38 3 10 11 4 13 28 18 21 19 8 30 35 6 34 15 29 12 41 22 36 5 2 39 20 24 40 9 1 27 37 14 23 17 7
8 28 10 3 16 13 14 39 18 41 21 37 31 19 36 33 32 38 25 2 17 4 12 6 7 15 5 24 27 1 20 26 42 35 40 22 23 34 9 11 30 29
14 12 30 36 22 25 1 15 23 35 33 39 18 42 5 41 28 37 8 27 16 31 10 24 32 3 6 9 21 34 19 29 40 17 7 38 11 20 13 26 2 4
38 31 33 22 41 30 20 3 19 12 37 42 28 5 27 23 25 17 14 4 35 32 9 34 1 11 29 8 13 7 10 16 36 18 26 15 40 21 2 39 24 6
Part 4: 1000 latin squares of order 256:
Generated in 359.960275435 seconds.
</pre>
=={{header|Wren}}==
| |||