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
   * regular permutation (e.g. swap all 1's and 2's)
   * swap of box-rows or box-columns (boxes staying intact)
   * transposition or mirroring along x or y axes
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 

----
[Arts and crafts of Tcl-Tk programming]
}