#!/usr/bin/env perl6

sub compare-cell($other, $this) {
	if ($other ~~ Array) {
		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
					eager grep { !compare-cell($sudoku[any(0..2)+3*$sx][any(0..2)+3*$sy], $_) },
		                        # and not in this row
					eager grep { !compare-cell($sudoku[any(0..8)][$y+3*$sy], $_) },
					# or in this column
					eager grep { !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) {
	my $solved = 0;
	for 0..8 X 0..8 -> $x, $y {
		next unless $sudoku[$x][$y] ~~ Array;
		my @candidates = reverse @($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 ];

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

