This [simpleOO] object hierarchy can solve almost all of the simple [Sudoku] puzzles, without guessing at all. It uses simple rules, and mostly just looks for naked singles and hidden singles sequentially. The solve method of `ISolver` loops until it stops making progress. [DKF]: A version of this, based on [TclOO]/[Tcl]8.6, is available at [http://rosettacode.org/wiki/Sudoku_Solver#Tcl%|%the Rosetta Code site%|%]. ---- package require simpleOO if 0 { ISudoku is responsible only for the layout of the board, and access to the squares. } object ISudoku { inherits IUnknown method clear {} { for {set y 0} {$y<9} {incr y} { for {set x 0} {$x<9} {incr x} { $this set $x $y {} } } } method load {data} { if {[llength $data]!=9} {error "data must be a 9-element list, each element also being a list of 9 numbers from 1 to 9 or blank."} for {set y 0} {$y<9} {incr y} { set row [lindex $data $y] if {[llength $row]!=9} {error "data must be a 9-element list, each element also being a list of 9 numbers from 1 to 9 or blank."} for {set x 0} {$x<9} {incr x} { $this set $x $y [lindex $row $x] } } } method dump {} { set rows {} for {set y 0} {$y<9} {incr y} { lappend rows [$this getrow 0 $y] } return $rows } method set {x y value} { if {[catch {set value [format %d $value]}]} {set value 0} if {($value<1) || ($value>9)} { set idata(sq$x$y) {} } else { set idata(sq$x$y) $value } } method get {x y} { if {![info exists idata(sq$x$y)]} {return {}} return $idata(sq$x$y) } method getvar {x y} { # returns the name of the variable containing cell $x,$y # for use in trace, -variablename, etc return ::ISudoku::$this\(sq$x$y) } method getrow {x y} { set row {} for {set x 0} {$x<9} {incr x} { lappend row [$this get $x $y] } return $row } method getcol {x y} { set col {} for {set y 0} {$y<9} {incr y} { lappend col [$this get $x $y] } return $col } method getregion {x y} { set xR [expr {($x/3)*3}] set yR [expr {($y/3)*3}] set regn {} for {set x $xR} {$x<[expr {$xR+3}]} {incr x} { for {set y $yR} {$y<[expr {$yR+3}]} {incr y} { lappend regn [$this get $x $y] } } return $regn } } if 0 { `ISolver` inherits from `ISudoku`, and adds the ability to filter possibilities for a square by looking at all the squares in the row, column, and region that the square is a part of. The method ''solve'' contains a list of rule-objects to use, and iterates over each square on the board, applying each rule sequentially until the square is allocated. } object ISolver { inherits ISudoku method validchoices {x y} { if {[$this get $x $y]=={}} { set row [$this getrow $x $y] set col [$this getcol $x $y] set regn [$this getregion $x $y] set eliminate [eval list $row $col $regn] set eliminate [lsearch -all -inline -not $eliminate {}] set eliminate [lsort -unique $eliminate] set choices {} for {set c 1} {$c<10} {incr c} { if {[lsearch $eliminate $c]==-1} { lappend choices $c } } if {[llength $choices]==0} {error "No choices left for square $x,$y"} return $choices } else { return [$this get $x $y] } } method completion {} { return [expr 81-[llength [lsearch -all -inline [join [$this dump]] {}]]] } method solve {} { set rule1 [new IRuleOnlyChoice] set rule2 [new IRuleRowChoice] set rule3 [new IRuleColumnChoice] set rule4 [new IRuleRegionChoice] while {1} { set begin [$this completion] for {set y 0} {$y<9} {incr y} { for {set x 0} {$x<9} {incr x} { if {[$this get $x $y]==""} { foreach rule [list $rule1 $rule2 $rule3 $rule4] { set c [$rule solve $this $x $y] if {$c!=0} { $this set $x $y $c puts "$rule solved $this at $x,$y for $c" update break } } } } } set end [$this completion] if {$end==81} { puts "Finished solving!" break } elseif {$begin==$end} { puts "A round finished without solving any squares, giving up." break } } $rule1 Release ; $rule2 Release ; $rule3 Release ; $rule4 Release } } if 0 { `IRule` is the template for the rules used in `ISolver`. The other rule-objects apply their logic to the values passed in and return either '0' or a number to allocate to the requested square. } object IRule { inherits IUnknown ; method solve {hSudoku x y} {}} object IRuleOnlyChoice { # Get all the allocated numbers for each square in the the row, # column, and region containing $x,$y. If there is only one # unallocated number among all three groups, it must be allocated # at $x,$y inherits IRule method solve {hSudoku x y} { if {![$hSudoku isa ISolver]} {error "hSudoku must be an instance of class ISolver."} set choices [$hSudoku validchoices $x $y] if {[llength $choices]==1} { return $choices } else { return 0 } } } object IRuleColumnChoice { # Test each column to determine if $choice is an invalid choice # for all other columns in row $X. If it is, it must only go # in square $x,$y. inherits IRule method solve {hSudoku x y} { if {![$hSudoku isa ISolver]} {error "hSudoku must be an instance of class ISolver."} set choices [$hSudoku validchoices $x $y] foreach choice $choices { set failed 0 for {set x2 0} {$x2<9} {incr x2} { if {$x2!=$x} { set rowChoice [$hSudoku validchoices $x2 $y] if {[lsearch $rowChoice $choice]!=-1} { set failed 1 } } } if {!$failed} {return $choice} } return 0 } } object IRuleRowChoice { # Test each row to determine if $choice is an invalid choice # for all other rows in column $y. If it is, it must only go # in square $x,$y. inherits IRule method solve {hSudoku x y} { if {![$hSudoku isa ISolver]} {error "hSudoku must be an instance of class ISolver."} set choices [$hSudoku validchoices $x $y] foreach choice $choices { set failed 0 for {set y2 0} {$y2<9} {incr y2} { if {$y2!=$y} { set colChoice [$hSudoku validchoices $x $y2] if {[lsearch $colChoice $choice]!=-1} { set failed 1 } } } if {!$failed} {return $choice} } return 0 } } object IRuleRegionChoice { # Test each square in the region occupied by $x,$y to determine # if $choice is an invalid choice for all other squares in that # region. If it is, it must only go in square $x,$y. inherits IRule method solve {hSudoku x y} { if {![$hSudoku isa ISolver]} {error "hSudoku must be an instance of class ISolver."} set choices [$hSudoku validchoices $x $y] foreach choice $choices { set failed 0 set regnX [expr {($x/3)*3}] ; set regnY [expr {($y/3)*3}] for {set y2 $regnY} {$y2<[expr $regnY+3]} {incr y2} { for {set x2 $regnX} {$x2<[expr $regnX+3]} {incr x2} { if {($x2!=$x) || ($y2!=$y)} { set colChoice [$hSudoku validchoices $x2 $y2] if {[lsearch $colChoice $choice]!=-1} { set failed 1 } } } } if {!$failed} {return $choice} } return 0 } } ---- !!!!!! %| [Category Games] |% !!!!!!