I have written a Sudoku Solver in tcl/tk, and its equivalent in C. The C version solves a difficult one in about 1 milli-second on my machine (with a Core2 Duo 6600 @ 2.4GHz inside).
Download:
604000900 000070060 500002003 000100400 040020080 007008000 800900001 050030000 003000809
.\sudokuSolver002.exe < .\sample01.txtand the answer is printed.
No doubt there should be way better internal data representaions in terms of efficiency; For instance, instead of modifying bits of all the tiles affected every time, we should hold "candidate mask" for each column/row/box.
However, I think I should stop here --- I have a lot of stuff to work on other than this "sudoku solver", so spending hours on the algorithm itself is actually wasting my precious time, now I feel. Well, who knows. I might come back to this problem all of sudden ... but, maybe, not now.
# # Sudoku Solver # # Rev. 0.10 Apr. 18, 2009 zhuo --- sec. (reduction only) # Rev. 0.20 Apr. 19, 2009 zhuo 256 sec. "inference" introduced # Rev. 0.30 Apr. 19, 2009 zhuo 249 sec. string representation. # Rev. 0.40 Apr. 19, 2009 zhuo xxx better reducer? but failed. # takes 0.032 sec (c.f. 0.008 # at R0.30) # ...width-search is not so bad. # Rev. 0.50 Apr. 20, 2009 zhuo 243 sec yet another reducer: it answeres # ok or ng # Rev. 0.60 Apr. 22, 2009 zhuo 1.25 sec try branch-reducing in infer{} # OK. # Platform: # Mac/Windows/Linux and any platforms where Tcl/Tk runs. # # Preparation: # - Install Tcl/Tk. # - Save this text as xxx.tcl (xxx: any filename you like). # # How to run: # - Click xxx.tcl to start. # - Enter the numbers. You can use tab / shift-tab for traverse. # - Click "SOLVE" to have the answer. # - Click "EXIT" to quit. array set ::D {} # inference necessary set ::sample { 6 "" 4 "" "" "" 9 "" "" "" "" "" "" 7 "" "" 6 "" 5 "" "" "" "" 2 "" "" 3 "" "" "" 1 "" "" 4 "" "" "" 4 "" "" 2 "" "" 8 "" "" "" 7 "" "" 8 "" "" "" 8 "" "" 9 "" "" "" "" 1 "" 5 "" "" 3 "" "" "" "" "" "" 3 "" "" "" 8 "" 9 } # inference not necessary set ::sample1 { "" 6 3 "" 5 "" "" "" "" "" 4 "" 2 "" "" 8 6 "" "" "" "" 6 "" "" "" 4 "" "" "" "" 4 "" "" "" 2 "" 5 2 "" 3 "" 6 "" 8 9 "" 7 "" "" "" 1 "" "" "" "" 8 "" "" "" 9 "" "" "" "" 3 4 "" "" 7 "" 1 "" "" "" "" "" 4 "" 9 5 "" } frame .p for { set y 0 } { $y < 9 } { incr y } { for { set x 0 } { $x < 9 } { incr x } { entry .p.e$x$y -text "" -justify center -font {FixedSys 32} -width 2 .p.e$x$y insert end [lindex $::sample [expr $y * 9 + $x]] grid .p.e$x$y -column $x -row $y -sticky news } } button .b -text "SOLVE" -command "solve" button .c -text "CLEAR" -command "clear" button .d -text "DUMP" -command "dump" button .e -text "EXIT" -command "destroy ." pack .b -side top -expand yes -fill both pack .c -side top -expand yes -fill both pack .d -side top -expand yes -fill both pack .e -side top -expand yes -fill both pack .p -side top -expand yes -fill both console show proc clear {} { for { set y 0 } { $y < 9 } { incr y } { for { set x 0 } { $x < 9 } { incr x } { .p.e$x$y delete 0 end } } } proc dump {} { for { set y 0 } { $y < 9 } { incr y } { for { set x 0 } { $x < 9 } { incr x } { puts -nonewline "$::D($x,$y) " } puts "" } } proc load {} { set ::numFixed 0 for { set y 0 } { $y < 9 } { incr y } { for { set x 0 } { $x < 9 } { incr x } { set val [.p.e$x$y get] if { $val == "" } { set ::D($x,$y) "123456789" } else { set ::D($x,$y) $val } } } } proc solve {} { # load initial settings load set t0 [clock clicks -milliseconds] reduce ::D set t1 [clock clicks -milliseconds] set reduceSec [format "%6.3f(sec)" [expr (0.0+$t1-$t0)/1000.0]] set inferSec [format "%6.3f(sec)" 0.0] if { $::numFixed == 81 } { tk_messageBox -message "Solved. \nReduction: $reduceSec\nInference: $inferSec" -type ok return } set result [infer ::D] set t2 [clock clicks -milliseconds] set inferSec [format "%6.3f(sec)" [expr (0.0+$t2-$t1)/1000.0]] if { $result == "complete" } { tk_messageBox -message "Solved. \nReduction: $reduceSec\nInference: $inferSec" -type ok return } tk_messageBox -message "Not Solved : Illegal Conditions Suspected.\nReduction: $reduceSec\nInference: $inferSec" -type ok } ######################################## # 05 yet another better reducer... ######################################## proc reduce {Dname} { upvar $Dname d set ::indice {} for { set y 0 } { $y < 9 } { incr y } { for { set x 0 } { $x < 9 } { incr x } { if { [string length $d($x,$y)] == 1 } { lappend ::indice $x $y } } } return [reduce5 d] } proc reduce5 {Dname} { upvar $Dname d while { [llength $::indice] } { if { ! [reduce5internal d [lindex $::indice 0] [lindex $::indice 1]] } { set ::indice {} return 0 } set ::indice [lreplace $::indice 0 1] incr ::numFixed } return 1 } proc reduce5internal {Dname bx by} { upvar $Dname d set v $d($bx,$by) if {$v == ""} { return 0 } set xfrom [expr {($bx/3)*3}] set yfrom [expr {($by/3)*3}] set xbelow [expr {$xfrom+3}] set ybelow [expr {$yfrom+3}] for { set y $yfrom } { $y < $ybelow } { incr y } { if { $y == $by } { continue } for { set x $xfrom } { $x < $xbelow } { incr x } { if { ($bx != $x) && [reduce3elem d $x $y $v] == 0 } { return 0 } } } for { set i 0 } { $i < 9 } { incr i } { if { ($i != $bx) && [reduce3elem d $i $by $v] == 0 } { return 0 } if { ($i != $by) && [reduce3elem d $bx $i $v] == 0 } { return 0 } } return 1 } proc reduce3elem { Dname ex ey val} { upvar $Dname d if { [regsub $val $d($ex,$ey) "" new] } { if { $new == "" } { return 0 } if { [string length $new] == 1 } { .p.e$ex$ey delete 0 end .p.e$ex$ey insert end $new lappend ::indice $ex $ey } set d($ex,$ey) $new } return 1 } ###################################################################### proc findFirstMultiple {dname} { upvar $dname orig for { set y 0 } { $y < 9 } { incr y } { for { set x 0 } { $x < 9 } { incr x } { if { [string length $orig($x,$y)] > 1 } { return "$x $y" } } } return "" } proc infer {dname} { upvar $dname orig # find unfixed elem. set xy [findFirstMultiple orig] if { $xy == "" } { return "complete"} # incomplete set x [lindex $xy 0] set y [lindex $xy 1] # backup set backup [array get orig] set cands $orig($x,$y) foreach cand [split $cands ""] { set orig($x,$y) $cand .p.e$x$y delete 0 end .p.e$x$y insert end $cand update set ::indice "$x $y" if { [reduce5 orig] } { if { [infer orig] == "complete" } { return "complete" } } array set orig $backup } .p.e$x$y delete 0 end update return "fail" }
# # Sudoku Solver # # Rev. 0.10 Apr. 18, 2009 zhuo --- sec. (reduction only) # Rev. 0.20 Apr. 19, 2009 zhuo 256 sec. "inference" introduced # Rev. 0.30 Apr. 19, 2009 zhuo 249 sec. string representation. # # # Platform: # Mac/Windows/Linux and any platforms where Tcl/Tk runs. # # Preparation: # - Install Tcl/Tk. # - Save this text as xxx.tcl (xxx: any filename you like). # # How to run: # - Click xxx.tcl to start. # - Enter the numbers. You can use tab / shift-tab for traverse. # - Click "SOLVE" to have the answer. # - Click "EXIT" to quit. array set ::D {} # inference necessary set ::sample { 6 "" 4 "" "" "" 9 "" "" "" "" "" "" 7 "" "" 6 "" 5 "" "" "" "" 2 "" "" 3 "" "" "" 1 "" "" 4 "" "" "" 4 "" "" 2 "" "" 8 "" "" "" 7 "" "" 8 "" "" "" 8 "" "" 9 "" "" "" "" 1 "" 5 "" "" 3 "" "" "" "" "" "" 3 "" "" "" 8 "" 9 } # inference not necessary set ::sample0 { "" 6 3 "" 5 "" "" "" "" "" 4 "" 2 "" "" 8 6 "" "" "" "" 6 "" "" "" 4 "" "" "" "" 4 "" "" "" 2 "" 5 2 "" 3 "" 6 "" 8 9 "" 7 "" "" "" 1 "" "" "" "" 8 "" "" "" 9 "" "" "" "" 3 4 "" "" 7 "" 1 "" "" "" "" "" 4 "" 9 5 "" } frame .p for { set y 0 } { $y < 9 } { incr y } { for { set x 0 } { $x < 9 } { incr x } { entry .p.e$x$y -text "" -justify center -font {FixedSys 32} -width 2 .p.e$x$y insert end [lindex $::sample [expr $y * 9 + $x]] grid .p.e$x$y -column $x -row $y -sticky news } } button .b -text "SOLVE" -command "solve" button .c -text "CLEAR" -command "clear" button .d -text "DUMP" -command "dump" button .e -text "EXIT" -command "destroy ." pack .b -side top -expand yes -fill both pack .c -side top -expand yes -fill both pack .d -side top -expand yes -fill both pack .e -side top -expand yes -fill both pack .p -side top -expand yes -fill both console show proc clear {} { for { set y 0 } { $y < 9 } { incr y } { for { set x 0 } { $x < 9 } { incr x } { .p.e$x$y delete 0 end } } } proc dump {} { for { set y 0 } { $y < 9 } { incr y } { for { set x 0 } { $x < 9 } { incr x } { puts -nonewline "$::D($x,$y) " } puts "" } } proc load {} { set ::numFixed 0 for { set y 0 } { $y < 9 } { incr y } { for { set x 0 } { $x < 9 } { incr x } { set val [.p.e$x$y get] if { $val == "" } { set ::D($x,$y) "123456789" set ::D($x,$y,Fixed) 0 } else { set ::D($x,$y) $val set ::D($x,$y,Fixed) 1 incr ::numFixed } set ::D($x,$y,Used) 0 } } } proc solve {} { # load initial settings load set t0 [clock clicks -milliseconds] reduce ::D set t1 [clock clicks -milliseconds] set reduceSec [format "%6.3f(sec)" [expr (0.0+$t1-$t0)/1000.0]] set inferSec [format "%6.3f(sec)" 0.0] if { $::numFixed == 81 } { tk_messageBox -message "Solved. \nReduction: $reduceSec\nInference: $inferSec" -type ok return } set result [infer ::D] set t2 [clock clicks -milliseconds] set inferSec [format "%6.3f(sec)" [expr (0.0+$t2-$t1)/1000.0]] if { $result == "complete" } { tk_messageBox -message "Solved. \nReduction: $reduceSec\nInference: $inferSec" -type ok return } tk_messageBox -message "Not Solved : Illegal Conditions Suspected.\nReduction: $reduceSec\nInference: $inferSec" -type ok } proc reduce {Dname} { upvar $Dname d while { [reduceOne d] > 0 } {} } proc reduceOne {Dname} { upvar $Dname d set reduce 0 for { set y 0 } { $y < 9 } { incr y } { for { set x 0 } { $x < 9 } { incr x } { if { $d($x,$y,Fixed) && (!$d($x,$y,Used)) } { incr reduce [reduceOneInternal d $x $y] set d($x,$y,Used) 1 } } } return $reduce } proc updateElem {dname ex ey val} { upvar $dname d set reduce 0 if { [regsub $val $d($ex,$ey) "" d($ex,$ey)] } { incr reduce if { [string length $d($ex,$ey)] == 1 } { set d($ex,$ey,Fixed) 1 set d($ex,$ey,Used) 0 .p.e$ex$ey delete 0 end .p.e$ex$ey insert end $d($ex,$ey) incr ::numFixed } } return $reduce } proc reduceOneInternal { dname bx by } { upvar $dname d set reduce 0 for { set x 0 } { $x < 9 } { incr x } { if { (! $d($x,$by,Fixed)) && ($x != $bx) } { incr reduce [updateElem d $x $by $d($bx,$by)] } } for { set y 0 } { $y < 9 } { incr y } { if { (! $d($bx,$y,Fixed)) && ($y != $by) } { incr reduce [updateElem d $bx $y $d($bx,$by)] } } set xfrom [expr ($bx/3)*3] set xbelow [expr $xfrom+3] set yfrom [expr ($by/3)*3] set ybelow [expr $yfrom+3] for { set x $xfrom } { $x < $xbelow} { incr x } { for { set y $yfrom } { $y < $ybelow} { incr y } { if { (! $d($x,$y,Fixed)) && ( ($x != $bx) || ($y != $by) ) } { incr reduce [updateElem d $x $y $d($bx,$by)] } } } return $reduce } ###################################################################### proc findFirstMultiple {dname} { upvar $dname orig for { set y 0 } { $y < 9 } { incr y } { for { set x 0 } { $x < 9 } { incr x } { if { [string length $orig($x,$y)] > 1 } { return "$x $y" } } } return "" } proc infer {dname} { upvar $dname orig # find unfixed elem. set xy [findFirstMultiple orig] if { $xy == "" } { return "complete"} # incomplete set x [lindex $xy 0] set y [lindex $xy 1] # array set backup [array get orig] set cands $orig($x,$y) foreach cand [split $cands ""] { set orig($x,$y) $cand .p.e$x$y delete 0 end .p.e$x$y insert end $cand update if { [isValid orig $x $y] } { if { [infer orig] == "complete" } { return "complete" } } } set orig($x,$y) $cands .p.e$x$y delete 0 end update return "fail" } proc isValid { dname px py } { upvar $dname d set val $d($px,$py) # row check for { set x 0 } { $x < 9 } { incr x } { if { $x != $px } { if { $d($x,$py) == $val } { return 0 } } } # column check for { set y 0 } { $y < 9 } { incr y } { if { $y != $py } { if { $d($px,$y) == $val } { return 0 } } } # box check set xfrom [expr ($px/3)*3] set xbelow [expr $xfrom+3] set yfrom [expr ($py/3)*3] set ybelow [expr $yfrom+3] for { set y $yfrom } { $y < $ybelow} { incr y } { for { set x $xfrom } { $x < $xbelow } { incr x } { if { ($x != $px) || ($y != $py) } { if { $d($x,$y) == $val } { return 0 } } } } return 1 }
# # Sudoku Solver # # Rev. 0.10 Apr. 18, 2009 zhuo # # # Platform: # Mac/Windows/Linux and any platforms where Tcl/Tk runs. # # Preparation: # - Install Tcl/Tk. # - Save this text as xxx.tcl (xxx: any filename you like). # # How to run: # - Click xxx.tcl to start. # - Enter the numbers. You can use tab / shift-tab for traverse. # - Click "SOLVE" to have the answer. # - Click "EXIT" to quit. array set ::Values {} array set ::Fixed {} array set ::Used {} set ::sample { "" 6 3 "" 5 "" "" "" "" "" 4 "" 2 "" "" 8 6 "" "" "" "" 6 "" "" "" 4 "" "" "" "" 4 "" "" "" 2 "" 5 2 "" 3 "" 6 "" 8 9 "" 7 "" "" "" 1 "" "" "" "" 8 "" "" "" 9 "" "" "" "" 3 4 "" "" 7 "" 1 "" "" "" "" "" 4 "" 9 5 "" } frame .p for { set y 0 } { $y < 9 } { incr y } { for { set x 0 } { $x < 9 } { incr x } { entry .p.e$x$y -text "" -justify center -font {FixedSys 32} -width 2 # .p.e$x$y insert end [lindex $::sample [expr $y * 9 + $x]] grid .p.e$x$y -column $x -row $y -sticky news } } button .b -text "SOLVE" -command "solve" #button .d -text "DUMP" -command "dump" button .e -text "EXIT" -command "destroy ." pack .b -side top -expand yes -fill both pack .d -side top -expand yes -fill both pack .e -side top -expand yes -fill both pack .p -side top -expand yes -fill both proc dump {} { console show for { set y 0 } { $y < 9 } { incr y } { for { set x 0 } { $x < 9 } { incr x } { puts -nonewline "( $::Values($x,$y) ) " } puts "" } } proc load {} { set ::numFixed 0 for { set y 0 } { $y < 9 } { incr y } { for { set x 0 } { $x < 9 } { incr x } { set val [.p.e$x$y get] if { $val == "" } { set ::Values($x,$y) {1 2 3 4 5 6 7 8 9} set ::Fixed($x,$y) 0 } else { set ::Values($x,$y) $val set ::Fixed($x,$y) 1 incr ::numFixed } set ::Used($x,$y) 0 } } } proc solve {} { # load initial settings load while { $::numFixed < 81 } { if { [solveOne] == 0 } { tk_messageBox -message "Not Solved : Illegal Conditions Suspected." -type ok return } } tk_messageBox -message "Solved." -type ok } proc solveOne {} { set elim 0 for { set y 0 } { $y < 9 } { incr y } { for { set x 0 } { $x < 9 } { incr x } { if { $::Fixed($x,$y) && (!$::Used($x,$y)) } { incr elim [eliminateRow $x $y] incr elim [eliminateColumn $x $y] incr elim [eliminateBox $x $y] set ::Used($x,$y) 1 } } } return $elim } proc updateElem {ex ey val} { set elim 0 set i [lsearch $::Values($ex,$ey) $val] if { $i != -1 } { incr elim set ::Values($ex,$ey) [lreplace $::Values($ex,$ey) $i $i] if { [llength $::Values($ex,$ey)] == 1 } { set ::Fixed($ex,$ey) 1 set ::Used($ex,$ey) 0 .p.e$ex$ey delete 0 end .p.e$ex$ey insert end $::Values($ex,$ey) incr ::numFixed } } return $elim } proc eliminateRow { bx by } { set elim 0 for { set x 0 } { $x < 9 } { incr x } { if { (! $::Fixed($x,$by)) && ($x != $bx) } { incr elim [updateElem $x $by $::Values($bx,$by)] } } return $elim } proc eliminateColumn { bx by } { set elim 0 for { set y 0 } { $y < 9 } { incr y } { if { (! $::Fixed($bx,$y)) && ($y != $by) } { incr elim [updateElem $bx $y $::Values($bx,$by)] } } return $elim } proc eliminateBox { bx by } { set elim 0 set xfrom [expr ($bx/3)*3] set xbelow [expr $xfrom+3] set yfrom [expr ($by/3)*3] set ybelow [expr $yfrom+3] for { set x $xfrom } { $x < $xbelow} { incr x } { for { set y $yfrom } { $y < $ybelow} { incr y } { if { (! $::Fixed($x,$y)) && ( ($x != $bx) || ($y != $by) ) } { incr elim [updateElem $x $y $::Values($bx,$by)] } } } return $elim }