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/
Tcl8.6, is available at
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
}
}
