Keith Vetter - Here's a little tk program that lets you solve the Challenger puzzles that you often find syndicated in the daily paper [L1 ]. In this puzzle you must make each row, column and diagonal add up to a certain sum. This program aids in solving them by giving you running totals, showing illegal, correct and forced squares.
I wrote it with the intention that the user would enter the day's puzzle and then solve it. But I've also include a half-dozen or so puzzles from the last week to give you a taste.
##+##########################################################################
#
# challenger.tcl
#
# Challenger -- helps solve the challenger math puzzle
# by Keith Vetter
#
# Revisions:
# KPV Oct 08, 2002 - initial revision
#
##+##########################################################################
#############################################################################
# All the cells in the puzzle
set state(cells) {0 4
1 0 1 1 1 2 1 3 1 4
2 0 2 1 2 2 2 3 2 4
3 0 3 1 3 2 3 3 3 4
4 0 4 1 4 2 4 3 4 4
5 0 5 1 5 2 5 3 5 4 }
# Some puzzles to play with
set puzzle(0) {16 . 1 . . 9 . . . 3 16 . . 2 . 17 1 . . . 9 11 18 12 10 12}
set puzzle(1) {24 . . 3 . 14 . 9 . . 34 . . . 7 33 6 . . . 30 28 27 29 27 32}
set puzzle(2) {18 . . 3 . 10 . 4 . . 20 . . . 1 10 5 . . . 20 12 13 17 18 12}
set puzzle(3) {7 . 1 . . 8 . . . 1 9 . . 1 . 10 1 . . . 11 9 9 9 11 12}
set puzzle(4) {23 . . . 5 23 6 . . . 23 . . 6 . 23 . 5 . . 23 25 19 25 23 23}
set puzzle(5) {33 . 9 . . 28 . . . 6 30 . . 8 . 29 8 . . . 30 29 30 32 26 27}
set puzzle(6) {35 . . 5 . 23 . 2 . . 21 . . . 9 20 8 . . . 31 20 24 20 31 17}
set puzzle(7) {28 . 9 . . 26 . . 5 . 26 8 . . . 27 . . . 5 27 30 30 22 24 25}
set puzzle(8) {15 5 . . . 16 . . . 3 6 . 3 . . 22 . . 4 . 15 21 12 7 19 9}
# The rows, columns and diagonals
array set rows {
1,4 {1,0 1,1 1,2 1,3} 2,4 {2,0 2,1 2,2 2,3} 3,4 {3,0 3,1 3,2 3,3}
4,4 {4,0 4,1 4,2 4,3} 5,0 {1,0 2,0 3,0 4,0} 5,1 {1,1 2,1 3,1 4,1}
5,2 {1,2 2,2 3,2 4,2} 5,3 {1,3 2,3 3,3 4,3} 5,4 {1,0 2,1 3,2 4,3}
0,4 {4,0 3,1 2,2 1,3}
}
array set move {Up {-1 0} Down {1 0} Left {0 -1} Right {0 1}}
set state(locked) 0
set state(undo) {}
set state(forced) {}
set state(who) -1
proc DoDisplay {} {
wm title . "TkChallenger"
DoMenus
frame .play -bd 2 -relief raised -padx 30 -pady 20
frame .bottom
for {set row 0} {$row < 6} {incr row} {
set cells {}
if {$row == 0} {set cells "x x x x"}
for {set col 0} {$col < 5} {incr col} {
if {$row == 0} {set col 4}
set tag ".e$row,$col"
entry $tag -width 6 -textvariable ss($row,$col) -justify c \
-disabledbackground lightblue -exportselection 0
$tag config -disabledforeground [$tag cget -foreground]
bind $tag <Key> [list MyKey %W %A %K]
if {$row == 5 || $col == 4} {
$tag config -bg cyan -disabledbackground cyan
}
lappend cells $tag
}
eval grid $cells -in .play
}
button .new -text "New Puzzle" -command PickPuzzle -takefocus 0
button .forced -text "Do Forced Moves" -command DoForced -takefocus 0
button .undo -text Undo -command Undo -state disabled -takefocus 0
pack .play .bottom -side top -fill both -expand 1
pack .new .forced .undo -in .bottom -side left -pady 10 -expand 1
array set ::b2m {.lock {.m.puzzle 3} .unlock {.m.puzzle 4} .undo {.m.edit 4}
.erase {.m.edit 0} .eraseA {.m.edit 1} .forced {.m.edit 3}}
focus .e1,0
DoButtons
}
proc DoMenus {} {
menu .m -tearoff 0
. configure -menu .m ;# Attach menu to main window
# Top level menu buttons
.m add cascade -menu .m.puzzle -label "Puzzle" -underline 0
.m add cascade -menu .m.edit -label "Edit" -underline 0
.m add cascade -menu .m.help -label "Help" -underline 0
menu .m.puzzle -tearoff 0
.m.puzzle add command -label "Blank Puzzle" -under 0 -command {Erase 1}
.m.puzzle add command -label "New Puzzle" -under 0 -command PickPuzzle
.m.puzzle add separator
.m.puzzle add command -label "Lock Puzzle" -under 0 -command Lock
.m.puzzle add command -label "Unlock Puzzle" -under 0 -command Unlock
menu .m.edit -tearoff 0
.m.edit add command -label "Erase" -under 0 -command {Erase 0}
.m.edit add command -label "Erase All" -under 6 -command {Erase 1}
.m.edit add separator
.m.edit add command -label "Do Forced Moves" -under 0 -command DoForced
.m.edit add command -label "Undo" -under 0 -command Undo
menu .m.help -tearoff 0
.m.help add command -label Help -under 0 -command Help
}
proc PickPuzzle {{who ""}} {
global state ss puzzle
if {$who == ""} { ;# Pick one at random
set names [array names puzzle]
set len [llength $names]
while {1} {
set n [expr {int(rand() * $len)}]
set who [lindex $names $n]
if {$who != $state(who)} break
if {$len == 1} break
}
}
set state(who) $who
Erase 1
foreach {row col} $state(cells) val $puzzle($who) {
if {$val == "."} {set val {}}
set ss($row,$col) $val
}
Lock
}
# DoButtons -- set the buttons state depending on circumstances
proc DoButtons {} {
global state b2m
array set s {1 normal 0 disabled}
set ww [list .lock .unlock .erase .eraseA .undo .forced]
# Get into bb the states we want
if {$state(locked)} { set bb {0 1 1 0} } { set bb {1 0 0 1} }
lappend bb [expr {[llength $state(undo)] > 0 ? 1 : 0}]
lappend bb [expr {[llength $state(forced)] > 0 ? 1 : 0}]
foreach w $ww b $bb {
if {[winfo exists $w]} { ;# Configure the button
$w configure -state $s($b)
}
foreach {m e} $::b2m($w) { ;# Configure the menu
$m entryconfigure $e -state $s($b)
}
}
}
# Lock -- locks (by disabling) all cells w/ values in them
proc Lock {} {
global ss state
foreach {row col} $state(cells) {
set tag ".e$row,$col"
if {$row == 5 || $col == 4} {
append ss($row,$col) "/ "
} elseif {$ss($row,$col) == ""} continue
$tag config -state disabled
}
set state(locked) 1
set state(undo) {}
DoButtons
SumRows
set w [focus -lastfor .]
if {[winfo exists $w] && [$w cget -state] != "normal"} {
event generate $w <Tab>
}
}
# Unlock -- unlocks (by enabling) all cells
proc Unlock {} {
global ss state
foreach {row col} $state(cells) {
set tag ".e$row,$col"
$tag config -state normal
if {$row == 5 || $col == 4} {
regsub {/.*} $ss($row,$col) {} ss($row,$col)
}
}
set state(locked) 0
DoButtons
}
# Erase -- erases either all non-locked cells, or all cells
proc Erase {all} {
if {! $all && $::state(locked) == 0} return
set undo {}
foreach {row col} $::state(cells) {
set tag ".e$row,$col"
if {$all || [$tag cget -state] == "normal"} {
set was [$tag get]
lappend undo $tag "$row,$col" $was
set ::ss($row,$col) ""
}
}
SumRows
lappend ::state(undo) $undo
if {$all} Unlock
focus .e1,0
DoButtons
}
# SumRows -- the workhorse of our program. Sums up each row and
# updates the running total (deficit actually) and does cell
# configuring for bad, good and forced cells.
proc SumRows {} {
global rows ss state
if {$::state(locked) == 0} return
foreach {row col} $state(cells) { ;# Put all cells back to white
set tag ".e$row,$col"
if {[$tag cget -state] == "normal"} { $tag config -bg white }
}
set state(forced) {}
foreach scell [array names rows] { ;# Loop on each row/col/diagonal
.e$scell config -disabledbackground cyan;# Erase any red or green bg
set n [regexp {\s*([0-9]+)/?} $ss($scell) => max]
if {! $n} continue
set sum 0
set missing {}
foreach cell $rows($scell) { ;# Each cell in row/col/diag
set val $ss($cell)
if {[string is integer -strict $val]} {
set sum [expr {$sum + $val}]
} else {
lappend missing $cell
}
}
# Show running deficit
set ss($scell) [format "%2d/%2d" $max [expr {$max - $sum}]]
# Figure out bad, good or forced cells stuff
set num [llength $missing]
if {$num == 0 && $sum == $max} {
.e$scell config -disabledbackground green
} elseif {$num == 0 || $sum > $max} {
.e$scell config -disabledbackground red
} else {
set delta [expr {1.0 * ($max - $sum) / $num}]
if {$delta < 1 || $delta > 9} {
.e$scell config -disabledbackground red
} elseif {$num == 1 || $delta == 1.0 || $delta == 9.0} {
foreach who $missing {
lappend state(forced) $who [expr {int($delta)}]
set tag ".e$who"
$tag config -bg yellow
}
}
}
}
DoButtons
}
# DoForced -- fills in the values for all forced cells
proc DoForced {} {
global state ss
set undo {}
SumRows ;# Refresh forced info
if {[llength $state(forced)] == 0} return
foreach {cell val} $state(forced) {
if {[info exists done($cell)]} continue
lappend undo ".e$cell" $cell $ss($cell)
set ss($cell) $val
set done($cell) $val
}
lappend state(undo) $undo
SumRows
}
proc Homer {{end 0}} {
}
# MyKey -- handles all keystrokes for each cell
proc MyKey {w char sym} {
regexp {([0-9]),([0-9])} $w who row col
set before [$w get] ;# For undo info
switch -- $sym {
"Tab" { return -code continue }
"asterisk" { Undo }
z { if {$char == "\x1A"} Undo }
"space" { $w delete 0 end }
"BackSpace" - "Delete" {
set pos [$w index insert]
$w delete [incr pos -1] end
}
"Home" - "End" {
if {$sym == "End"} {set event <Shift-Tab>} {set event <Tab>}
focus .e0,4 ; event generate .e0,4 $event
}
"Up" - "Down" - "Left" - "Right" {
foreach {drow dcol} $::move($sym) break
while {1} {
incr row $drow ; incr col $dcol
set ww ".e$row,$col"
if {! [winfo exists $ww]} {return -code break}
if {[$ww cget -state] != "normal"} continue
focus $ww
break
}
}
default {
if {! [string is integer -strict $char]} { return -code break }
if {$row == 5 || $col == 4} { ;# Sum cells
set val [$w get]
if {$val != ""} {
set char [expr {(($val * 10) + $char) % 100}]
}
} elseif {$char == "0"} {
set char ""
}
$w delete 0 end
$w insert 0 $char
#$w selection range 0 end
$w icursor end
if {$row < 5 && $col < 4} {
event generate $w <Tab> ;# Move to next cell
}
}
}
set now [$w get]
if {$before != $now} {lappend ::state(undo) [list $w $who $before]}
SumRows
return -code break
}
# Undo -- Undoes the last operation
proc Undo {} {
global state ss
# Pop off the event to undo
set item [lindex $state(undo) end]
set state(undo) [lrange $state(undo) 0 end-1]
foreach {w who was} $item {
set ss($who) $was
focus $w
}
SumRows
DoButtons
}
proc Help {} {
catch {destroy .help}
toplevel .help
wm title .help "TkChallenger Help"
wm geom .help "+[expr {[winfo x .] + [winfo width .] + 10}]+[winfo y .]"
text .help.t -relief raised -wrap word -width 70 -height 27
.help.t config -padx 10 -pady 10
button .help.dismiss -text Dismiss -command {destroy .help}
pack .help.t -side top -expand 1 -fill both
pack .help.dismiss -side bottom -expand 1 -pady 10
set bold "[font actual [.help.t cget -font]] -weight bold"
.help.t tag configure title -justify center -foreground red \
-font "Times 20 bold"
.help.t tag configure title2 -justify center -font "Times 12 bold"
.help.t tag configure bullet -font $bold
.help.t tag configure bn -lmargin1 15 -lmargin2 15
.help.t tag configure bn2 -lmargin1 15 -lmargin2 20
.help.t insert end "TkChallenger\n" title
.help.t insert end "by Keith Vetter\n\n" title2
set m "This program helps you solve the Challenger puzzles that you often "
append m "see in the daily paper. I wrote this program because I'm "
append m "horrible at solving these puzzles--this helps but I'm still bad."
.help.t insert end $m n \n\n
.help.t insert end "How to Play" bullet \n
set m "Fill in each square with a number, 1-9. "
append m "Horizontal square should add to the total on "
append m "the right, vertical squares to the number on the "
append m "bottom and the main diagonals to the number in "
append m "the upper and lower right."
.help.t insert end $m bn \n\n
.help.t insert end "What the Different Colored Squares Mean" bullet \n
set m "- Cyan squares show the value each row or column must add up "
append m "to along with the amount still needed to reach that value.\n"
append m "- Light blue squares are playing squares with known values.\n"
append m "- Green squares show when a row or column is correct.\n"
append m "- Red squares show when a row or column is in an illegal state.\n"
append m "- Yellow squares show squares for which the value is forced."
.help.t insert end $m bn2 \n\n
.help.t insert end "Built in Puzzles" bullet \n
set m "TkChallenger comes with about half-a-dozen built in puzzles, "
append m "but is really designed for you to create your own. "
append m "Unlocking the puzzle allows you to enter values into "
append m "any square. Once you've entered the puzzle, lock it and "
append m "solve away."
.help.t insert end $m bn \n\n
.help.t config -state disabled
}
DoDisplay
PickPuzzle 8