FrickingNutz.com

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;
    }
}