Recently the Developement Manager had a contest where he asked the developers to provide a program to solve sudoku puzzles. I'm not in development but he asked me to particpate too -- I think because he wanted to see a Perl solution as well as Java, dotNET, etc.
The winning offering, written in Java, won simply by solving the puzzles fastest. It solved the worst case puzzle in about 500 ms. By comparison my Perl program solved the same puzzle in about 5 seconds.
When comparing the source code it was obvious that both of the above programs were using a similar back step algorithm with recursion. Out of curiosity we ran each thru a profiler and discoverd that my Perl program made 13,361 recusrsive calls to the grid check subroutine whereas his Java program made over 500,000! It was pretty obviuos my search algorithm was way more efficient than his and the only answer I could come up for the difference was that Perl must pay a lot in overhead for subroutines and or recursion.
#!/usr/bin/perl
use strict;
use warnings;
# set to 1 for elapsed time calculations
my ($TIME)=1;
# declare the grid array as global
my (@grid);
# precalculated search space for each cell
my %search = (
(0=>[0,1,2,3,4,5,6,7,8,9,10,11,18,19,20,27,36,45,54,63,72]),
(1=>[0,1,2,3,4,5,6,7,8,9,10,11,18,19,20,28,37,46,55,64,73]),
(2=>[0,1,2,3,4,5,6,7,8,9,10,11,18,19,20,29,38,47,56,65,74]),
(3=>[0,1,2,3,4,5,6,7,8,12,13,14,21,22,23,30,39,48,57,66,75]),
(4=>[0,1,2,3,4,5,6,7,8,12,13,14,21,22,23,31,40,49,58,67,76]),
(5=>[0,1,2,3,4,5,6,7,8,12,13,14,21,22,23,32,41,50,59,68,77]),
(6=>[0,1,2,3,4,5,6,7,8,15,16,17,24,25,26,33,42,51,60,69,78]),
(7=>[0,1,2,3,4,5,6,7,8,15,16,17,24,25,26,34,43,52,61,70,79]),
(8=>[0,1,2,3,4,5,6,7,8,15,16,17,24,25,26,35,44,53,62,71,80]),
(9=>[0,1,2,9,10,11,12,13,14,15,16,17,18,19,20,27,36,45,54,63,72]),
(10=>[0,1,2,9,10,11,12,13,14,15,16,17,18,19,20,28,37,46,55,64,73]),
(11=>[0,1,2,9,10,11,12,13,14,15,16,17,18,19,20,29,38,47,56,65,74]),
(12=>[3,4,5,9,10,11,12,13,14,15,16,17,21,22,23,30,39,48,57,66,75]),
(13=>[3,4,5,9,10,11,12,13,14,15,16,17,21,22,23,31,40,49,58,67,76]),
(14=>[3,4,5,9,10,11,12,13,14,15,16,17,21,22,23,32,41,50,59,68,77]),
(15=>[6,7,8,9,10,11,12,13,14,15,16,17,24,25,26,33,42,51,60,69,78]),
(16=>[6,7,8,9,10,11,12,13,14,15,16,17,24,25,26,34,43,52,61,70,79]),
(17=>[6,7,8,9,10,11,12,13,14,15,16,17,24,25,26,35,44,53,62,71,80]),
(18=>[0,1,2,9,10,11,18,19,20,21,22,23,24,25,26,27,36,45,54,63,72]),
(19=>[0,1,2,9,10,11,18,19,20,21,22,23,24,25,26,28,37,46,55,64,73]),
(20=>[0,1,2,9,10,11,18,19,20,21,22,23,24,25,26,29,38,47,56,65,74]),
(21=>[3,4,5,12,13,14,18,19,20,21,22,23,24,25,26,30,39,48,57,66,75]),
(22=>[3,4,5,12,13,14,18,19,20,21,22,23,24,25,26,31,40,49,58,67,76]),
(23=>[3,4,5,12,13,14,18,19,20,21,22,23,24,25,26,32,41,50,59,68,77]),
(24=>[6,7,8,15,16,17,18,19,20,21,22,23,24,25,26,33,42,51,60,69,78]),
(25=>[6,7,8,15,16,17,18,19,20,21,22,23,24,25,26,34,43,52,61,70,79]),
(26=>[6,7,8,15,16,17,18,19,20,21,22,23,24,25,26,35,44,53,62,71,80]),
(27=>[0,9,18,27,28,29,30,31,32,33,34,35,36,37,38,45,46,47,54,63,72]),
(28=>[1,10,19,27,28,29,30,31,32,33,34,35,36,37,38,45,46,47,55,64,73]),
(29=>[2,11,20,27,28,29,30,31,32,33,34,35,36,37,38,45,46,47,56,65,74]),
(30=>[3,12,21,27,28,29,30,31,32,33,34,35,39,40,41,48,49,50,57,66,75]),
(31=>[4,13,22,27,28,29,30,31,32,33,34,35,39,40,41,48,49,50,58,67,76]),
(32=>[5,14,23,27,28,29,30,31,32,33,34,35,39,40,41,48,49,50,59,68,77]),
(33=>[6,15,24,27,28,29,30,31,32,33,34,35,42,43,44,51,52,53,60,69,78]),
(34=>[7,16,25,27,28,29,30,31,32,33,34,35,42,43,44,51,52,53,61,70,79]),
(35=>[8,17,26,27,28,29,30,31,32,33,34,35,42,43,44,51,52,53,62,71,80]),
(36=>[0,9,18,27,28,29,36,37,38,39,40,41,42,43,44,45,46,47,54,63,72]),
(37=>[1,10,19,27,28,29,36,37,38,39,40,41,42,43,44,45,46,47,55,64,73]),
(38=>[2,11,20,27,28,29,36,37,38,39,40,41,42,43,44,45,46,47,56,65,74]),
(39=>[3,12,21,30,31,32,36,37,38,39,40,41,42,43,44,48,49,50,57,66,75]),
(40=>[4,13,22,30,31,32,36,37,38,39,40,41,42,43,44,48,49,50,58,67,76]),
(41=>[5,14,23,30,31,32,36,37,38,39,40,41,42,43,44,48,49,50,59,68,77]),
(42=>[6,15,24,33,34,35,36,37,38,39,40,41,42,43,44,51,52,53,60,69,78]),
(43=>[7,16,25,33,34,35,36,37,38,39,40,41,42,43,44,51,52,53,61,70,79]),
(44=>[8,17,26,33,34,35,36,37,38,39,40,41,42,43,44,51,52,53,62,71,80]),
(45=>[0,9,18,27,28,29,36,37,38,45,46,47,48,49,50,51,52,53,54,63,72]),
(46=>[1,10,19,27,28,29,36,37,38,45,46,47,48,49,50,51,52,53,55,64,73]),
(47=>[2,11,20,27,28,29,36,37,38,45,46,47,48,49,50,51,52,53,56,65,74]),
(48=>[3,12,21,30,31,32,39,40,41,45,46,47,48,49,50,51,52,53,57,66,75]),
(49=>[4,13,22,30,31,32,39,40,41,45,46,47,48,49,50,51,52,53,58,67,76]),
(50=>[5,14,23,30,31,32,39,40,41,45,46,47,48,49,50,51,52,53,59,68,77]),
(51=>[6,15,24,33,34,35,42,43,44,45,46,47,48,49,50,51,52,53,60,69,78]),
(52=>[7,16,25,33,34,35,42,43,44,45,46,47,48,49,50,51,52,53,61,70,79]),
(53=>[8,17,26,33,34,35,42,43,44,45,46,47,48,49,50,51,52,53,62,71,80]),
(54=>[0,9,18,27,36,45,54,55,56,57,58,59,60,61,62,63,64,65,72,73,74]),
(55=>[1,10,19,28,37,46,54,55,56,57,58,59,60,61,62,63,64,65,72,73,74]),
(56=>[2,11,20,29,38,47,54,55,56,57,58,59,60,61,62,63,64,65,72,73,74]),
(57=>[3,12,21,30,39,48,54,55,56,57,58,59,60,61,62,66,67,68,75,76,77]),
(58=>[4,13,22,31,40,49,54,55,56,57,58,59,60,61,62,66,67,68,75,76,77]),
(59=>[5,14,23,32,41,50,54,55,56,57,58,59,60,61,62,66,67,68,75,76,77]),
(60=>[6,15,24,33,42,51,54,55,56,57,58,59,60,61,62,69,70,71,78,79,80]),
(61=>[7,16,25,34,43,52,54,55,56,57,58,59,60,61,62,69,70,71,78,79,80]),
(62=>[8,17,26,35,44,53,54,55,56,57,58,59,60,61,62,69,70,71,78,79,80]),
(63=>[0,9,18,27,36,45,54,55,56,63,64,65,66,67,68,69,70,71,72,73,74]),
(64=>[1,10,19,28,37,46,54,55,56,63,64,65,66,67,68,69,70,71,72,73,74]),
(65=>[2,11,20,29,38,47,54,55,56,63,64,65,66,67,68,69,70,71,72,73,74]),
(66=>[3,12,21,30,39,48,57,58,59,63,64,65,66,67,68,69,70,71,75,76,77]),
(67=>[4,13,22,31,40,49,57,58,59,63,64,65,66,67,68,69,70,71,75,76,77]),
(68=>[5,14,23,32,41,50,57,58,59,63,64,65,66,67,68,69,70,71,75,76,77]),
(69=>[6,15,24,33,42,51,60,61,62,63,64,65,66,67,68,69,70,71,78,79,80]),
(70=>[7,16,25,34,43,52,60,61,62,63,64,65,66,67,68,69,70,71,78,79,80]),
(71=>[8,17,26,35,44,53,60,61,62,63,64,65,66,67,68,69,70,71,78,79,80]),
(72=>[0,9,18,27,36,45,54,55,56,63,64,65,72,73,74,75,76,77,78,79,80]),
(73=>[1,10,19,28,37,46,54,55,56,63,64,65,72,73,74,75,76,77,78,79,80]),
(74=>[2,11,20,29,38,47,54,55,56,63,64,65,72,73,74,75,76,77,78,79,80]),
(75=>[3,12,21,30,39,48,57,58,59,66,67,68,72,73,74,75,76,77,78,79,80]),
(76=>[4,13,22,31,40,49,57,58,59,66,67,68,72,73,74,75,76,77,78,79,80]),
(77=>[5,14,23,32,41,50,57,58,59,66,67,68,72,73,74,75,76,77,78,79,80]),
(78=>[6,15,24,33,42,51,60,61,62,69,70,71,72,73,74,75,76,77,78,79,80]),
(79=>[7,16,25,34,43,52,60,61,62,69,70,71,72,73,74,75,76,77,78,79,80]),
(80=>[8,17,26,35,44,53,60,61,62,69,70,71,72,73,74,75,76,77,78,79,80])
);
sub main {
my ($line,$aa);
# load the array
$aa = "";
foreach $line (<>) {
chomp ($line);
# want 0 instead of '-'
$line =~ s/\-/0/g;
$aa .= $line . ",";
}
# convert grid to one dimensional array
chomp $aa;
@grid = split /,/,$aa;
sudoku_print();
# start the clock
if ($TIME) {
start_clock();
}
# go to it!
grid_check();
}
#
sub grid_check {
my ($cntr,$val,$et,$cell,$sudoku);
my (@list,@range);
my (%solve);
# first find cells with fewest possibiles
for $cntr (0..80) {
# if cell is allready set skip it
next if($grid[$cntr]);
# create a list of impossible values
# target cell is at $cntr
# test cell is at $cell
# check each cell in the precalculated search space
@list = (1,0,0,0,0,0,0,0,0,0);
foreach $cell (@{$search{$cntr}}) {
$list[$grid[$cell]] = 1;
}
# count the number of possible values
# remember @list is the illegal values so invert the sense of the
+search
$solve{$cntr} = (grep{!$list[$_]}1..9);
}
# now sort by the number of possiblities
@range = (sort {$solve{$a}<=>$solve{$b}} keys %solve);
# run thru the sorted list.
# This loop looks at undeterined cells in ascending order of possibi
+litie
# with a recursve call to this function. It will not finish until e
+very
# cell is non-zero.
foreach $cntr (@range) {
# skip the cell if it already has a value. T
next if($grid[$cntr]);
@list = (1,0,0,0,0,0,0,0,0,0);
foreach $cell (@{$search{$cntr}}) {
$list[$grid[$cell]] = 1;
}
# For each possible value of the target --
# remember to invert the sense of the search
foreach $val (grep{!$list[$_]}1..9) {
$grid[$cntr] = $val;
grid_check();
}
# return and try next value
return $grid[$cntr] = 0;
}
# if we ever get this far then print the results
# silly to restart the clock for subsequent solutions since the firs
+t was
# the costly one.
sudoku_print();
return;
}
{
my ($solution) = 0;
sub sudoku_print {
my($cntr,$cell,$sudoku,$et);
$et = ($TIME ? ": ".time_format(elapsed_time()) : "");
$cntr = 0;
if($solution) {
$sudoku = "Solution $solution" . $et;
} else {
$sudoku = "Original Puzzle"
}
$sudoku .= "\n\n";
while ($cntr < 80) {
# print a row
for $cell($cntr..($cntr+8)) {
$sudoku .= $grid[$cell];
$sudoku .= ((($cell+1)%3) ? " " : " ");
}
$cntr += 9;
$sudoku .= (($cntr%27) ? "\n" : "\n\n");
}
$sudoku .= "\n";
print $sudoku;
$solution++;
}
}
sub time_format {
my ($et) = @_;
my ($hours,$min,$sec,$rtn);
$hours = int($et/3600);
$et -= (3600*$hours);
$min = int($et/60);
$et -= (60*$min);
$rtn .= sprintf "%dh",$hours if $hours;
$rtn .= sprintf "%02dm",$min if $min;
$rtn .= sprintf "%05.3fs",$et;
return $rtn;
}
# time fucntions
use Time::HiRes qw();
{
my ($start);
sub start_clock {
$start = [Time::HiRes::gettimeofday()];
}
sub elapsed_time {
return Time::HiRes::tv_interval($start);
}
}
main();
