Sudoku Puzzle Creater / Solver

Will create or solve Sudoku grid. Redirect the output into an html file and open with a browser. Interesting technical note: use of goto at line 278...so sue me!

 

#!/usr/bin/perl -w

# sudoku puzzle creator

my @grid = (
[ 1, 2, 3, 4, 5, 6, 7, 8, 9 ],
[ 4, 5, 6, 7, 8, 9, 1, 2, 3 ],
[ 7, 8, 9, 1, 2, 3, 4, 5, 6 ],

[ 5, 6, 7, 8, 9, 1, 2, 3, 4 ],
[ 8, 9, 1, 2, 3, 4, 5, 6, 7 ],
[ 2, 3, 4, 5, 6, 7, 8, 9, 1 ],

[ 9, 1, 2, 6, 7, 8, 3, 4, 5 ],
[ 3, 4, 5, 9, 1, 2, 6, 7, 8 ],
[ 6, 7, 8, 3, 4, 5, 9, 1, 2 ] );


# alternatively fill this array with a existing puzzle to need solved ( 0=values to find)
# and set $numberToRemove to 0 in the main program

#@grid = (
# [ 0, 0, 0, 0, 0, 0, 3, 0, 0 ],
# [ 2, 1, 3, 0, 0, 0, 5, 0, 7 ],
# [ 4, 0, 0, 7, 1, 0, 0, 0, 0 ],
# [ 8, 6, 0, 0, 9, 0, 0, 7, 0 ],
# [ 9, 0, 0, 5, 0, 0, 1, 2, 6 ],
# [ 0, 0, 5, 6, 0, 0, 0, 0, 0 ],
# [ 0, 0, 7, 0, 5, 4, 0, 3, 1 ],
# [ 0, 0, 0, 0, 0, 0, 0, 0, 0 ],
# [ 3, 0, 1, 0, 0, 6, 0, 0, 9 ] );

#@grid = (
# [ 7, 0, 0, 0, 0, 5, 3, 1, 0 ],
# [ 2, 1, 3, 0, 0, 0, 5, 0, 7 ],
# [ 4, 5, 0, 7, 1, 3, 0, 0, 0 ],
# [ 8, 6, 2, 3, 9, 1, 4, 7, 5 ],
# [ 9, 0, 4, 5, 0, 0, 1, 2, 6 ],
# [ 1, 0, 5, 6, 4, 2, 0, 0, 0 ],
# [ 6, 0, 7, 0, 5, 4, 0, 3, 1 ],
# [ 5, 0, 0, 1, 3, 0, 0, 0, 0 ],
# [ 3, 0, 1, 0, 0, 6, 0, 5, 9 ] );

JumbleGrid(@grid);

print "<table><tr><td>Starting grid...</td></tr></table>\n";
PrintGrid(@grid);


my $i;
my $numberToRemove = 35;
for ( $i=0; $i < $numberToRemove; $i++ ) {
$lastgoodgrid = $grid;
$rnd1 = int(rand()*9);
$rnd2 = int(rand()*9);
$grid[$rnd1][$rnd2] = 0;
}
$grid = $lastgoodgrid;

print "<table><tr><td>Grid with removed numbers...</td></tr></table>\n";
PrintGrid(@grid);

SolveGrid(map [@$_], @grid);

sub JumbleGrid {
@grid = @_;

for ( $j=0; $j<9; $j++ ) {
for ( $i=0; $i < 9; $i += 3 ) {
$rnd1 = int(rand()*3);
$rnd2 = int(rand()*3);

while ( $rnd1 == $rnd2 ) {
$rnd2 = int(rand()*3);
}
my $r1 = $i+$rnd1;
my $r2 = $i+$rnd2;
SwapRows($r1, $r2, @grid);
}

for ( $i=0; $i < 9; $i += 3 ) {
$rnd1 = int(rand()*3);
$rnd2 = int(rand()*3);

while ( $rnd1 == $rnd2 ) {
$rnd2 = int(rand()*3);
}
my $c1 = $i+$rnd1;
my $c2 = $i+$rnd2;
SwapCols($c1, $c2, @grid);
}
$rnd1 = int(rand()*8)+1;
$rnd2 = int(rand()*8)+1;

while ( $rnd1 == $rnd2 ) {
$rnd2 = int(rand()*8)+1;
}

SwapNumbers($rnd1, $rnd2, @grid);
}
return @grid;
}

sub PrintGrid {
print "<table border=\"1\">\n";
my @grid = @_;
for ( $y = 0; $y < 9; $y++ ) {
print "<tr>";
for ( $x = 0; $x < 9; $x++ ) {
if ( ( $grid[$x][$y] ) > 0 ) {
print "<td>".$grid[$x][$y] . "</td>";
} else {
print "<td> </td>";
}


if (( ($x+1) % 3 ) == 0 ) {
print "<td></td>";
}

}
if (( ($y+1) % 3 ) == 0 ) {
print "<tr><td colspan=\"11\"> </td></tr>\n";
} else {
print "</tr>\n";
}
}
}

sub PrintHelper {
print "<table border=\"1\">\n";
my @grid = @_;
for ( $y = 0; $y < 9; $y++ ) {
print "<tr>";
for ( $x = 0; $x < 9; $x++ ) {
if ( ( $grid[$x][$y] ) == 0 ) {
my @c = CheckSquare($x, $y, 0, @grid);
print "<td> @c </td>";
} else {
print "<td>".$grid[$x][$y]."</td>";
}


if (( ($x+1) % 3 ) == 0 ) {
print "<td></td>";
}

}
if (( ($y+1) % 3 ) == 0 ) {
print "<tr><td colspan=\"11\"> </td></tr>\n";
} else {
print "</tr>\n";
}
}
}



sub SwapRows {
my ( $row1, $row2, @grid ) = @_;
my $t;

for ( $x = 0; $x < 9; $x++ ) {
$t = $grid[$x][$row1];
$grid[$x][$row1] = $grid[$x][$row2];
$grid[$x][$row2] = $t;
}
}

sub SwapCols {
my ( $col1, $col2, @grid ) = @_;
my $t;

for ( $y = 0; $y < 9; $y++ ) {
$t = $grid[$col1][$y];
$grid[$col1][$y] = $grid[$col2][$y];
$grid[$col2][$y] = $t;
}
}



sub SwapNumbers {
my ( $num1, $num2, @grid ) = @_;

for ( $y = 0; $y < 9; $y++ ) {
for ( $x = 0; $x < 9; $x++ ) {
if ( $grid[$x][$y] == $num1 ) {
$grid[$x][$y] = $num2;
} else {
if ( $grid[$x][$y] == $num2 ) {
$grid[$x][$y] = $num1;
}
}
}
}
}


# check x,y co-ordinate and return numbers possible in this square
sub CheckSquare {
my ( $x, $y, $complexrules, @grid ) = @_;

my $i;

my @possibles = ( 0,1,1,1,1,1,1,1,1,1 );



# rule 1 - check the row
for ( my $i=0; $i < 9; $i++ ) {
$possibles[ $grid[$i][$y] ] = 0;
}

# rule 2 - check the column
for ( my $i=0; $i < 9; $i++ ) {
$possibles[ $grid[$x][$i] ] = 0;
}

# rule 3 - check the enclosing 3x3 grid
my $sx = (int( $x / 3 )) * 3;
my $sy = (int( $y / 3 )) * 3;

for ( my $i=0; $i < 3; $i++ ) {
for ( my $j=0; $j < 3; $j++ ) {
$possibles[ $grid[$sx+$i][$sy+$j] ] = 0;
}
}

# check what we've done...if we have a exact match then return
my @choice = ();
my $c = 0;

# go through possible values and pick out ones
for ( $i=1; $i <=9; $i++ ) {
if ( $possibles[$i] > 0 ) {
$choice[$c++] = $i;
}
}

# if we have an exact match dont bother with the complex rules
if ( scalar @choice == 1 ) {
return @choice;
}

if ( $complexrules ) {
if ( $x == 8 && $y == 1 ) {
print "\n";
}
# @choice contains matches so far, check if any of these appear just the once

# rule 4 - a unique number in 3x3 grid
$sx = (int( $x / 3 )) * 3;
$sy = (int( $y / 3 )) * 3;

%tNum = ();
@tCh = ();
for ( my $i=0; $i < 3; $i++ ) {
for ( my $j=0; $j < 3; $j++ ) {
my @tCh;
if ( $grid[$i][$j] == 0 ) {
@tCh = CheckSquare($i, $j, 0, @grid);
foreach my $myc ( @tCh ) {
$tNum{$myc}++;
}
}
}
}

# now check if any choices appear just once...

foreach my $tco ( @choice ) {
if ( exists ( $tNum{$tco} ) ) {
if ( $tNum{$tco} == 1 ) {
#print "Matched $tco at $x, $y using rule 4!\n";
@possibles = ( 0,0,0,0,0,0,0,0,0,0 );
$possibles[$tco] = 1;
goto FOUND;
}
}
}
# rule 5 - a unique number in row
%tNum = ();
@tCh = ();
for ( my $i=0; $i < 9; $i++ ) {
if ( $grid[$i][$y] == 0 ) {
@tCh = CheckSquare($i, $y, 0, @grid);
foreach my $myc ( @tCh ) {
$tNum{$myc}++;
}
}
}

foreach my $tco ( @choice ) {
if ( exists ( $tNum{$tco} ) ) {
if ( $tNum{$tco} == 1 ) {
#print "Matched to $tco at $x, $y using rule 6!\n";
@possibles = ( 0,0,0,0,0,0,0,0,0,0 );
$possibles[$tco] = 1;
goto FOUND;
}
}
}


# rule 6 - a unique number in col
%tNum = ();
@tCh = ();
for ( my $i=0; $i < 9; $i++ ) {
if ( $grid[$x][$i] == 0 ) {
@tCh = CheckSquare($x, $i, 0, @grid);
foreach my $myc ( @tCh ) {
$tNum{$myc}++;
}
}
}

foreach my $tco ( @choice ) {
if ( exists ( $tNum{$tco} ) ) {
if ( $tNum{$tco} == 1 ) {
#print "Matched to $tco at $x, $y using rule 6!\n";
@possibles = ( 0,0,0,0,0,0,0,0,0,0 );
$possibles[$tco] = 1;
goto FOUND;
}
}
}

}
FOUND:

@choice = ();
$c = 0;

#if ( $grid[$x][$y] != 0 ) {
# return @choice;
#}
# go through possible values and pick out ones
for ( $i=1; $i <=9; $i++ ) {
if ( $possibles[$i] > 0 ) {
$choice[$c++] = $i;
}
}

return @choice;
}

sub SolveGrid {
my @grid = @_;

# find square with smallest number of possibles

my $foundR;
my $foundC;
my @myChoices;

my $minVal = 10;

for ( my $c=0; $c < 9; $c++ ) {
for ( my $r=0; $r < 9; $r++ ) {
if ( $grid[$r][$c] == 0 ) {
@choices = CheckSquare($r, $c, 1, @grid );

if ( @choices < $minVal ) {
$minVal = @choices;
$foundR = $r;
$foundC = $c;
@myChoices = @choices;
}
}
}
}

if ( $minVal == 0 ) {
# jeeez! this grid gone screwy...try another approach
return 0;
}

if ( $minVal < 10 ) {
if ( scalar @myChoices > 1 ) {
print "<table><tr><td>Minimum number of choices at $foundR, $foundC [ @myChoices ]</td></tr></table>\n";
print "<table><tr><td>Current grid...</td></tr></table>\n";
PrintGrid(@grid);
print "<table><tr><td>Helper...</td></tr></table>\n";
PrintHelper(@grid);
}
foreach my $tryNum ( @myChoices ) {
$grid[$foundR][$foundC] = $tryNum;
if ( SolveGrid(map [@$_], @grid) ) {
last;
}
}
} else {
print "<table><tr><td>Solved!!</td></tr></table>\n\n";
PrintGrid(@grid);

return 1;
}
}