Cookie Notice

As far as I know, and as far as I remember, nothing in this page does anything with Cookies.

2009/06/17

Sudoku from the Other End

Previously, we talked about Sudoku in terms of creating the gameplay part, making a user interface for it. That's one part of the problem.

It has been theorized that people don't really like learning, they like it when they get thing, which is why high school sucks. I do know that when I'm not solving problems at work and wish to remind my brain what solving problems feels like, I start playing Sudoku. And on occasion, there are Sudoku puzzles that I just cannot get.

At this point, I will say that I don't quite get the story of John Henry. There's a job that's tough, that's back-breaking work. John Henry was good at it, the best there was. The company thinks that crippling men and sending them to an early grave doesn't pay and brings in a machine to do that job. John Henry challenges the machine, they go head-to-head, and John Henry, the best there was, beats the machine, but dies at the end. So the one man who can beat the machine is in a pine box, with his widow left to care for his orphan children, and this is somehow a win. With some modification, I could see this turned into a sort of Luddite anti-machine parable, but as it stands, it just doesn't work like that.

I do Sudoku to pass my time and exercise my mind. I know I can't beat the machine. "Varlo Grant is a number-crunchin' man, Lord, Lord. Varlo is a number-crunchin' man."

How do people solve Sudoku puzzles? I can tell you how I do it. There are two different ways of deciding if a number should be in a place. Either a number must be there, or a number cannot be anywhere else. I go for as many "must be there" numbers as I can, with each number limiting the number of possibilities for other numbers, giving me more "must be there" numbers. Eventually I come to the point where I start seeing "can't be elsewhere" places, where there's many open spots but the 8 can only be in one of 'em. And once I finish with all the things that have to be there, there's loops where two numbers are left and I have to choose one and see if it works out.

I use gnome-sudoku as I use a Gnome desktop, although sometimes I do puzzles on paper. Either way, there's note-taking. There is, to use a computer science term, state. If I put something down wrong, I have to erase everything about that. On paper, multiple erasures look bad and eventually tear away the paper. On the computer, it's easier, but still, there is a penalty for being wrong, if only in my head, which makes you careful about guessing. Basically, you guess when you can no longer prove. This works well for the human mind. I think this can be abstracted to other human activities. People improvise on guitars because the cost of blowing a note is only temporary embarrassment. People don't improvise so much in designing buildings because the cost of blowing architecture is several months of time, several million dollars and possibly several lives.

Computers, on the other hand, don't care. Depending on your algorithm, your state is ephemeral, tossed away as soon as as you know it's wrong.

Basically, take a position (in a specific and set order — tried a more chainy algorithm based upon my Boggle code [which I might post and discuss later], but it sucked), make a guess, check the state and go on. The key is to make the state passable. I'll get into details in a bit, but early on I tried copying an array. A Sudoku puzzle is a 9x9 square, which implies a 9x9 multidimensional array. But Perl, the implementation language I used, does not have multidimensional arrays. It has arrays of arrays. Assuming $array[0][1] = 2, @array is an array of pointers to anonymous arrays, and the second value in the first anonymous array (remember, computer people start counting at 0). The practical upside of this is that my @new_array = @array doesn't recreate the multidimensional array. It passes a set of pointers to anonymous arrays from one array to another. So, my choice was to make a scalar value holding the state that can easily be broken up into an array, rather than passing arrays around.

This is the "main" of my Sudoku Solver.

#!/usr/bin/perl

use Modern::Perl ;
use subs qw{ solve_sudoku test_solution display_puzzle no_go_list } ;

my @array ;
my @test ;
my $x = 0 ;
my $debug = 0 ;
my $outcount = 0 ;

#READ IN DATA
while ( my $line = ) {
chomp $line ;
$line =~ s{\D}{ }mxg ;
my @line = split m{|}mx , $line ;
for my $y ( 0 .. 8 ) {
if ( $line[$y] =~ m{\d}mx ) { $array[$x][$y] = $line[$y] ; }
else { $array[$x][$y] = '' ; }
}
$x++ ;
}

solve_sudoku( 0 , 0 , '' ) ;
exit 0 ;
#===============================================================================

__DATA__
9__3____6
_8______7
__52_89__
__8__4_73
_9_____4_
76_1__2__
__78_14__
1______5_
8____9__1
Modern::Perl for the win. Thanks, chromatic. Not that I probably couldn't get this working better, but we'll go with what we have. And I probably could cleans some unused variables from this section, but so be it. If I wanted to read in puzzles from standard in or something, I would've done something with Getopt::Long, but that wasn't the part that interested me.

One thing you might notice is that I start at position 0,0 when, in the data set, there's already a value in 0,0. The algorithm has to be able to handle the existing numbers.

#-------------------------------------------------------------------------------
sub solve_sudoku {
my $x = shift ;
my $y = shift ;
my $nx ;
my $ny ;
my $history = shift ;
my @tmp_array ;

# MAKE TEMP ARRAY
for my $a ( 0 .. 9 ) {
for my $b ( 0 .. 9 ) {
$tmp_array[$a][$b] = $array[$a][$b] ;
}
}

# FILL TEMP ARRAY
for my $tmp ( split m{\s}mx , $history ) {
if ( $tmp =~ /\d\d\d/ ) {
my ( $xx , $yy , $vv ) ;
$tmp =~ m{(\d)(\d)(\d)}mx ;
$xx = $1 ; $yy = $2 ; $vv = $3 ;
my $v = $tmp_array[$xx][$yy] =~ m{\d}mx ;
if ( $tmp_array[$xx][$yy] =~ m{\d}mx ) {
$debug and say ' FAIL EXISTS ' . $xx . $yy . $v ;
return 0 ;
}
$tmp_array[$xx][$yy] = $vv ;
}
}
return if ! test_solution( \@tmp_array ) ; #0 if fail

#my @no_go = no_go_list 0 , 0 , \@tmp_array ;

# SHOW CURRENT STATE
#say 'X: ' . $x ;
#say 'Y: ' . $y ;
#say 'No-go: ' . join ',' , @no_go ;
#display_puzzle \@tmp_array ;

my $current = $tmp_array[$x][$y] ;
$nx = $x ;
$ny = $y + 1 ;
if ( $ny > 8 ) {
$ny = 0 ;
$nx = $x + 1 ;
}
if ( $current =~ m{\d}mx ) { # current position is filled
solve_sudoku( $nx , $ny , $history ) ;
}
else { # current possition is empty ;
for my $v ( 1 .. 9 ) {
$tmp_array[$x][$y] = $v ;
# next if grep m{$v} , @no_go ;
solve_sudoku( $nx , $ny , $history . ' ' . $x . $y . $v ) ;
}
}
}
#-------------------------------------------------------------------------------
There is dyked-out code for displaying each iteration. That was primarily for debugging and should really be put in an if ( $debug ) {} block. There's also a @no_go list created. I don't have the bugs worked out, and I've found this works acceptably fast without it, so I kept it out. So, I recreate and test the current state, decide on the next position, iterate through the possible values for that position (1 through 9) and jump to that. Recursion and iteration where each makes sense.

So, Dave, where do you know if you've solved it? In test_solution(), of course.


) {
next if $val =~ m{\D}mx ;
$error{ $val }++ ;
}
}
for my $e ( sort keys %error ) {
if ( $error{$e} > 1 && $e =~ m{\d}mx ) {
$debug and say 'FAIL HORIZONTAL ' . $e ;
return 0 ;
}
}
}
}

{ # Vertical
for my $y ( 0 .. 8 ) {
my %error ;
for my $x ( 0 .. 8 ) {
my $val = $$ptr_array[$x][$y] ;
if ( defined $val ) {
next if $val =~ m{\D}mx ;
$error{ $val }++ ;
}
}
for my $e ( sort keys %error ) {
if ( $error{$e} > 1 && $e =~ m{\d}mx ) {
$debug and say 'FAIL VERTICAL ' . $e ;
return 0 ;
}
}
}
}

{ # blocks
my @range ;
$range[0][0] = 0 ; $range[0][1] = 1 ; $range[0][2] = 2 ;
$range[1][0] = 3 ; $range[1][1] = 4 ; $range[1][2] = 5 ;
$range[2][0] = 6 ; $range[2][1] = 7 ; $range[2][2] = 8 ;

for my $a ( 0 ..2 ) {
for my $b ( 0 ..2 ) {
my @x = $range[$a] ;
my @y = $range[$b] ;
my %error ;
for my $i ( 0 .. 2 ) {
for my $j ( 0 .. 2 ) {
my $x = $range[$a][$i] ;
my $y = $range[$b][$j] ;
my $val = $$ptr_array[$x][$y] ;
if ( defined $val ) {
next if $val =~ m{\D}mx ;
$error{ $val }++ ;
}
}
}
for my $e ( sort keys %error ) {
if ( $error{$e} > 1 && $e =~ m{\d}mx ) {
$debug and say 'FAIL BLOCK ' . $e ;
return 0 ;
}
}
}
}
}

{ # ALL GOOD
my $c = 0 ; #numberof numbers in array
for my $y ( 0 .. 8 ) {
for my $x ( 0 .. 8 ) {
my $val = $$ptr_array[$x][$y] ;
if ( defined $val && $val =~ m{\d}mx ) {
$c++ ;
}
}
}
if ( $c == 81 ) {
say 'GOOD' ;
display_puzzle $ptr_array ;
exit ;
}
}
return 1 ;
}
#-------------------------------------------------------------------------------


Adapted from my test code from the previous Sudoku problem, but instead of having to highlight all the positions where I fail, I just have to admit "I fail" and return 0. Makes for one fewer loop for each test, which is good. If I don't fail, I succeed, so I end with return 1 to announce that. And, after the possible fails and the return, I count the filled spaces. If there are ( 9 x 9 = ) 81 filled squares, then the puzzle is solved, so I display the solution and exit.

The real hero to the story of John Henry, I think, is the guy who invented and built the steel-driving machine, the man whose intellectual sweat made it so that nobody had to work themselves to an early grave. Of course, you now have to find something to do with all the people who are no longer killing themselves to death driving steel. But that seems a bit far afield and too philosophical for a coding blog.

2 comments:

  1. cloning nested structures in Perl can be done with Storable (core) or Clone.

    ReplyDelete
  2. Wow. Thank you. Good to know.

    ReplyDelete