Sudoku solver
Sudoku solver
There are probably tons of these already available, but here is a quick
sudoku solver (in Perl):
#! /usr/bin/perl
# Example:
#
# echo $' 2 \n 1 9 4 \n 2 1 5 9\n3 6 \n 68 41 5\n 427 8 \n 51 \n 7 3 \n79 5 ' perl sudokusolve.pl
#
use strict;
use warnings;
my $s = read_sudoku();
my $res= solve($s);
if($res) {
print_sudoku($res);
print "Got it!\n";
} else {
print "Failed :(\n";
}
exit 0;
sub solve {
my ($s)= @_;
my $res= try_solve($s);
return $s if $res eq 'SOLVED';
return undef if $res eq 'FAIL';
# Make a guess, backtracking if we were wrong.
# Try to find some field where there are only two possibilities.
my ($a, $b);
OUTER:
for my $i (0..8) {
INNER:
for my $j (0..8) {
next INNER if keys(%{$s>[$i][$j]}) == 1;
if(keys(%{$s>[$i][$j]}) == 2) {
($a,$b)= ($i,$j);
last OUTER;
} elsif(!defined($a)) {
($a,$b)= ($i,$j);
}
}
}
die "Internal?!?" unless defined($a);
for my $choice (keys %{$s>[$a][$b]}) {
my $s_copy = [ map { [ map { { %$_ } } @$_ ] } @$s ];
$s_copy>[$a][$b] = { $choice => 1 };
my $res= solve($s_copy);
return $res if defined($res); # Got it!
}
return undef; # Failed.
}
sub read_sudoku {
my $s= [ ];
for(my $i = 0; $i < 9; $i++) {
my $x = <STDIN>;
chomp($x);
if(length($x) < 9) {
print STDERR "Short line: '$x'\n";
redo;
}
for(my $j = 0; $j < 9; $j++) {
my $entry= substr($x, $j, 1);
$s>[$i][$j] = { map(($_ => 1), ($entry eq ' ' ? (1..9) : ($entry))) };
}
}
return $s;
}
sub print_sudoku {
my ($s) = @_;
for(my $i = 0; $i < 9; $i++) {
print "\n" unless $i % 3;
for(my $j= 0; $j < 9; $j++) {
print "" unless $j % 3;
print((keys(%{$s>[$i][$j]}) > 1 ? ' ' : keys(%{$s>[$i][$j]})),
($j == 8 ? "\n" : " "));
}
}
print "\n";
}
sub try_solve {
my ($s)= @_;
my $done;
my $progress;
do {
$done = 1; # Set false when nondetermined field found
$progress= undef;
for(my $i = 0; $i < 9; $i++) {
for(my $j = 0; $j < 9; $j++) {
my $x = $s>[$i][$j];
return 'FAIL' if keys(%$x) == 0;
$done = undef if keys(%$x) > 1;
my $h1= { %$x };
my $h2= { %$x };
my $h3= { %$x };
for(my $a = 0; $a < 9; $a++) {
if($a != $i) {
my $y = $s>[$a][$j];
delete $h1>{$_} for keys(%$y);
if(keys %$y == 1) {
$progress = 1 if delete $x>{(keys(%$y))[0]};
}
}
if($a != $j) {
my $y = $s>[$i][$a];
delete $h2>{$_} for keys(%$y);
if(keys %$y == 1) {
$progress = 1 if delete $x>{(keys(%$y))[0]};
}
}
my $b = 3*int($i/3) + int($a / 3);
my $c = 3*int($j/3) + $a % 3;
if($b != $i  $c != $j) {
my $y = $s>[$b][$c];
delete $h3>{$_} for keys(%$y);
if(keys %$y == 1) {
$progress = 1 if delete $x>{(keys(%$y))[0]};
}
}
}
return 'FAIL' if keys(%$h1) > 1  keys(%$h2) > 1  keys(%$h3) > 1;
if(keys(%$h1) == 1) {
delete($x>{$_}) for grep(!$h1>{$_}, keys %$x);
} elsif(keys(%$h2) == 1) {
delete($x>{$_}) for grep(!$h2>{$_}, keys %$x);
} elsif(keys(%$h3) == 1) {
delete($x>{$_}) for grep(!$h3>{$_}, keys %$x);
}
}
}
} while(!$done && $progress);
return $done ? 'SOLVED' : 'UNSOLVED';
}
I wanted to use strategy rather than brute force (not sure what the
complexity of that would be; the above seems to solve puzzles in a split
second). Strategies are
 If a digit is already in a row/column/square, it cannot occur a second
time.
 A digit is known to occur in a field if it cannot occur in any of the 8
other fields of a row/column/square.
These are not sufficient to solve (all) puzzles. Here is another example
strategy: If we know in some 3x3 square that some particular digit can only
occur in a particular row/column, then that digit can not occur in that
digit/column in any other square.
However, at this point I just added a quick backtracking step. It seems the
implemented strategies are sufficiently close to a full solution that only
very little backtracking is needed, and a solution is usually arrived at
instantly.
This example took perhaps an hour to put together. It is a nice example of
the usefulness of learning Perl. Because Perl is well suited for a very wide
range of programming tasks, the investment needed to learn the language pays
off very well. Perl can be used for 2minute oneliners like this to massage a
.h file:
perl nle 'print "#define prefix_$1 $1" if /^\s*[azAz09_ ]+\s+([_azAZ09]+)\s*\(/ ' *.h
It can be used for quick hacks like this sudoku solver. And it can be used for
fullscale application development.
If I were to use different languages for these different tasks, I would
have less time to spend on learning each one, and thus would work less
efficiently at all of them.
Tags: hacks, perl
