-
-Rosetta Example: Sudoku
-
-
-
-
-
-
-
-
-Solve a partially filled-in 9x9 Sudoku grid and display the result -in a human-readable format. For detailed description of this -example, see http://rosettacode.org/wiki/Sudoku_Solver
This implementation is based on http://wiki.tcl.tk/19934
-
-
-
package require nx
The class Sudoku implements the basic interface to a sudoku 9x9
-board to load/dump data and to set/access cells, rows, columns and
-regions.
-
-
-
nx::Class create Sudoku { - - :variable board - - # Setup an array from 0..9 to ease iterations over the cells of - # lines and columns. - for {set i 0} {$i < 9} {incr i} {lappend positions $i} - :variable positions $positions - - :public method load {data} { - # - # Load a 9x9 partially solved sudoku. The unsolved cells are - # represented by a@ symbols. - # - set error "data must be a 9-element list, each element also being a\ - list of 9 numbers from 1 to 9 or blank or an @ symbol." - if {[llength $data] != 9} { - error $error - } - foreach y ${:positions} { - set row [lindex $data $y] - if {[llength $row] != 9} { - error $error - } - foreach x ${:positions} { - set cell [lindex $row $x] - if {![regexp {^[@1-9]?$} $cell]} { - error $cell-$error - } - if {$cell eq "@"} {set cell ""} - :set $x $y $cell - } - } - } - - :public method dump {-pretty-print:switch} { - # - # Output the current state of the sudoku either as list or in - # a pretty-print style. - # - set rows [lmap y ${:positions} {:getRow 0 $y}] - if {${pretty-print}} { - set result +-----+-----+-----+\n - foreach line $rows postline {0 0 1 0 0 1 0 0 1} { - append result |[lrange $line 0 2]|[lrange $line 3 5]|[lrange $line 6 8]|\n - if {$postline} { - append result +-----+-----+-----+\n - } - } - return $result - } else { - return $rows - } - } - - :method log {msg} { - #puts "log: $msg" - } - - :method set {x y value:integer,0..1} { - # - # Set cell at position x,y to the given value or empty. - # - if {$value<1 || $value>9} { - set :board($x,$y) {} - } else { - set :board($x,$y) $value - } - } - :method get {x y} { - # - # Get value of cell at position x, y. - # - return [set :board($x,$y)] - } - - :method getRow {x y} { - # - # Return a row at constant position y. - # - return [lmap x ${:positions} {:get $x $y}] - } - :method getCol {x y} { - # - # Return a column at constant position x. - # - return [lmap y ${:positions} {:get $x $y}] - } - - :method getRegion {x y} { - # - # Return a 3x3 region - # - set xR [expr {($x/3)*3}] - set yR [expr {($y/3)*3}] - set regn {} - for {set x $xR} {$x < $xR+3} {incr x} { - for {set y $yR} {$y < $yR+3} {incr y} { - lappend regn [:get $x $y] - } - } - return $regn - } -} -
The class SudokuSolver inherits from Sudoku, and adds the
-ability to solve a given Sudoku game. The method solve applies all
-rules for each unsolved cell until it finds a safe solution.
-
-
-
-nx::Class create SudokuSolver -superclass Sudoku { - - :public method validchoices {x y} { - set v [:get $x $y] - if {$v ne {}} { - return $v - } - - set row [:getRow $x $y] - set col [:getCol $x $y] - set regn [:getRegion $x $y] - set eliminate [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 {$c ni $eliminate} { - lappend choices $c - } - } - if {[llength $choices]==0} { - error "No choices left for square $x,$y" - } - return $choices - } - - :method completion {} { - # - # Return the number of already solved items. - # - return [expr {81-[llength [lsearch -all -inline [join [:dump]] {}]]}] - } - - :public method solve {} { - # - # Try to solve the sudoku by applying the provided rules. - # - while {1} { - set begin [:completion] - foreach y ${:positions} { - foreach x ${:positions} { - if {[:get $x $y] eq ""} { - foreach rule [Rule info instances] { - set c [$rule solve [self] $x $y] - if {$c} { - :set $x $y $c - :log "[$rule info class] solved [self] at $x,$y for $c" - break - } - } - } - } - } - set end [:completion] - if {$end == 81} { - :log "Finished solving!" - break - } elseif {$begin == $end} { - :log "A round finished without solving any squares, giving up." - break - } - } - } -} -
The class rule provides "solve" as public interface for all rule -objects. The rule objects apply their logic to the values -passed in and return either 0 or a number to allocate to the -requested square.
-
-
-
nx::Class create Rule { - - :public method solve {hSudoku:object,type=::SudokuSolver x y} { - :Solve $hSudoku $x $y [$hSudoku validchoices $x $y] - } - - # 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 - :create ruleOnlyChoice { - :object method Solve {hSudoku x y choices} { - if {[llength $choices] == 1} { - return $choices - } else { - return 0 - } - } - } - - # 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. - :create RuleColumnChoice { - :object method Solve {hSudoku x y choices} { - foreach choice $choices { - set failed 0 - for {set x2 0} {$x2 < 9} {incr x2} { - if {$x2 != $x && $choice in [$hSudoku validchoices $x2 $y]} { - set failed 1 - break - } - } - if {!$failed} {return $choice} - } - return 0 - } - } - - # 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. - :create RuleRowChoice { - :object method Solve {hSudoku x y choices} { - foreach choice $choices { - set failed 0 - for {set y2 0} {$y2 < 9} {incr y2} { - if {$y2 != $y && $choice in [$hSudoku validchoices $x $y2]} { - set failed 1 - break - } - } - if {!$failed} {return $choice} - } - return 0 - } - } - - # 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. - :create RuleRegionChoice { - :object method Solve {hSudoku x y choices} { - foreach choice $choices { - set failed 0 - set regnX [expr {($x/3)*3}] - set regnY [expr {($y/3)*3}] - for {set y2 $regnY} {$y2 < $regnY+3} {incr y2} { - for {set x2 $regnX} {$x2 < $regnX+3} {incr x2} { - if { - ($x2!=$x || $y2!=$y) - && $choice in [$hSudoku validchoices $x2 $y2] - } then { - set failed 1 - break - } - } - } - if {!$failed} {return $choice} - } - return 0 - } - } -} - -SudokuSolver create sudoku { - - :load { - {3 9 4 @ @ 2 6 7 @} - {@ @ @ 3 @ @ 4 @ @} - {5 @ @ 6 9 @ @ 2 @} - - {@ 4 5 @ @ @ 9 @ @} - {6 @ @ @ @ @ @ @ 7} - {@ @ 7 @ @ @ 5 8 @} - - {@ 1 @ @ 6 7 @ @ 8} - {@ @ 9 @ @ 8 @ @ @} - {@ 2 6 4 @ @ 7 3 5} - } - :solve - - puts [:dump -pretty-print] -}
The dump method outputs the solved Sudoku:
-
-
-
+-----+-----+-----+
-|3 9 4|8 5 2|6 7 1|
-|2 6 8|3 7 1|4 5 9|
-|5 7 1|6 9 4|8 2 3|
-+-----+-----+-----+
-|1 4 5|7 8 3|9 6 2|
-|6 8 2|9 4 5|3 1 7|
-|9 3 7|1 2 6|5 8 4|
-+-----+-----+-----+
-|4 1 3|5 6 7|2 9 8|
-|7 5 9|2 3 8|1 4 6|
-|8 2 6|4 1 9|7 3 5|
-+-----+-----+-----+