## Mini Sudoku

Artur Trzewik: Programming a sudoku solver is a good brain training for an evening.
Perhaps it will in time replace Eight Queens Problem as a popular student homework assignment.

Here is a short implementation. It has some extra functionality to observe the solution progress. It will not solve problems which need several tries.

```    namespace eval sudoku {
variable win
}

proc sudoku::lremoveAll {list_ref listr} {
upvar \$list_ref list
foreach elem \$listr {
lremove list \$elem
}
}
proc sudoku::lremove {list_ref elem} {
upvar \$list_ref list
if {[set index [lsearch -exact \$list \$elem]]>=0} {
set list [lreplace \$list \$index \$index]
return 1
}
return 0
}

proc sudoku::clear {} {
set f [list]
for {set i 0} {\$i<9*9} {incr i} {
lappend f [list]
}
setWin \$f
}
proc sudoku::complexReduction {ref_f t} {
variable win
upvar \$ref_f f
set fields {1 2 3 4 5 6 7 8 9}

set found 0

for {set y 0} {\$y<9} {incr y} {
for {set x 0} {\$x<9} {incr x} {
if {[llength [set pos [lindex \$t [expr {\$x+\$y*9}]]]]>1} {
set i 0
set allposibles [list]
foreach p [getColumn \$t \$x] {
if {\$i==\$y} {
incr i
continue
}
set allposibles [concat \$allposibles \$p]
incr i
}
lremoveAll pos \$allposibles
if {[llength \$pos]==1} {
lset f [expr {\$x+\$y*9}] [lindex \$pos 0]
lset t [expr {\$x+\$y*9}] [lindex \$pos 0]
set found 1
return \$found
}
set pos [lindex \$t [expr {\$x+\$y*9}]]
set i 0
set allposibles [list]
foreach p [getRow \$t \$y] {
if {\$i==\$x} {
incr i
continue
}
set allposibles [concat \$allposibles \$p]
incr i
}
lremoveAll pos \$allposibles
if {[llength \$pos]==1} {
lset f [expr {\$x+\$y*9}] [lindex \$pos 0]
lset t [expr {\$x+\$y*9}] [lindex \$pos 0]
set found 1
return \$found
}
}
}
}
return \$found
}
proc sudoku::compute {} {
set f [getNumbers]
while 1 {
set r1 [simpleReduction f]
set r2 [complexReduction f [simpleReduction f 0]]
if {\$r1==0 && \$r2==0} {
break
}
}
setWin \$f

}
proc sudoku::getColumn {f column} {
set l [list]
for {set i 0} {\$i<9} {incr i} {
lappend l [lindex \$f [expr {\$i*9+\$column}]]
}
return \$l
}
proc sudoku::getNumbers {} {
variable win
set f [list]
for {set i 0} {\$i<9*9} {incr i} {
lappend f [list]
}
for {set x 0} {\$x<9} {incr x} {
for {set y 0} {\$y<9} {incr y} {
lset f [expr {\$x+\$y*9}] [\$win.e\${x}_\$y get]
}
}
return \$f
}
list [lindex \$f \$diff] [lindex \$f [expr {\$diff+1}]] [lindex \$f [expr {\$diff+2}]] [lindex \$f [expr {\$diff+9}]] [lindex \$f [expr {\$diff+10}]] [lindex \$f [expr {\$diff+11}]] [lindex \$f [expr {\$diff+18}]] [lindex \$f [expr {\$diff+19}]] [lindex \$f [expr {\$diff+20}]]
}
proc sudoku::getRow {f row} {
lrange \$f [expr {\$row*9}] [expr {\$row*9+8}]
}
set f [tk_getOpenFile -filetypes {{{SuDoKu Files} *.sdk}}]
if {\$f eq ""} {
return
}
set file [open \$f r]
close \$file
setWin \$num
}
proc sudoku::lstep {} {
set f [getNumbers]
set t [simpleReduction f 0]
complexReduction f \$t
setWin \$f
}
proc sudoku::myInit {} {
setWin {
{} {} {} {} 6  {} {} 3  {}
{} {} 5  3  {} {} {} {} {}
8  {} {} {} {} 5  {} 4  7
{} {} {} 1  5  {} {} {} {}
{} 1  {} {} {} {} {} 9  {}
{} 5  {} {} {} 4  3  {} {}
{} {} 4  6  8  {} {} 2  3
2  {} 1  {} 4  {} {} {} 8
{} 9  {} {} 7  2  1  6  {}
}

}
proc sudoku::setMessage mes {
variable win
\$win.lab configure -text \$mes

}
proc sudoku::setWin f {
variable win

for {set x 0} {\$x<9} {incr x} {
for {set y 0} {\$y<9} {incr y} {
\$win.e\${x}_\$y delete 0 end
\$win.e\${x}_\$y insert 0 [lindex \$f [expr {\$x+\$y*9}]]
}
}

}
proc sudoku::simpleReduction {ref_f {reduction 1}} {
upvar \$ref_f f
set fields {1 2 3 4 5 6 7 8 9}
set t [list]

for {set y 0} {\$y<9} {incr y} {
for {set x 0} {\$x<9} {incr x} {
if {[lindex \$f [expr {\$x+\$y*9}]] eq ""} {
set pos \$fields
lremoveAll pos [getRow \$f \$y]
lremoveAll pos [getColumn \$f \$x]
lremoveAll pos [getQuad \$f [expr {\$x/3+(\$y/3)*3}]]
lappend t \$pos
if {[llength \$pos]==1 && \$reduction} {
lset f [expr {\$x+\$y*9}] [lindex \$pos 0]
return 1
} elseif {[llength \$pos]==0} {
setMessage "Keine L½sung \${x}:\$y"
}
} else {
lappend t [lindex \$f [expr {\$x+\$y*9}]]
}
}
}
if {\$reduction==1} {
return 0
}
return \$t
}
proc sudoku::initWindow {window} {
variable win
set win \$window

frame \$win.f
frame \$win.b
label \$win.help -text "Use double click to show possible numbers"  -bg green
if {[lsearch [font names] espfont]<0} {
font create sdkfont -family Courier -size 25
}

for {set y 0} {\$y<9} {incr y} {
for {set x 0} {\$x<9} {incr x} {
set qq [expr {(\$x / 3) + (\$y / 3)}]
entry \$win.e\${x}_\$y -width 2 -font sdkfont
if {[expr {\$qq % 2}]==1} { \$win.e\${x}_\$y  config -bg grey }
bind \$win.e\${x}_\$y <Double-1>  [list sudoku::testPos \$x \$y]
grid \$win.e\${x}_\$y -in \$win.f -column \$x -row \$y -padx 2 -pady 2
}
}
button \$win.compute -text "Solve"      -command sudoku::compute
button \$win.step    -text "Strategy 1" -command sudoku::step
button \$win.lstep   -text "Strategy 2" -command sudoku::lstep
#label \$win.lab -relief raised -border 3
label \$win.lab -relief sunken -border 3

#pack \$win.help -fill x
pack \$win.compute \$win.step \$win.lstep -side left -in \$win.b
#pack \$win.b \$win.lab -fill x
pack \$win.b    -fill x
pack \$win.help -fill x
pack \$win.lab  -fill x

\$win.m add command -label "Clean"       -command sudoku::clear
\$win.m add command -label "Set example" -command sudoku::myInit
\$win.m add command -label "Save"        -command sudoku::save

if {\$win eq ""} {
} else {
}

}

proc sudoku::save {} {
set f [tk_getSaveFile -initialfile my.sdk -filetypes {{{SuDoKu Files} *.sdk}}]
if {\$f eq ""} {
return
}
set file [open \$f w]
puts \$file [getNumbers]
close \$file
}
proc sudoku::step {} {
set f [getNumbers]
set t [simpleReduction f]
setWin \$f
}
proc sudoku::testPos {x y} {
set f [getNumbers]
set t [simpleReduction f 0]
set pos [lindex \$t [expr {\$y*9+\$x}]]
setMessage "\${x}:\$y = \$pos"

}
proc sudoku::try f {
for {set i 0} {\$i<9} {incr i} {
if {[llength [lsort -unique [getColumn \$f \$i]]]!=9} {
return 0
}
if {[llength [lsort -unique [getRow \$f \$i]]]!=9} {
return 0
}
if {[llength [lsort -unique [getQuad \$f \$i]]]!=9} {
return 0
}
}
return 1
}

sudoku::initWindow {}
sudoku::myInit```

HJG Added grey background for every other block, moved help-line directly above output-label.