This solution takes < 1 second to resolve a Sudoku: (I started with 25 seconds last night, as I used the first available blank instead of the blank spot with the least options.)
use Data::Dumper;
use strict;
use warnings;
my $board = [
[undef, undef, 8, undef, undef, undef, undef, 4, undef
+],
[4, undef, undef, 2, 5, undef, undef, undef, 7],
[undef, undef, undef, undef, undef, 7, 2, undef, 1],
[undef, undef, undef, 9, undef, undef, undef, undef, 8
+],
[1, undef, 6, 5, undef, 2, 9, undef, 3],
[9, undef, undef, undef, undef, 1, undef, undef, undef
+],
[7, undef, 1, 6, undef, undef, undef, undef, undef],
[8, undef, undef, undef, 2, 3, undef, undef, 6],
[undef, 2, undef, undef, undef, undef, 4, undef, undef
+]
];
my $t0 = time();
try($board);
print "Took " . (time() - $t0) . " seconds\n";
sub try {
my $board = shift;
my ($x, $y, @options) = find_blank_with_least_options($board);
if (defined($x)) {
for (@options) {
$board->[$x][$y] = $_;
try($board);
}
$board->[$x][$y] = undef;
} else {
print "find solution:\n";
display($board);
}
}
sub find_blank_with_least_options {
my $board = shift;
my ($x_to_return, $y_to_return, @options_to_return);
my $least = 9;
for my $x (0 .. 8) {
for my $y (0 .. 8) {
if (!defined($board->[$x][$y])) {
my @options = (0,1,1,1,1,1,1,1,1,1);
for (0 .. 8) {
$options[$board->[$x][$_]] = 0 if defined($board->
+[$x][$_]);
$options[$board->[$_][$y]] = 0 if defined($board->
+[$_][$y]);
}
for my $i (int($x/3) * 3 .. int($x/3) * 3 + 2) {
for my $j (int($y/3) * 3 .. int($y/3) * 3 + 2) {
$options[$board->[$i][$j]] = 0 if defined($boa
+rd->[$i][$j]);
}
}
my $sum;
$sum += $options[$_] for (0 .. 9);
if ($sum < $least) {
$x_to_return = $x;
$y_to_return = $y;
$least = $sum;
$#options_to_return = -1;
for (1 .. 9) {
push @options_to_return, $_ if ($options[$_]);
}
}
}
}
}
return ($x_to_return, $y_to_return, @options_to_return);
}
sub display {
my $board = shift;
for my $x (0 .. 8) {
for my $y (0 .. 8) {
print $board->[$x][$y] ? $board->[$x][$y] . " " : " ";
}
print "\n";
}
}