Data commit
This commit is contained in:
Ingy döt Net
parent
7387c8f97b
commit
cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
249
Task/Sudoku/Tcl/sudoku-1.tcl
Normal file
249
Task/Sudoku/Tcl/sudoku-1.tcl
Normal file
|
|
@ -0,0 +1,249 @@
|
|||
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
|
||||
}
|
||||
}
|
||||
24
Task/Sudoku/Tcl/sudoku-2.tcl
Normal file
24
Task/Sudoku/Tcl/sudoku-2.tcl
Normal file
|
|
@ -0,0 +1,24 @@
|
|||
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
|
||||
1
Task/Sudoku/Tcl/sudoku-3.tcl
Normal file
1
Task/Sudoku/Tcl/sudoku-3.tcl
Normal file
|
|
@ -0,0 +1 @@
|
|||
oo::objdefine sudoku method Log msg {puts $msg}
|
||||
Loading…
Add table
Add a link
Reference in a new issue