Sudoku

#!/usr/bin/perl -w # sudoku.pl, a perl CGI script to create and solve Sudoku puzzles # Copyright (C) 2005-06-02 Christian Wolff # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. # Or, download it from http://www.gnu.org/copyleft/gpl.html # # You can reach the author via email: sub-gpl scara.com # use strict; my $script = $ENV{'SCRIPT_NAME'} . '?'; # get CGI parameter: 8 digit date, new selection my %query = (); my %queryraw = (); my $query = $ENV{'QUERY_STRING'}; chomp $query; for (split (/&/, $query)) { if (/=/) { my ($param,$content) = split(/=/, $_, 2); $queryraw{$param} = $content; $content =~ tr/+/ /; $content =~ s/%([0-9a-fA-F]{2})/pack('c',hex($1))/ge; $query{$param} = $content; } else { $query{'sel'} = $_; } } $query{'type'} = 'S' unless $query{'type'}; $script .= 'type=' . $query{'type'} . '&'; if ($query{'map'}) { if (length($query{'map'}) < 9) { $query{'map'} .= substr('123456789', length($query{'map'}), 9 - length($query{'map'})); $queryraw{'map'} = $query{'map'}; #TODO $queryraw{'map'} = s/./% } } else { $query{'map'} = '123456789'; $queryraw{'map'} = $query{'map'}; } $script .= 'map=' . $queryraw{'map'} . '&'; $query{'sel'} = '' unless $query{'sel'}; # print HTTP header print "MIME-Version: 1.0\nContent-Type: text/html\n"; print "\n"; # print HTML header print < Sudoku END my @field = (); my @cut = (); sub map_cell { my $n = shift; if ($n eq ' ') { return ' '; } elsif (($n >= 1) && ($n <= 9)) { return substr($query{'map'}, $n - 1, 1); } else { return $n; } } # cell with potential numbers sub print_pot_cell { my ($mask, $row, $col) = @_; my ($x, $y, $n, $i); $i = 0; print ""; for ($x = 0; $x < 3; $x++) { print ""; for ($y = 0; $y < 3; $y++) { $n = 1 + $x * 3 + $y; print ""; } print ""; } print "

"; if ($mask & (1 << ($n - 1))) { $i++; print " " . map_cell($n) . " "; } else { print " "; } if (($n == 9) && ($i == 2)) { print " G "; } print "

\n"; } # dummy cell with all numbers sub print_dum_cell { my ($x, $y, $n); print ""; for ($x = 0; $x < 3; $x++) { print ""; for ($y = 0; $y < 3; $y++) { $n = 1 + $x * 3 + $y; print ""; } print ""; } print "

"; print " " . map_cell($n) . " "; print "

\n"; } # final cell with one big number sub print_fin_cell { my ($n, $color, $link) = @_; print "" if $link; print "
" . map_cell($n) . "
"; print "" if $link; print "\n"; } # sole cell for solution grid sub print_sol_cell { my ($n, $color) = @_; print " " . map_cell($n) . " \n"; } sub print_cell { my ($mask, $row, $col, $level) = @_; my ($i, $n); $n = 0; for ($i = 0; $i < 9; $i++) { if ($mask & (1 << $i)) { if ($n) { print_pot_cell($mask, $row, $col); return; } else { $n = $i + 1; } } } if ($level == 0) { print_fin_cell( $n ? $n : 'X', ! $n ? 'orange' : ($mask & 512) ? 'red' : 'black', ($mask & 512) ? "sel=$cut[$row][$col]" : ''); } elsif ($level == 1) { if ($mask & 512) { print_fin_cell($n ? $n : 'X', ! $n ? 'orange' : 'red', "sel=$cut[$row][$col]"); } else { print_fin_cell(' ', 'white', ''); # print_dum_cell(); } } elsif ($level == 2) { print_sol_cell($n ? $n : 'X', ! $n ? 'orange' : ($mask & 512) ? 'red' : 'black'); } } sub print_table { my $level = shift; my ($row, $col); print "\n"; for ($row = 0; $row < 9; $row++) { print "\t\n"; for ($col = 0; $col < 9; $col++) { print "\t\t\n"; print "\t\t\n" if ($col == 2) || ($col == 5); #print "\t\t\n" if ($col == 2) && ($row == 0); #print "\t\t\n" if ($col == 5) && ($row == 0); #print "\t\t\n" if ($col == 2) && ($row == 3); #print "\t\t\n" if ($col == 5) && ($row == 6); } print "\t\n"; print "\t\n" if ($row == 2) || ($row == 5); #print "\t\n" if $row == 2; #print "\t\n" if $row == 5; } print "

\n\t\t\t"; print_cell($field[$row][$col], $row, $col, $level); print "\t\t

\n"; } # eliminate same number in row, column and segment sub elim { my $ret = 0; my $n = shift; my ($r, $c, $row, $col, $i); my $b = 1 << ($n - 1); for ($r = 0; $r < 9; $r++) { for ($c = 0; $c < 9; $c++) { next unless (($field[$r][$c] & 511) == $b); my $m = 1023 - $b; for ($row = 0; $row < 9; $row++) { if (($row != $r) && ($field[$row][$c] & $b)) { $field[$row][$c] &= $m; $ret |= 2; for ($i = 0; $i < 9; $i++) { $ret |= elim($i + 1) if (($field[$row][$c] & 511) == (1 << $i)); } } } for ($col = 0; $col < 9; $col++) { if (($col != $c) && ($field[$r][$col] & $b)) { $field[$r][$col] &= $m; $ret |= 4; for ($i = 0; $i < 9; $i++) { $ret |= elim($i + 1) if (($field[$r][$col] & 511) == (1 << $i)); } } } my ($ro, $co); $ro = $r - ($r % 3); $co = $c - ($c % 3); for ($row = 0; $row < 3; $row++) { for ($col = 0; $col < 3; $col++) { if ((($ro + $row != $r) || ($co + $col != $c)) && ($field[$ro + $row][$co + $col] & $b)) { $field[$ro + $row][$co + $col] &= $m; $ret |= 8; for ($i = 0; $i < 9; $i++) { $ret |= elim($i + 1) if (($field[$ro + $row][$co + $col] & 511) == (1 << $i)); } } } } if ($query{'type'} eq 'X') { if ($r == $c) { for ($row = 0; $row < 9; $row++) { if (($row != $r) && ($field[$row][$row] & $b)) { $field[$row][$row] &= $m; $ret |= 8192; for ($i = 0; $i < 9; $i++) { $ret |= elim($i + 1) if (($field[$row][$row] & 511) == (1 << $i)); } } } } if ($r == 8 - $c) { for ($row = 0; $row < 9; $row++) { if (($row != $r) && ($field[$row][8 - $row] & $b)) { $field[$row][8 - $row] &= $m; $ret |= 8192; for ($i = 0; $i < 9; $i++) { $ret |= elim($i + 1) if (($field[$row][8 - $row] & 511) == (1 << $i)); } } } } } } } return $ret; } # eliminate twins and triplets sub twin_elim { my $ret = 0; my ($n, $b, $m, $r, $ro, $row, $c, $co, $col, $i, @comb, $o1, $o2); for ($ro = 0; $ro < 9; $ro += 3) { for ($co = 0; $co < 9; $co += 3) { for ($n = 0; $n < 9; $n++) { $b = 1 << $n; $m = 1023 - $b; for ($row = 0; $row < 3; $row++) { $comb[$row] = 0; for ($col = 0; $col < 3; $col++) { $comb[$row] |= $field[$ro + $row][$co + $col]; } } for ($row = 0; $row < 3; $row++) { $o1 = ($row + 1) % 3; $o2 = ($row + 2) % 3; if (($comb[$row] & $b) && (! ($comb[$o1] & $b)) && (! ($comb[$o2] & $b))) { for ($col = 0; $col < 9; $col++) { if (($col < $co) || ($col >= $co + 3)) { if (($field[$ro + $row][$col] & $b) && ($field[$ro + $row][$col] & 511 & $m)) { $field[$ro + $row][$col] &= $m; $ret |= 16; } } } } } for ($col = 0; $col < 3; $col++) { $comb[$col] = 0; for ($row = 0; $row < 3; $row++) { $comb[$col] |= $field[$ro + $row][$co + $col]; } } for ($col = 0; $col < 3; $col++) { $o1 = ($col + 1) % 3; $o2 = ($col + 2) % 3; if (($comb[$col] & $b) && (! ($comb[$o1] & $b)) && (! ($comb[$o2] & $b))) { for ($row = 0; $row < $ro; $row++) { if (($row < $ro) || ($row >= $ro + 3)) { if (($field[$row][$co + $col] & $b) && ($field[$row][$co + $col] & 511 & $m)) { $field[$row][$co + $col] &= $m; $ret |= 32; } } } } } } } } return $ret; } # eliminate paired numbers in row, column and segment sub pair_elim { my ($r, $c, $row, $col, $i, $b, $n); my $ret = 0; for ($r = 0; $r < 9; $r++) { for ($c = 0; $c < 9; $c++) { $b = $field[$r][$c] & 511; $n = 0; for ($i = 0; $i < 9; $i++) { $n++ if $b & (1 << $i); } next unless $n == 2; my $m = 1023 - $b; $n = 0; for ($row = 0; $row < 9; $row++) { if (($row != $r) && (($field[$row][$c] & 511) == $b)) { last if $n; $n = $row + 1; } } if ($n) { for ($row = 0; $row < 9; $row++) { if (($row != $r) && ($row != ($n - 1)) && ($field[$row][$c] & $b)) { $field[$row][$c] &= $m; for ($i = 0; $i < 9; $i++) { if (($field[$row][$c] & 511) == (1 << $i)) { $ret |= elim($i + 1) | 64; } } } } } $n = 0; for ($col = 0; $col < 9; $col++) { if (($col != $c) && (($field[$r][$col] & 511) == $b)) { last if $n; $n = $col + 1; } } if ($n) { for ($col = 0; $col < 9; $col++) { if (($col != $c) && ($col != ($n - 1)) && ($field[$r][$col] & $b)) { $field[$r][$col] &= $m; for ($i = 0; $i < 9; $i++) { if (($field[$r][$col] & 511) == (1 << $i)) { $ret |= elim($i + 1) | 128; } } } } } my ($ro, $co, $rn, $cn); $ro = $r - ($r % 3); $co = $c - ($c % 3); ($rn, $cn) = (0, 0); for ($row = 0; $row < 3; $row++) { for ($col = 0; $col < 3; $col++) { if ((($ro + $row != $r) || ($co + $col != $c)) && (($field[$ro + $row][$co + $col] & 511) == $b)) { last if ($rn && $cn); $rn = $ro + $row + 1; $cn = $co + $col + 1; } } } if ($rn && $cn) { for ($row = 0; $row < 3; $row++) { for ($col = 0; $col < 3; $col++) { if ((($ro + $row != $r) || ($co + $col != $c)) && (($ro + $row != ($rn - 1)) || ($co + $col != ($cn - 1))) && ($field[$ro + $row][$co + $col] & $b)) { $field[$ro + $row][$co + $col] &= $m; for ($i = 0; $i < 9; $i++) { if (($field[$ro + $row][$co + $col] & 511) == (1 << $i)) { $ret |= elim($i + 1) | 256; } } } } } } } } return $ret; } sub def { my ($r, $c, $n, $s) = @_; $field[$r][$c] = 1024 | ($s ? 512 : 0) | (1 << ($n - 1)); return elim($n); } # find single number in segment sub seg_elim { my $ret = 0; my ($i, $m, $r, $ro, $row, $c, $co, $col); for ($i = 0; $i < 9; $i++) { for ($ro = 0; $ro < 9; $ro += 3) { for ($co = 0; $co < 9; $co += 3) { $m = 1 << $i; ($r, $c) = (0, 0); for ($row = 0; $row < 3; $row++) { for ($col = 0; $col < 3; $col++) { if ($field[$ro + $row][$co + $col] & $m) { $m = 0 if ($r || $c); last unless $m; ($r, $c) = ($ro + $row + 1, $co + $col + 1); } } last unless $m; } if ($m && $r && $c && (($field[$r - 1][$c - 1] & 511) != $m)) { $ret |= def($r - 1, $c - 1, $i + 1, 0) | 512; } } } } return $ret; } # find single number in row sub row_elim { my $ret = 0; my ($i, $m, $row, $c, $col); for ($i = 0; $i < 9; $i++) { for ($row = 0; $row < 9; $row++) { $m = 1 << $i; $c = 0; for ($col = 0; $col < 9; $col++) { if ($field[$row][$col] & $m) { $m = 0 if $c; last unless $m; $c = $col + 1; } } if ($m && $c && (($field[$row][$c - 1] & 511) != $m)) { $ret |= def($row, $c - 1, $i + 1, 0) | 1024; } } } return $ret; } # find single number in column sub col_elim { my $ret = 0; my ($i, $m, $r, $row, $col); for ($i = 0; $i < 9; $i++) { for ($col = 0; $col < 9; $col++) { $m = 1 << $i; $r = 0; for ($row = 0; $row < 9; $row++) { if ($field[$row][$col] & $m) { $m = 0 if $r; last unless $m; $r = $row + 1; } } if ($m && $r && (($field[$r - 1][$col] & 511) != $m)) { $ret |= def($r - 1, $col, $i + 1, 0) | 2048; } } } return $ret; } # find single number in column sub diag_elim { my $ret = 0; my ($i, $m, $r, $row); for ($i = 0; $i < 9; $i++) { $m = 1 << $i; $r = 0; for ($row = 0; $row < 9; $row++) { if ($field[$row][$row] & $m) { $m = 0 if $r; last unless $m; $r = $row + 1; } } if ($m && $r && (($field[$r - 1][$r - 1] & 511) != $m)) { $ret |= def($r - 1, $r - 1, $i + 1, 0) | 16384; } $m = 1 << $i; $r = 0; for ($row = 0; $row < 9; $row++) { if ($field[$row][8 - $row] & $m) { $m = 0 if $r; last unless $m; $r = $row + 1; } } if ($m && $r && (($field[$r - 1][9 - $r] & 511) != $m)) { $ret |= def($r - 1, 9 - $r, $i + 1, 0) | 16384; } } return $ret; } sub fill_field { my $ret = 0; my $sel = shift; my ($row, $col); # clear array for ($row = 0; $row < 9; $row++) { for ($col = 0; $col < 9; $col++) { $field[$row][$col] = 511; } } # step through 'sel' entries my $pre = ''; while ($sel =~ s/^(\d)(\d)(\d)//) { my ($r, $c, $n) = ($1, $2, $3); $ret |= def($r, $c, $n, 1); $cut[$r][$c] = $pre . $sel; $pre .= $r . $c . $n; } return $ret; } sub solve { my $ret = 0; my ($r, $rt, $ri, $i); my ($row, $col); do { $rt = 0; $ri = $ret; do { $r = seg_elim(); $rt |= $r; } while ($r); $ret |= $rt; if ($ret == $ri) { $ri = $ret; do { $r = row_elim(); $rt |= $r; } while ($r); $ret |= $rt; } if ($ret == $ri) { $ri = $ret; do { $r = col_elim(); $rt |= $r; } while ($r); $ret |= $rt; } if ($query{'type'} eq 'X') { if ($ret == $ri) { $ri = $ret; do { $r = diag_elim(); $rt |= $r; } while ($r); $ret |= $rt; } } if ($ret == $ri) { $ri = $ret; do { $r = twin_elim(); $rt |= $r; } while ($r); $ret |= $rt; } if ($ret == $ri) { $ri = $ret; do { $r = pair_elim(); $rt |= $r; } while ($r); $ret |= $rt; } if ($ret == $ri) { for ($i = 0; $i < 9; $i++) { $r = elim($i + 1); $rt |= $r; } $ret |= $rt; } } while $rt; return $ret; } sub check { my ($solved, $invalid) = (1, 0); my ($row, $col); for ($row = 0; $row < 9; $row++) { for ($col = 0; $col < 9; $col++) { my $i; my $n = 0; my $f = 0; for ($i = 0; $i < 9; $i++) { $n = $i + 1 if (($field[$row][$col] & 511) == (1 << $i)); } $solved = 0 unless $n; $invalid = 2 unless $field[$row][$col] & 511; } } return $invalid | $solved; } #$query{'add'} $query{'hide'} my $level = fill_field($query{'sel'}); $level |= solve(); my $solved = check() & 1; if ((! $solved) && defined($query{'guess'}) && ($query{'guess'} =~ /^(\d)(\d)$/)) { my ($row, $col) = ($1, $2); my ($a, $b, $i, $as, $bs); for ($i = 0; $i < 9; $i++) { if ($field[$row][$col] & (1 << $i)) { if ($a) { $b = 1 << $i; } else { $a = 1 << $i; } } } $level = fill_field($query{'sel'}); $field[$row][$col] = $a; $level |= solve(); $as = check(); $level = fill_field($query{'sel'}); $field[$row][$col] = $b; $level |= solve(); $bs = check(); if (($as == 1) && ($bs == 2)) { $level = fill_field($query{'sel'}); $field[$row][$col] = $a; $level |= solve(); $solved = $as & 1; $level |= 4096; } elsif (($bs == 1) && ($as == 2)) { $solved = $bs & 1; $level |= 4096; } else { $level = fill_field($query{'sel'}); $level |= solve(); } } print "\n"; print "

\n"; print_table($solved); print "

\n"; print "

\n"; print "(fold back to hide solution)
\n" if $solved; print "

\n"; print_table(2) if $solved; print "

\n"; #print "Difficulty level: "; #if ($level & 4096) { # if ($level & (64 | 128 | 256)) { # print '"Diabolical"'; # } else { # print '"Tough"'; # } #} elsif ($level & (64 | 128 | 256)) { # print '"Tough"'; #} elsif ($level & (16 | 32)) { # print '"Moderate"'; #} else { # print '"Gentle"'; #} #print "
\n"; print "Strategies used:\n"; print "

Row elimination
\n" if $level & 2; print "
Column elimination
\n" if $level & 4; print "
Box elimination
\n" if $level & 8; print "
Diagonal elimination
\n" if $level & 8192; print "
Twin/Triplet elimination in row
\n" if $level & 16; print "
Twin/Triplet elimination in column
\n" if $level & 32; print "
Pair elimination in row
\n" if $level & 64; print "
Pair elimination in column
\n" if $level & 128; print "
Pair elimination in box
\n" if $level & 256; print "
Single number in row
\n" if $level & 1024; print "
Single number in column
\n" if $level & 2048; print "
Single number in box
\n" if $level & 512; print "
Single number in Diagonal
\n" if $level & 16384; print "
Guessing among two
\n" if $level & 4096; print "

\n"; if (! $solved) { print "\n"; } print "

\n"; if ($solved) { print "

\n"; if ($query{'map'} =~ /^\d+$/) { print "Fill in numbers 1 trough 9.
\n"; print "Each number once per row,
\n"; } elsif ($query{'map'} =~ /^[a-zA-Z]+$/) { print "Fill in the letters " . join(',', split(//, $query{'map'})) . ".
\n"; print "Each letter once per row,
\n"; } else { print "Fill in the symbols " . join(',', split(//, $query{'map'})) . ".
\n"; print "Each symbol once per row,
\n"; } if ($query{'type'} eq 'X') { print "column, 3-by-3 box and
\n"; print "each of the two diagonals.

\n"; } else { print "column, and 3-by-3 box.

\n"; } } else { print "

\n"; print "Select a number from the choices in a cell.
\n"; print "Repeat, until puzzle is solvable.
\n"; print "If a 'G' appears in a cell, click it for guessing
(Works only if one choice solves and the other
ends in invalid puzzle.)
\n"; print "Click selected numbers to un-select.
\n"; print "An orange 'X' denotes an error, un-select
one or more numbers to fix the problem.\n"; print "

\n"; } print "

\n"; print "

\n"; print "\n"; print "\n";