Cookie Notice

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

2009/06/18

Return To The Other End

It was suggested in the comments that there was a better way to pass the history around, and the suggestion was correct. I tried Storable and was not able to make it do what I wanted, so I went with Clone.

The Revised Code

#!/usr/bin/perl

use Modern::Perl ;
use Clone qw(clone) ;
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 , \@array ) ;

#-------------------------------------------------------------------------------
sub solve_sudoku {
my $x = shift ; my $nx ;
my $y = shift ; my $ny ;
my $history = shift ;
my $local = clone( $history ) ;
return if ! test_solution( $local ) ; #0 if fail
my $current = $$local[$x][$y] ;
$nx = $x ;
$ny = $y + 1 ;
if ( $ny > 8 ) {
$ny = 0 ;
$nx = $x + 1 ;
}
exit if !defined $nx ;
exit if !defined $ny ;
if ( $current =~ m{\d}mx ) { # current position is filled
solve_sudoku( $nx , $ny , $local ) ;
}
else { # current possition is empty ;
for my $v ( 1 .. 9 ) {
$$local[$x][$y] = $v ;
solve_sudoku( $nx , $ny , $local ) ;
}
}
}
#-------------------------------------------------------------------------------

#-------------------------------------------------------------------------------
sub test_solution {
# If incomplete and wrong, return 0
# If incomplete and right, return 1
# If complete and right, exit and display
my $ptr_array = shift ; #pointer to a potentially solved puzzle

{ # Horizontal
for my $x (0 .. 8 ) {
my %error ;
for my $y ( 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 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 ;
}
#-------------------------------------------------------------------------------

#-------------------------------------------------------------------------------
sub display_puzzle {
my $ptr_array = shift ; #pointer to a potentially solved puzzle
say ' -------------' ;
for my $x ( 0 .. 8 ) {
print ' ' ;
for my $y ( 0 .. 8 ) {
my $v = $$ptr_array[$x][$y] ;
if ( $v !~ m{\d}mx ) { $v = '_' ; }
print $v ;
print ' ' if $y == 2 ;
print ' ' if $y == 5 ;
}
say '' ;
say '' if $x == 2 ;
say '' if $x == 5 ;
}
say ' ------------- ' ;
say '' ;
}
#-------------------------------------------------------------------------------


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

The main loop is much cleaner, and it works. Yay me! Yay readers! Yay Clone! Yay Perl! Next steps are to integrate this into a Sudoku maker, connect that via Ajax to my puzzle, and to to find good ways to input the puzzles in the first place.