Anonymous user
Sudoku: Difference between revisions
→Tcl: Added implementation
m (Not the way the task template works, change to interwiki links) |
(→Tcl: Added implementation) |
||
Line 80:
r .= SubStr(p, A_Index, 1) (!Mod(A_Index, 9) ? "`n" : !Mod(A_Index,3) ? "`t" : "")
return r
}</lang>
=={{header|Tcl}}==
{{works with|Tcl|8.6}}
<lang tcl>package require Tcl 8.6
oo::class create Sudoku {
variable idata
method clear {} {
for {set y 0} {$y < 9} {incr y} {
for {set x 0} {$x < 9} {incr x} {
my set $x $y {}
}
}
}
method load {data} {
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
}
for {set y 0} {$y<9} {incr y} {
set row [lindex $data $y]
if {[llength $row] != 9} {
error $error
}
for {set x 0} {$x<9} {incr x} {
set d [lindex $row $x]
if {![regexp {^[@1-9]?$} $d]} {
error $d-$error
}
if {$d eq "@"} {set d ""}
my set $x $y $d
}
}
}
method dump {} {
set rows {}
for {set y 0} {$y < 9} {incr y} {
lappend rows [my getRow 0 $y]
}
return $rows
}
method Log msg {
# Chance to print message
}
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 getRow {x y} {
set row {}
for {set x 0} {$x<9} {incr x} {
lappend row [my get $x $y]
}
return $row
}
method getCol {x y} {
set col {}
for {set y 0} {$y<9} {incr y} {
lappend col [my 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 < $xR+3} {incr x} {
for {set y $yR} {$y < $yR+3} {incr y} {
lappend regn [my get $x $y]
}
}
return $regn
}
}
# SudokuSolver inherits from Sudoku, 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.
oo::class create SudokuSolver {
superclass Sudoku
method validchoices {x y} {
if {[my get $x $y] ne {}} {
return [my get $x $y]
}
set row [my getRow $x $y]
set col [my getCol $x $y]
set regn [my 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 [expr {
81-[llength [lsearch -all -inline [join [my dump]] {}]]
}]
}
method solve {} {
foreach ruleClass [info class subclass Rule] {
lappend rules [$ruleClass new]
}
while {1} {
set begin [my completion]
for {set y 0} {$y < 9} {incr y} {
for {set x 0} {$x < 9} {incr x} {
if {[my get $x $y] eq ""} {
foreach rule $rules {
set c [$rule solve [self] $x $y]
if {$c} {
my set $x $y $c
my Log "[info object class $rule] solved [self] at $x,$y for $c"
break
}
}
}
}
}
set end [my completion]
if {$end==81} {
my Log "Finished solving!"
break
} elseif {$begin==$end} {
my Log "A round finished without solving any squares, giving up."
break
}
}
foreach rule $rules {
$rule destroy
}
}
}
# Rule is the template for the rules used in Solver. 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.
oo::class create Rule {
method solve {hSudoku x y} {
if {![info object isa typeof $hSudoku SudokuSolver]} {
error "hSudoku must be an instance of class SudokuSolver."
}
tailcall my 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
oo::class create RuleOnlyChoice {
superclass Rule
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.
oo::class create RuleColumnChoice {
superclass Rule
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.
oo::class create RuleRowChoice {
superclass Rule
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.
oo::class create RuleRegionChoice {
superclass Rule
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
}
}</lang>
Demonstration code:
<lang tcl>SudokuSolver create sudoku
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}
}
sudoku solve
# Simple pretty-printer for completed sudokus
puts +-----+-----+-----+
foreach line [sudoku dump] postline {0 0 1 0 0 1 0 0 1} {
puts |[lrange $line 0 2]|[lrange $line 3 5]|[lrange $line 6 8]|
if {$postline} {
puts +-----+-----+-----+
}
}
sudoku destroy</lang>
Sample output:
<pre>+-----+-----+-----+
|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|
+-----+-----+-----+</pre>
If we'd added a logger method like this:
<lang tcl>oo::objdefine sudoku method Log msg {puts $msg}</lang>
Then this additional logging output would have been produced:
<pre>::RuleOnlyChoice solved ::sudoku at 8,0 for 1
::RuleColumnChoice solved ::sudoku at 1,1 for 6
::RuleRegionChoice solved ::sudoku at 4,1 for 7
::RuleRowChoice solved ::sudoku at 7,1 for 5
::RuleOnlyChoice solved ::sudoku at 8,1 for 9
::RuleColumnChoice solved ::sudoku at 1,2 for 7
::RuleColumnChoice solved ::sudoku at 5,2 for 4
::RuleRowChoice solved ::sudoku at 6,2 for 8
::RuleOnlyChoice solved ::sudoku at 8,2 for 3
::RuleColumnChoice solved ::sudoku at 3,3 for 7
::RuleRowChoice solved ::sudoku at 1,4 for 8
::RuleRowChoice solved ::sudoku at 5,4 for 5
::RuleRowChoice solved ::sudoku at 6,4 for 3
::RuleRowChoice solved ::sudoku at 0,5 for 9
::RuleOnlyChoice solved ::sudoku at 1,5 for 3
::RuleOnlyChoice solved ::sudoku at 0,6 for 4
::RuleOnlyChoice solved ::sudoku at 2,6 for 3
::RuleColumnChoice solved ::sudoku at 3,6 for 5
::RuleOnlyChoice solved ::sudoku at 6,6 for 2
::RuleOnlyChoice solved ::sudoku at 7,6 for 9
::RuleOnlyChoice solved ::sudoku at 0,7 for 7
::RuleOnlyChoice solved ::sudoku at 1,7 for 5
::RuleColumnChoice solved ::sudoku at 4,7 for 3
::RuleOnlyChoice solved ::sudoku at 6,7 for 1
::RuleOnlyChoice solved ::sudoku at 0,8 for 8
::RuleOnlyChoice solved ::sudoku at 4,8 for 1
::RuleOnlyChoice solved ::sudoku at 5,8 for 9
::RuleOnlyChoice solved ::sudoku at 3,0 for 8
::RuleOnlyChoice solved ::sudoku at 4,0 for 5
::RuleColumnChoice solved ::sudoku at 2,1 for 8
::RuleOnlyChoice solved ::sudoku at 5,1 for 1
::RuleOnlyChoice solved ::sudoku at 2,2 for 1
::RuleRowChoice solved ::sudoku at 0,3 for 1
::RuleColumnChoice solved ::sudoku at 4,3 for 8
::RuleColumnChoice solved ::sudoku at 5,3 for 3
::RuleOnlyChoice solved ::sudoku at 7,3 for 6
::RuleOnlyChoice solved ::sudoku at 8,3 for 2
::RuleOnlyChoice solved ::sudoku at 2,4 for 2
::RuleColumnChoice solved ::sudoku at 3,4 for 9
::RuleOnlyChoice solved ::sudoku at 4,4 for 4
::RuleOnlyChoice solved ::sudoku at 7,4 for 1
::RuleColumnChoice solved ::sudoku at 3,5 for 1
::RuleOnlyChoice solved ::sudoku at 4,5 for 2
::RuleOnlyChoice solved ::sudoku at 5,5 for 6
::RuleOnlyChoice solved ::sudoku at 8,5 for 4
::RuleOnlyChoice solved ::sudoku at 3,7 for 2
::RuleOnlyChoice solved ::sudoku at 7,7 for 4
::RuleOnlyChoice solved ::sudoku at 8,7 for 6
::RuleOnlyChoice solved ::sudoku at 0,1 for 2
Finished solving!</pre>
| |||