Latin Squares in reduced form

# utilities: factorial, sub-factorial, derangements
sub  postfix:<!>($n) { (constant f = 1, |[\×] 1..*)[$n] }
sub   prefix:<!>($n) { (1, 0, 1, -> $a, $b { ($++ + 2) × ($b + $a) } ... *)[$n] }
sub derangements(@l) { @l.permutations.grep(-> @p { none(@p Zeqv @l) }) }

sub LS-reduced (Int $n) {
    return [1] if $n == 1;

    my @LS;
    my @l = 1 X+ ^$n;
    my %D = derangements(@l).classify(*.[0]);

    for [X] (^(!$n/($n-1))) xx $n-1 -> $tuple {
        my @d.push: @l;
        @d.push: %D{2}[$tuple[0]];
        LOOP:
        for 3 .. $n -> $x {
            my @try = |%D{$x}[$tuple[$x-2]];
            last LOOP if any @try »==« @d[$_] for 1..@d-1;
            @d.push: @try;
        }
        next unless @d == $n and [==] [Z+] @d;
        @LS.push: @d;
    }
    @LS
}

say .join("\n") ~ "\n" for LS-reduced(4);
for 1..6 -> $n {
    printf "Order $n: Size %-4d x $n! x {$n-1}! => Total %d\n", $_, $_ * $n! * ($n-1)! given LS-reduced($n).elems
}

Output:

Last updated

Was this helpful?