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 ("box"), 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 (embellished by extra spaces and newlines, so the boxes are more evident) 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 matrix transposition (see also Transposing a matrix):}
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}
}
string range $res 0 end-2 ;# chop off last two newlines
}if 0 {The returned string has extra whitespace for better looks, but still parses as the same matrix. 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 }