Friday, October 22, 2010

Sudoku in Perl5 #2 - Optimizing the Perl5 implementation

The test in BruteForceTest irritated me .. iterating across the whole row, testing each cell to see if it was the cell we didn't want to test against. And same for each row of the column, and each cell of the block. All those repeated tests must add up to a lot of wasted time, right?

So I came up with BruteForceRange, which doesn't iterate over the whole row, only the portions to the left and right of the current cell. In the column, it iterates over the cells above and below ... the block test is more complicated, we'll get to it.

The program is mostly the same as BruteForceTest. The first difference is the name changes:

package BruteForceRange;

Instead of specifying 0..8 for the row or column for loop ...

for my $c ( 0 .. 8 ) {
next CELL # don't test against self.
if $c == $col;

the new version specifies a portion to the left, and a portion to the right. This is possible because ranges in Perl must increment, a left boundary greater than the right one is an empty range.

for my $c ( 0..$col-1,$col+1..8 ) {

We no longer need a test, let alone 8 tests that fail. Test_col() is similar, iterating over the rows above and below, but not the actual one we're testing against. test_block() is more complicated. Instead of the former nested block:

for my $r ( $baserow .. $baserow + 2 ) {
CELL:
for my $c ( $basecol .. $basecol + 2 ) {
next CELL # don't test against self.
if $r == $row and $c == $col;

We still have to iterate over all the rows. If we're not in the test row, scan all the columns, but in the test row, scan only the rows above and below the test column. The ternary operator : test ? value-if-test-was-true : value-if-test-was-false is the compact solution. Using a two-part range within the ternary operator generates an error, unless you add parentheses to delimit the list ... or maybe it's to clarify the bounds of the if-true portion of the operator.

for my $r ( $baserow .. $baserow + 2 ) {
CELL:
for my $c ( $r == $row
? ($basecol..$col-1,$col+1..$basecol + 2)
: $basecol .. $basecol + 2 ) {

If the ternary operator combines with the split range freaks you out, an alternative would be to calculate the range between the loops and store the lements in an array:

for my $r ( $baserow .. $baserow + 2 ) {
CELL:
my @columns = ( $r == $row
? ($basecol..$col-1,$col+1..$basecol + 2)
: $basecol .. $basecol + 2
);
for my $c ( @columns ) {


I won't show you the driver program I used while testing and verifying the module, it's just like the other one only with slightly different names. More interesting is a program to compare the results:

use BruteForceRange;
use BruteForceTest;
use Benchmark qw/:all/;

my $ARGS = { input =>
'010056207'
. '000700005'
. '000300498'
. '000200380'
. '006000700'
. '051007000'
. '684002000'
. '100003000'
. '305460020'
};

cmpthese( -60, {
BruteForceTest => sub { BruteForceTest->new( $ARGS )->solve; },
BruteForceRange => sub { BruteForceRange->new( $ARGS )->solve; },
}
);

new() returns an object for the specified puzzle, which is then told to solve itself. Since we're not going to look at the results, but only solve the problem over and over to see how fast it is, that's the simplest arrangement, and keeps the cmpthese call short. If the first argument to cmpthese is a positive number, it's a count of how many runs to perform; a negative number is the number of seconds to spend running the specified block ... in this case, each version is tested over and over for 15 seconds.

The results? It's a tie! In fact, the superfluous tests are a fraction faster that than the split range, 27.7 reps/second compared to 27.4 reps/second. That's on a 2.66 GHz Mac Pro tower with one Nehalem ( i7 ) processor and 12 GB of 1066 MHz DD3 memory sitting around doing nothing.

bash-3.2$ perl5.10 compare.pl
Rate BruteForceRange BruteForceTest
BruteForceRange 27.4/s -- -1%
BruteForceTest 27.7/s 1% --
bash-3.2$

Thursday, October 21, 2010

Sudoku in Perl5 #1 - a brute-force solution

Having written the Perl6 Sudoku solver, I decided to go back to the Perl5 version I wrote when I was experimenting with Moose, but I couldn't find where I put it. While waiting for my senile memory to function, I implemented a brute-force solution. The basic concept of the brute-force approach is that you begin with a grid, some cells of which have been defined by the puzzle designer. I begin with the first empty cell ( call it A) and set it to '1'. I check to see if that conflicts with any already specified cells in the same row, in the same column, in the same block. If there's a conflict, I try the next element in the list of possible values : 2, 3..9. If a value does not conflict with existing cells, then on to the next cell. If all values create a conflict, then an earlier cell must have the wrong value, so back up. By recursively calling a routine over and over, backing up is easy, just return. If we run out of cells to the right, advance to the next row; when we run out of rows, the puzzle is solved. At that point, return a true value, and all the recursion unrolls in victory.

I call this version BruteForceTest, because, when testing the row, column and block, you don't want to compare a cell against itself. Thee simple way to avoid that is to iterate over the whole list, and test whether we are comparing the cell against itself.


BruteForceTest.pm





package BruteForceTest;

use warnings;
use strict;

sub new {
my ($class) = shift;
my $self = bless {}, $class;

$self->_init(@_);
return $self;
}

sub _init {
my $self = shift;
my ($args) = @_;

die( __PACKAGE__
. "constructors requires arg 'input'.\n" )
unless exists $args->{input}
and defined $args->{input};
my (@digits) = ( $args->{input} =~ m{(\d)}xmsg );
die( __PACKAGE__
. q{constructor arg 'input' must be 81 }
. ' digits, 1..9, with 0 for empty cells. '
. 'Line breaks and spaces are allowed.'
. "\n"
) unless 81 == scalar @digits;
for my $row ( 0 .. 8 ) {
for my $col ( 0 .. 8 ) {
my $digit = shift @digits;
$self->{set}{$row}{$col}++
if $digit >= 1 and $digit <= 9;
$self->{grid}[$row][$col] = $digit;
}
}
}


I've never used a copy constructor in 12 years of Perl programming, so I don't bother with that ref $class or $class stuff, but I do move all the initialization into an _init method, so subclasses can override. In the last couple of years I've begun to shift the object off @_; that way, I can x the argument list in the debugger, without having a flood of junk from $self.

My constructor expects a single argument, a hash ref, with the key input and a single string as the value. Then I extract all the digits from the string into an array. I considered a couple of options, considered allowing multi-line input, considered accepting a dot , '.', or space for a zero, but then decided sticking to digits meant I could grep the digits out of a longer string. I also considered a routine to read from a file, but my priority is to compare the different versions from a single driver program, so I didn't really need that. Any file reader would go in main() rather than in the individual solver modules.

Having verified the right number of digits, I scan through the set, assigning them one by one into an array of arrays. If the value is a zero, it's still waiting to be solved. Digits one through nine are values set by the designer, pre-conditions i must not alter during the solving process, so I also set use the row and column indices to set a hash, indicating protected cells.

sub solve {
my $self = shift;
my ( $r, $c ) = @_;

$r ||= 0;
$c ||= 0;

return 1 if $r >= 9;
return $self->solve( successor( $r, $c ) )
if $self->{set}{$r}{$c}; # skip pre-spec sell
VALUE:
for my $value ( 1 .. 9 ) {
$self->{grid}[$r][$c] = $value;
next VALUE
unless $self->cell_value_ok( $r, $c );
return 1
if $self->solve( successor( $r, $c ) )
}
$self->{grid}[$r][$c] = 0;
return;
}

I'm going to call solve() recursively, to process each next cell. The first call, from main(), shouldn't be encumbured by arguments, but the default values are trivial to assign. At one time I would have tested for the end of the puzzle when incrementing the indices ... that's the way I was taught, but that seems so C, so Pascal, now. It's simple to check the row index at the top of solve(), and more in the style of functional languages. If the index is too large, we've reached the end of the puzzle, and can return the victory signal.

If the current cell is one of the pre-specified cells, all we need do is solve the rest of the puzzle, and return the success or failure of that effort. Otherwise, try the values one through nine, in the current cell. If cell_value_ok() detects a conflict, try the next value in the list, but if it's alright for now, see if the rest of the puzzle is solvable with the current conditions. If we get a failure back, try the next value. If the last value fails, we must have gone wrong earlier, so set the current cell back to zero, and back up a space. Returning true from solve() indicates success, false indicates failure.

sub cell_value_ok {
my $self = shift;
my ( $r, $c ) = @_;

return unless $self->test_row( $r, $c );
return unless $self->test_col( $r, $c );
return unless $self->test_block( $r, $c );
return 1;
}
sub test_row {
my $self = shift;
my ( $row, $col ) = @_;

my $val = $self->{grid}[$row][$col];

CELL:
for my $c ( 0 .. 8 ) {
next CELL # don't test against self.
if $c == $col;
return # collision
if $val == $self->{grid}[$row][$c];
}
return 1; # ok
}

cell_value_ok returns success if there is no conflict between the value in cell $r, $c and the other values in the row, in the column, and in the block. test_row() demonstrates the concept: For each cell in the row, skipping over column $c, return a failure if the values match. If no conflict are present, return success. test_col() looks the same, except for swapping row and column. I considered merging the two routines into one, with some indication of which way to process, but merging test_block as well would be difficult. A little redundancy only makes the program slightly larger, but this module is so tiny, it can't take more than a single block to read it in. So there's no advantage besides clean coding, to merging, and there may be some performance to be gained.

sub test_col {
my $self = shift;
my ( $row, $col ) = @_;

my $val = $self->{grid}[$row][$col];

CELL:
for my $r ( 0 .. 8 ) {
next CELL # don't test against self.
if $r == $row;
return # collision
if $val == $self->{grid}[$r][$col];
}
return 1; # ok
}

sub test_block {
my $self = shift;
my ( $row, $col ) = @_;

my $baserow = 3 * int( $row / 3 ); # 0, 3 or 6
my $basecol = 3 * int( $col / 3 );

my $val = $self->{grid}[$row][$col];

for my $r ( $baserow .. $baserow + 2 ) {
CELL:
for my $c ( $basecol .. $basecol + 2 ) {
next CELL # don't test against self.
if $r == $row and $c == $col;
return # collision
if $val == $self->{grid}[$r][$c];
}
}
return 1; # ok
}

test_block() is a bit more complicated. Each cell is in one of 9 sub-blocks, the first row and first column of the sub-block can only be zero, three or six. So divide the cell's row or column number by 3 and keep only the integer part, multiply by three again, and you have the first row/column value. Just consider that row and the next two, that column and the next two, and you've coverd the sub-block.

sub successor {
my ( $r, $c ) = @_;

if ( $c == 8 ) {
$r++;
$c = 0;
}
else {
$c++;
}
return ( $r, $c );
}

Figuring out the next cell is fairly simple. If we've reached column 8, it's time to advance to the first column of the next row, otherwise just go to the next column.

sub print_answer {
my $self = shift;

print "\n\n";
for my $r ( 0 .. 8 ) {
for my $c ( 0 .. 8 ) {
print $self->{grid}[$r][$c];
print q{ }
if $c % 3 == 2;
}
print "\n";
print "\n"
if $r % 3 == 2;
}
}
1;

Finally, a routine to display the grid as it is at the moment. Blank spaces and empty rows division the matrix into sub-blocks, cleaner than using lines. Admittedly, lines, and dots or zeroes or underscores, rather than empty spaces, for unsolved cells, would be helpful if debugging a partially complete solution, so you can determine the location of a value more easily. But for simple display purposes, less is more.

BruteForceTest.pl




use BruteForceTest;

use warnings;
use strict;

my $puzzle = BruteForceTest->new(
{
input => (
'010056207'
. '000700005'
. '000300498'
. '000200380'
. '006000700'
. '051007000'
. '684002000'
. '100003000'
. '305460020'
),
}
);
$ouzzle->print_answer;
$puzzle->solve;
$puzzle->print_answer;

The main-line is to demonstrate that the program works ...
Create a puzzle with a particular value. Print out the initial conditions, solve the puzzle, and print the result. The display looks like this, running it with time to estimate performance:

010 056 207
000 700 005
000 300 498

000 200 380
006 000 700
051 007 000

684 002 000
100 003 000
305 460 020



418 956 237
923 784 615
567 321 498

749 215 386
236 849 751
851 637 942

684 192 573
192 573 864
375 468 129

real 0m0.139s
user 0m0.041s
sys 0m0.005s

So overall it takes 1/7 seconds of clock time, of which 1/25 seconds is real and only 5/1000 seconds is spent running the CPU. This is my desktop, not the laptop which spent 42 seconds running the Perl6 version, so direct comparisons are pointless, but obviously there are some efficiencies still to be implemented in Perl6.