perl6 sudoku solver

gistfile1.txt

#!/usr/bin/env perl6

sub compare-cell($other, $this, :$all) {
    if ($other ~~ Array) {
        if ($all) {
            return $other.grep({ $this == $_ }) ?? 1 !! 0;
        } else {
            return 0;
        }
    } else {
        return $other == $this;
    }
}

sub clone-sudoku($sudoku) {
    my $clone = [];
    for 0..8 X 0..8 -> $x, $y {
        $clone[$x] ||= [];
        $clone[$x][$y] = $sudoku[$x][$y];
    }
    return $clone;
}

sub cleanup-impossible-values($sudoku, $level = 1) {
    my Bool $resolved;
    repeat {
        $resolved = False;
        for 0..2 X 0..2 X 0..2 X 0..2 -> $sx, $sy, $x, $y {
            if ($sudoku[$x+3*$sx][$y+3*$sy] ~~ Array) {
                # impossible values are the values listed as possible but that
                # actually are already assigned...
                $sudoku[$x+3*$sx][$y+3*$sy] = [
                    # make sure the value is not resolved as any in this section
                    grep { !compare-cell($sudoku[any(0..2)+3*$sx][any(0..2)+3*$sy], $_) &&
                           !compare-cell($sudoku[any(0..8)][$y+3*$sy], $_) &&
                           !compare-cell($sudoku[$x+3*$sx][any(0..8)], $_) },
                    # for all the possible values
                    @($sudoku[$x+3*$sx][$y+3*$sy])
                    ];
                if ($sudoku[$x+3*$sx][$y+3*$sy].elems == 1) {
                    # if only one element is left, then make it resolved
                    say '.' x $level ~ "$sx $sy $x $y solved...";
                    $sudoku[$x+3*$sx][$y+3*$sy] =
                        $sudoku[$x+3*$sx][$y+3*$sy].shift;
                    $resolved = True;
                } elsif ($sudoku[$x+3*$sx][$y+3*$sy].elems == 0) {
                    say '.' x $level ~ "Invalid solution...";
                    return 0;
                }
            }
        }
    } while $resolved;
    return 1;
}


sub print-sudoku($sudoku, $level = 1) {
    say '.' x $level ~ '-' x 5*9;
    say '.' x $level ~ (map -> $row {
        (map -> $cell {
            $cell ~~ Array ?? "#{$cell.elems}#" !! " $cell " 
         }, @($row)).join("  ") 
                        }, @($sudoku)).join("\n"~('.'x$level));
}

sub solve-sudoku($sudoku, $level = 1) {
    for 0..8 X 0..8 -> $x, $y {
        next unless $sudoku[$x][$y] ~~ Array;
        my @candidates = @($sudoku[$x][$y]);
        for @candidates -> $val {
            say '.' x $level ~ "Trying $val on $x,$y";
            my $solution = clone-sudoku($sudoku);
            $solution[$x][$y] = $val;
            cleanup-impossible-values($solution, $level) or next;
            print-sudoku($solution,$level);
            my $solved = solve-sudoku($solution, $level + 1);
            if $solved {
                return $solved;
            }
        }
        say '.' x $level ~ "Backtrack, path unsolvable...";
        return 0;
    }
    say '.' x $level ~ "Fully solved";
    return $sudoku;
}

my $sudoku =
    map { [ map { $_ == 0 ?? [1..9] !! $_+0  }, @($_) ] },
    [ 0,0,1,0,0,5,3,0,0 ],
    [ 0,5,0,4,9,0,0,0,0 ],
    [ 0,0,0,1,0,2,0,6,4 ],
    [ 0,0,0,0,0,0,7,5,0 ],
    [ 6,0,0,0,0,0,0,0,1 ],
    [ 0,3,5,0,0,0,0,0,0 ],
    [ 4,6,0,9,0,3,0,0,0 ],
    [ 0,0,0,0,2,4,0,9,0 ],
    [ 0,0,3,6,0,0,1,0,0 ];

print-sudoku($sudoku,0);
my $solved = solve-sudoku($sudoku);
if $solved {
    print-sudoku($solved,0);
} else {
    say "unsolvable.";
}