if 0 {Richard Suchenwirth 2005-05-31 - The Sudoku puzzle seems to be quite popular in the UK. After reading the n-th time about it, I wanted to play with it, in my usual quest to implement things in Tcl, in order to understand them better.
A sudoku is a 9x9 matrix of digits 1..9, such that each occurs exactly once in every row, column, and 3x3 submatrix, if I understand the rules correctly. A matrix in Tcl is most easily implemented as a list of lists, whose elements can be conveniently accessed with two-index lindex and lset. The following matrix may be the "canonical" sudoku, as the first row and the first (top-left) "box" come in natural 1..9 order: }
set s {
{1 2 3 4 5 6 7 8 9}
{4 5 6 7 8 9 1 2 3}
{7 8 9 1 2 3 4 5 6}
{2 3 4 5 6 7 8 9 1}
{5 6 7 8 9 1 2 3 4}
{8 9 1 2 3 4 5 6 7}
{3 4 5 6 7 8 9 1 2}
{6 7 8 9 1 2 3 4 5}
{9 1 2 3 4 5 6 7 8}
}if 0 {It is also evident that the rows below the first are produced by rotation, by 3, 6, 1, 4, 7, 2, 5, 8 positions. Also, boxes are related to their left neighbor by row rotation, or to their upper neighbor by element rotation of one position.
Here's accessor functions to extract a given row, column, or box, returned as a list (boxes being indexed by
0 3 6 1 4 7 2 5 8
):}
proc sudoku'row {s i} {lindex $s $i}
proc sudoku'col {s i} {
foreach row $s {lappend res [lindex $row $i]}
set res
}
proc sudoku'box {s i} {
for {set r [expr ($i%3)*3]} {$r<($i%3)*3+3} {incr r} {
for {set c [expr ($i/3)*3]} {$c<($i/3)*3+3} {incr c} {
lappend res [lindex $s $r $c]
}
}
set res
}if 0 {To validate a sudoku, each row, column, and box has to be tested whether it contains the digits 1..9 exactly once:}
proc sudoku'ok1 list {expr {[lsort $list] eq {1 2 3 4 5 6 7 8 9}}}
proc sudoku'ok s {
foreach dim {row col box} {
foreach $dim {0 1 2 3 4 5 6 7 8} {
if ![sudoku'ok1 [sudoku'$dim $s [set $dim]]] {
error "invalid sudoku $dim [set $dim]: \
{[sudoku'$dim $s [set $dim]]}"
}
}
}
}#-- Testing
sudoku'ok $s
if 0 {No error is thrown, so it looks like the code above is good...
As regular as this canonical sudoku is, it is perhaps not exactly challenging for a trained user, once he discovers the regularity. Without proof, I just postulate that every combination of
will again produce a valid sudoku, and after several of these it might even be a challenge for puzzlers...
For example, here's a simple transposition:}
proc transpose matrix {
set cmd list
set i -1
foreach col [lindex $matrix 0] {append cmd " $[incr i]"}
foreach row $matrix {
set i -1
foreach col $row {lappend [incr i] $col}
}
eval $cmd
}
sudoku'ok [transpose $s]#-- Trying a permutation:
sudoku'ok [string map {1 2 2 1 3 4 4 3 5 6 6 5 7 8 8 7} $s]#-- and a mirroring (along the y axis):
proc lreverse list {
if [set i [llength $list]] {
while {[incr i -1]>=0} {lappend res [lindex $list $i]}
set res
}
}
sudoku'ok [lreverse $s]#-- Reformatting a transformed matrix to look like a sudoku again:
proc sudoku'format s {
set n 0
foreach row $s {
append res [regsub -all (......?) $row {\1 }]\n
if {([incr n]%3)==0} {append res \n}
}
set res
}if 0 {Example:
% sudoku'format [transpose $s] 1 4 7 2 5 8 3 6 9 2 5 8 3 6 9 4 7 1 3 6 9 4 7 1 5 8 2 4 7 1 5 8 2 6 9 3 5 8 2 6 9 3 7 1 4 6 9 3 7 1 4 8 2 5 7 1 4 8 2 5 9 3 6 8 2 5 9 3 6 1 4 7 9 3 6 1 4 7 2 5 8