Keith Vetter 2007-02-09 : Artificial intelligence in Tcl? Here's a program that while I wouldn't call intelligent it clearly does a task which for humans requires intelligence--solving logic problems. I guess that qualifies as weak AI [L1 ].
Anyway, recently I received the fun book Challenging Logic Puzzles by Barry R. Clarke [L2 ].
Many of the puzzles in the book are of the following format: several rows of information organized into several columns categories such as name, occupation, favorite food, etc. But for various (amusing) reasons, the lists are scrambled such that one and only one item in each column is in its correct position. Finally we're given a list of constraints such as the person who eats ice cream is two place above the man in the red shirt. The goal is to unscramble the list.
Here's an example from the book:
Beating at Eating
Name Surname Dessert
Agatha Greed cream puffs
Bugsy Forager trifle
Delilah Eatalot cheesecake
Chuck Hunk ice cream
(short spiel about an eating contest and how the lists
got messed up so that one and only one item in each column
is correctly positioned)
1) Chuck is one place above ice cream
2) Trifle is not above Delilah
3) Greed is two places below Delilah
4) Trifle is one place above Forager.Fun little puzzle, give it a try.
After solving a bunch of these, I decided to see if I could program the computer to solve these types of problems. The approach I took is to enumerate all possible solutions and test each one to see if it matches all the conditions. There were two challenges. First is to enumerate and test all possible combinations. Permutations helped with the enumeration and some fun coding help with the testing.
The bigger challenge was to make the process efficient. The number of possible solutions grows really fast: N rows of M columns yields N!**M possibilities. A simple 4x3 puzzle has 13,824 possible solutions, one 6x4 has 268,738,560,000. I found 3 ways to reduce this number. First, throw out all possibilities not having exactly one item correctly placed. Second, you can prune whole chunks of possibilities by noting that if a certain ordering of column A fails some constraint then you don't need to test that ordering of A with all the possible orderings of the other columns. Third, an optimal reordering of the constraints can increase the likelihood of big chunks being pruned.
How good were these optimations? Well a 5x4 puzzle originally took over thirteen minutes to solve now completes in three seconds (207,360,000 possible solutions reduced to 5,765).
The purpose of this program is to let you enter in puzzles of this type and have the computer solve them. I've included a dozen samples from the book of varying complexity. Give a try at solving them by hand then check out how well the program does.
Jeff Smith 2021-03-03 : Below is an online demo using CloudTk. This demo runs "Solving Logic Puzzles" in an Alpine Linux Docker Container. It is a 27.4MB image which is made up of Alpine Linux + tclkit + Solving-Logic-Puzzles.kit + libx11 + libxft + fontconfig + ttf-linux-libertine. It is run under a user account in the Container. The Container is restrictive with permissions for "Other" removed for "execute" and "read" for certain directories.
##+##########################################################################
#
# LogicPuzzleSolver.tcl -- Solves one type of logic problems
# by Keith Vetter, February 2007
#
package require Tk
package require tile
set S(title) "TCL Logic Puzzle Solver"
array set PERMCNT {0 0 1 1 2 0 3 3 4 8 5 45 6 264 7 1855 8 14832 9 133497}
set PLACES {xx first second third fourth fifth sixth seventh eighth
ninth tenth eleventh twelfth thirteenth fourteenth fifteenth}
proc DoDisplay {} {
global S
wm title . $S(title)
label .tmp
eval font create boldFont [font actual "[.tmp cget -font] bold"]
font create bigBold -family Helvetica -size 18 -weight bold
destroy .tmp
frame .master -bd 0 -relief ridge -padx 10
frame .const -bd 0 -relief ridge
button .solve -text "Solve" -font boldFont -bd 5 -command Solve
pack .master .const -side top -fill x -pady {0 30}
pack .solve -side top -expand 1 -pady 15
DoMenus
DrawMaster
DrawConstraints
bind all <Key-Return> [bind all <Key-Tab>]
bind all <Key-F2> {console show}
}
proc DoMenus {} {
. configure -menu [menu .m -tearoff 0]
.m add cascade -menu [menu .m.game -tearoff 0] -label "Game" -underline 0
.m add cascade -menu [menu .m.puzzle -tearoff 0] -label "Puzzles" -underline 0
.m add cascade -menu [menu .m.help -tearoff 0] -label "Help" -underline 0
.m.game add command -label "Load Puzzle" -under 0 -command LoadPuzzle
.m.game add command -label "Save Puzzle" -under 0 -command SavePuzzle
.m.game add separator
.m.game add command -label "Blank Puzzle" -under 0 -command BlankDlg
.m.game add separator
.m.game add command -label "Exit" -under 1 -command exit
set cnt -1
foreach title [GetTitles] {
incr cnt
#.m.puzzle add command -label $title -command [list NewPuzzle $cnt]
.m.puzzle add radiobutton -label $title -variable S(who) -value $cnt \
-command [list NewPuzzle $cnt]
}
.m.help add command -label About -under 0 -command About
}
proc About {} {
set txt "$::S(title)\nby Keith Vetter, February 2007\n\n"
append txt "There's a class of logic puzzle in which\n"
append txt "there is a grid of people and attributes.\n"
append txt "We know that EXACTLY one attribute in\n"
append txt "each column is positioned correctly.\n\n"
append txt "Also in the puzzle are a set of constraints\n"
append txt "on the items. For example, a typical one\n"
append txt "might be \"Sally is 2 places below the\n"
append txt "doctor\" or \"Bob is not the butcher.\"\n\n"
append txt "This program lets you enter and solve\n"
append txt "such logic puzzles."
tk_messageBox -icon info -message $txt -title "About $::S(title)"
}
proc DrawMaster {} {
global S MASTER
set S(total) [expr {wide(pow($::PERMCNT($S(numElem)), $S(numCol)))}]
set S(total,disp) "[Comma $S(total)] configurations"
set W .master
eval destroy [winfo child $W]
entry $W.title -textvariable ::MASTER(title) -font bigBold -justify c
frame $W.grid
label $W.total -textvariable S(total,disp)
label $W.help -fg red -font boldFont \
-text "EXACTLY one item in each column is correctly positioned"
pack $W.title $W.grid $W.help $W.total -side top -fill both
for {set col 0} {$col < $S(numCol)} {incr col} {
entry $W.title,$col -textvariable ::MASTER(t,$col) \
-justify c -font boldFont -relief solid
grid $W.title,$col -row 0 -column $col -sticky ew -in $W.grid
}
for {set row 0} {$row < $S(numElem)} {incr row} {
for {set col 0} {$col < $S(numCol)} {incr col} {
entry $W.$row,$col -textvariable ::MASTER($row,$col) \
-justify c -bd 1 -relief solid
grid $W.$row,$col -row [expr {$row+1}] -column $col \
-sticky news -in $W.grid
}
}
trace remove variable MASTER write Tracer
trace variable MASTER w Tracer
Tracer MASTER {} w
}
proc DrawConstraints {} {
global S C
set names [GetMasterNames]
set ops [GetOperations]
set W .const
eval destroy [winfo child $W]
label $W.title -text Constraints -font bigBold -justify c
frame $W.grid
pack $W.title $W.grid -side top -fill both
label $W.t,0 -text "Who" -font boldFont -justify c
label $W.t,1 -text "Operation" -font boldFont -justify c
label $W.t,2 -text "Whom" -font boldFont -justify c
grid $W.t,0 $W.t,1 $W.t,2 -row 0 -sticky ew -in $W.grid
for {set row 0} {$row < 10} {incr row} {
set w1 $W.grid.$row,who
set w2 $W.grid.$row,op
set w3 $W.grid.$row,whom
::ttk::combobox $w1 -textvariable C($row,who) \
-values $names -state readonly -justify c
::ttk::combobox $w2 -textvariable C($row,op) \
-values $ops -state readonly -justify c
::ttk::combobox $w3 -textvariable C($row,whom) \
-values $names -state readonly -justify c
grid $w1 $w2 $w3 -row [expr {$row+1}]
}
trace remove variable C write Tracer
trace variable C w Tracer
Tracer C {} w
}
proc Tracer {var1 var2 op} {
global C S MASTER
set valid 1
# MASTER tests
for {set row 0} {$row < $S(numElem)} {incr row} {
for {set col 0} {$col < $S(numCol)} {incr col} {
if {! [info exists MASTER($row,$col)]} { set MASTER($row,$col) ""}
if {$MASTER($row,$col) eq ""} { set valid 0 ; break }
}
if {! $valid} break
}
# Constraint tests
set W .const
if {[winfo exists $W.grid]} {
set names [GetMasterNames]
set ops [GetOperations]
for {set row 0} {$row < 10} {incr row} {
foreach a {who op whom} {
if {! [info exists C($row,$a)]} { set C($row,$a) "" }
if {$C($row,$a) eq "<none>"} {set C($row,$a) ""}
}
set newState readonly
set r [expr {$row - 1}]
if {$row > 0 &&
($C($r,who) eq "" || $C($r,op) eq "" || $C($r,whom) eq "")} {
set newState disabled
if {$C($r,who) ne "" || $C($r,op) ne "" || $C($r,whom) ne ""} {
set valid 0
}
}
set w1 $W.grid.$row,who
set w2 $W.grid.$row,op
set w3 $W.grid.$row,whom
$w1 config -state $newState -value $names
$w2 config -state $newState -values $ops
$w3 config -state $newState -value $names
}
}
.solve config -state [expr {$valid ? "normal" : "disabled"}]
}
proc GetOperations {} {
global S
set all {<none>}
lappend all "above" "not above"
for {set i 1} {$i < $S(numElem)} {incr i} {
lappend all "$i above"
}
lappend all "is" "is not" "below" "not below"
for {set i 1} {$i < $S(numElem)} {incr i} {
lappend all "$i below"
}
lappend all "next to" "not next to"
return $all
}
proc GetMasterNames {} {
global S MASTER
set all {<none>}
for {set col 0} {$col < $S(numCol)} {incr col} {
for {set row 0} {$row < $S(numElem)} {incr row} {
lappend all $MASTER($row,$col)
}
}
set all [concat $all [lrange $::PLACES 1 $S(numElem)]]
return $all
}
proc GetColumnNames {col} {
set all {""}
for {set row 0} {$row < $::S(numElem)} {incr row} {
lappend all $::MASTER($row,$col)
}
return $all
}
proc Solve {} {
global S PERMCNT cnt
Init
set S(result) {}
set S(stat) ""
set S(cnt,disp) 0
set S(where) {}
set S(C) [SortConstraints]
SolveDialog
set start [clock seconds]
set cnt 0
set mod 100
while {1} {
if {($cnt % $mod) == 0} {
set S(cnt,disp) [Comma $cnt];
if {$cnt >= 1000} {set mod 1000}
if {$cnt >= 5000} {set mod 5000}
update
}
incr cnt
if {! [winfo exists .sdlg]} break
if {[TestTrialSolution]} {
lappend S(result) [array get ::TRIAL]
lappend S(where) $cnt
set S(stat) [llength $S(result)]
}
if {[StepTrialSolution]} break
}
set S(cnt) $cnt
set S(ttime) [expr {[clock seconds] - $start}]
if {[winfo exists .sdlg] || $S(result) ne {}} {
SolutionDialog
}
return [llength $S(result)]
}
proc SolutionDialog {} {
global S MASTER TRIAL
set W .sdlg
set WB .sdlg.body
if {! [winfo exists $W]} SolveDialog
set S(cancel) "Dismiss"
eval destroy [winfo child $WB]
set len [llength $S(result)]
if {$len == 0} {
set S(title) "ERROR: no solution"
return
}
if {$len > 1} {
set S(title) "ERROR: $len solutions"
return
}
wm title $W "Solution"
set S(title) $MASTER(title)
$WB config -padx 20 -pady 10
set S(stat) [clock format $S(ttime) -gmt 1 -format %M:%S]
append S(stat) "\t[Comma $S(cnt)]/[Comma $S(total)]"
array set TRIAL [lindex $S(result) 0]
for {set col 0} {$col < $S(numCol)} {incr col} {
label $WB.title,$col -textvariable MASTER(t,$col) \
-justify c -font boldFont -relief solid -bg white
grid $WB.title,$col -row 0 -column $col -sticky ew
grid columnconfigure $WB $col -weight 1 -uniform a
}
for {set row 0} {$row < $S(numElem)} {incr row} {
for {set col 0} {$col < $S(numCol)} {incr col} {
set bg white
if {$TRIAL($row,$col) eq $MASTER($row,$col)} { set bg cyan }
label $WB.$row,$col -textvariable TRIAL($row,$col) \
-justify c -bd 1 -relief solid -bg $bg
grid $WB.$row,$col -row [expr {$row+1}] -column $col \
-sticky news
}
}
CenterWindow $W
bind $W <Escape> [list destroy $W]
bind $W <space> [list destroy $W]
}
proc SolveDialog {} {
global S PERMCNT
set S(cancel) "Stop"
set S(title) "Solving..."
set W .sdlg
destroy $W
toplevel $W
wm withdraw $W
wm title $W ""
wm transient $W .
label $W.title -textvariable S(title) -font bigBold
frame $W.body
label $W.body.cnt -textvariable S(cnt,disp) -anchor e
label $W.body.ttl -text " out of [Comma $S(total)]" -anchor w
label $W.stat -textvariable S(stat)
frame $W.buttons -bd 2 -relief ridge
::ttk::button $W.buttons.cancel -textvariable S(cancel) \
-command [list destroy $W]
grid $W.title -padx 30 -sticky ew
grid $W.body -sticky ew
grid $W.body.cnt $W.body.ttl -sticky ew
grid $W.stat
grid $W.buttons -sticky ew
pack $W.buttons.cancel -side bottom -pady 10
CenterWindow $W .
wm deiconify $W
grab $W
}
proc CenterWindow {w {W .}} {
update idletasks ;# Need to get geometry correct
set wh [winfo reqheight $w] ; set ww [winfo reqwidth $w]
set sw [winfo width $W] ; set sh [winfo height $W]
set sy [winfo y $W] ; set sx [winfo x $W]
set x [expr {$sx + ($sw - $ww)/2}] ; set y [expr {$sy + ($sh - $wh)/2}]
incr y -130
if {$x < 0} { set x 0 } ; if {$y < 0} {set y 0}
wm geometry $w +$x+$y
}
proc TestTrialSolution {} {
global C COL S
if {! [TestColumns]} { return 0 } ;# Shouldn't happen
foreach which $S(C) {
foreach {ok badCol} [Test1Constraint $which] break
if {! $ok} {
for {set i 0} {$i < $badCol} {incr i} {
set COL($i) {}
}
return 0
}
}
return 1
}
proc TestColumns {} {
global S MASTER TRIAL
# One correct per column
for {set col 0} {$col < $S(numCol)} {incr col} {
set numOK 0
for {set row 0} {$row < $S(numElem)} {incr row} {
incr numOK [string equal $MASTER($row,$col) $TRIAL($row,$col)]
}
if {$numOK != 1} { return 0 }
}
return 1
}
proc Test1Column {col} {
global S COL
set numOK 0
for {set row 0} {$row < $S(numElem)} {incr row} {
incr numOK [expr {$row == [lindex $COL($col) $row]}]
}
if {$numOK != 1} { return 0 }
return 1
}
proc Dump {} {
global S TRIAL
for {set row 0} {$row < $S(numElem)} {incr row} {
set line ""
for {set col 0} {$col < $S(numCol)} {incr col} {
append line "$TRIAL($row,$col)\t"
}
puts $line
}
}
proc StepTrialSolution {} {
global S COL
for {set i 0} {$i < $S(numCol)} {incr i} {
set done 1
while {1} {
set COL($i) [NextPerm $COL($i)]
if {$COL($i) eq {}} {
set done 0
set COL($i) [FirstPerm]
}
if {[Test1Column $i]} break
}
FillColumn $i
if {$done} { return 0}
}
return 1
}
proc FillColumn {col} {
global MASTER TRIAL COL S
if {$COL($col) eq {}} return
for {set row 0} {$row < $S(numElem)} {incr row} {
set from [lindex $COL($col) $row]
set TRIAL($row,$col) $MASTER($from,$col)
}
}
proc SortConstraints {} {
global C
set all {}
foreach arr [array names C *,who] {
if {$C($arr) eq ""} continue
set which [lindex [split $arr ","] 0]
foreach {. col0} [FindWho $C($which,who) $which] break
foreach {. col1} [FindWho $C($which,whom) $which] break
set minCol [expr {$col0 < $col1 ? $col0 : $col1}]
lappend all [list $which $minCol]
}
set result {}
foreach arr [lsort -index 1 -decreasing -integer $all] {
lappend result [lindex $arr 0]
}
return $result
}
proc Init {} {
global COL
for {set i 0} {$i < $::S(numCol)} {incr i} {
set COL($i) [FirstPerm]
FillColumn $i
while {1} {
if {[Test1Column $i]} break
set COL($i) [NextPerm $COL($i)]
FillColumn $i
}
}
}
proc FirstPerm {} {
set result {}
for {set i 0} {$i < $::S(numElem)} {incr i} {
lappend result $i
}
return $result
}
# https://wiki.tcl-lang.org/11262
proc NextPerm { perm } {
# Find the smallest subscript j such that we have already visited
# all permutations beginning with the first j elements.
set j [expr { [llength $perm] - 1 }]
set ajp1 [lindex $perm $j]
while { $j > 0 } {
incr j -1
set aj [lindex $perm $j]
if { [string compare $ajp1 $aj] > 0 } {
set foundj {}
break
}
set ajp1 $aj
}
if { ![info exists foundj] } return
# Find the smallest element greater than the j'th among the elements
# following aj. Let its index be l, and interchange aj and al.
set l [expr { [llength $perm] - 1 }]
while { $aj >= [set al [lindex $perm $l]] } {
incr l -1
}
lset perm $j $al
lset perm $l $aj
# Reverse a_j+1 ... an
set k [expr {$j + 1}]
set l [expr { [llength $perm] - 1 }]
while { $k < $l } {
set al [lindex $perm $l]
lset perm $l [lindex $perm $k]
lset perm $k $al
incr k
incr l -1
}
return $perm
}
# +#
# -#
# nextto
# not nextto
# is
# is not
# below
# above
# is 2nd
# is not 2nd
# return 1 if satisfies constraint
proc Test1Constraint {which} {
global C
foreach {row0 col0} [FindWho $C($which,who) $which] break
set op $C($which,op)
foreach {row1 col1} [FindWho $C($which,whom) $which] break
set minCol [expr {$col0 < $col1 ? $col0 : $col1}]
if {[regexp {^(\d+) below$} $op => num]} {
set n [expr {$row0 - $num}]
return [list [expr {$n == $row1}] $minCol]
}
if {[regexp {^(\d+) above$} $op => num]} {
set n [expr {$row0 + $num}]
return [list [expr {$n == $row1}] $minCol]
}
if {$op eq "is"} {
return [list [expr {$row0 == $row1}] $minCol]
}
if {$op eq "is not"} {
return [list [expr {$row0 != $row1}] $minCol]
}
if {$op eq "next to"} {
set n [expr {abs($row0 - $row1)}]
return [list [expr {$n == 1}] $minCol]
}
if {$op eq "not next to"} {
set n [expr {abs($row0 - $row1)}]
return [list [expr {$n != 1}] $minCol]
}
if {$op eq "above"} {
return [list [expr {$row0 < $row1}] $minCol]
}
if {$op eq "not above"} {
return [list [expr {$row0 >= $row1}] $minCol]
}
if {$op eq "below"} {
return [list [expr {$row0 > $row1}] $minCol]
}
if {$op eq "not below"} {
return [list [expr {$row0 <= $row1}] $minCol]
}
error "bad op"
return 0
}
proc FindWho {who which} {
global S TRIAL
set who [string tolower $who]
for {set row 0} {$row < $S(numElem)} {incr row} {
for {set col 0} {$col < $S(numCol)} {incr col} {
set t [string tolower $TRIAL($row,$col)]
if {$t eq $who} { return [list $row $col] }
}
}
set n [lsearch $::PLACES $who]
if {$n != -1} { return [list [expr {$n - 1}] 9999] }
error "Can't find '$who' => which: $which"
return {-1 -1}
}
proc Comma { num } {
while {[regsub {^([-+]?[0-9]+)([0-9][0-9][0-9])} $num {\1,\2} num]} {}
return $num
}
proc Reset {} {
global S MASTER C
#unset -nocomplain S
unset -nocomplain MASTER
unset -nocomplain C
set S(numCol) 3
set S(numElem) 4
}
proc NewPuzzle {{who ""}} {
global S MASTER C PUZZLE
set S(who) $who
if {$who ne ""} {
Reset
foreach {title s m c} $PUZZLE($who) break
array set S $s
array set MASTER $m
array set C $c
set MASTER(title) $title
} else {
set col $S(numCol)
set elem $S(numElem)
Reset
set S(numCol) $col
set S(numElem) $elem
foreach arr [array names MASTER] { set MASTER($arr) "" }
}
DrawMaster
DrawConstraints
}
proc BlankDlg {} {
global S
set W .ndlg
destroy $W
toplevel $W
wm title $W ""
wm transient $W .
wm withdraw $W
wm protocol $W WM_DELETE_WINDOW BlankDone
label $W.title -text "New Puzzle Size" -font bigBold
label $W.lcol -text "Columns"
tk_optionMenu $W.ecol S(numCol) 2 3 4 5 6
label $W.lrow -text "Rows"
tk_optionMenu $W.erow S(numElem) 2 3 4 5 6
frame $W.buttons -bd 2 -relief ridge
::ttk::button $W.buttons.ok -text Okay -command BlankDone
grid $W.title - -sticky ew
grid $W.lcol -row 1 -column 0 -sticky e
grid $W.ecol -row 1 -column 1 -sticky w
grid $W.lrow -row 2 -column 0 -sticky e
grid $W.erow -row 2 -column 1 -sticky w
grid $W.buttons - -sticky ew
pack $W.buttons.ok -pady 15 -expand 1
CenterWindow $W
wm deiconify $W
}
proc BlankDone {} {
destroy .ndlg
NewPuzzle
}
proc GetTitles {} {
global PUZZLE
set all {}
for {set i 0} {[info exists PUZZLE($i)]} {incr i} {
lappend all [lindex $PUZZLE($i) 0]
}
return $all
}
proc LoadPuzzle {} {
global S PUZZLE
set types {{{Puzzle Files} {.pzl}} {{All Files} *}}
set fname [tk_getOpenFile -filetypes $types -initialfile puzzle.pzl]
if {$fname eq ""} return
if {[interp exists newInterp]} { interp delete newInterp }
interp create -safe newInterp
newInterp eval set P {{}}
if {[catch {newInterp invokehidden source $fname}]} {
interp delete newInterp
error "Bad puzzle file: $fname"
}
set P [newInterp eval set P]
interp delete newInterp
if {[llength $P] != 4} { error "Bad puzzle file data: $fname" }
if {[array names PUZZLE *,user] eq {}} {.m.puzzle add separator}
set n [llength [array names PUZZLE]]
set PUZZLE($n,user) $P
set title [lindex $PUZZLE($n,user) 0]
.m.puzzle add radiobutton -label $title -variable S(who) -value $n,user \
-command [list NewPuzzle $n,user]
NewPuzzle $n,user
}
proc SavePuzzle {} {
set txt [SerializePuzzle]
set types {{{Puzzle Files} {.pzl}} {{All Files} *}}
set fname [tk_getSaveFile -filetypes $types -initialfile puzzle.pzl]
if {$fname eq ""} return
set fout [open $fname w]
puts $fout $txt
close $fout
}
proc SerializePuzzle {} {
global S MASTER C
set t " "
set p "set P {\n"
append p "$t\"$MASTER(title)\"\n"
append p "$t{numCol $S(numCol) numElem $S(numElem)}\n"
append p "$t{\n$t$t"
for {set col 0} {$col < $S(numCol)} {incr col} {
append p "t,$col \"$MASTER(t,$col)\"\t"
}
for {set row 0} {$row < $S(numElem)} {incr row} {
append p "\n$t$t"
for {set col 0} {$col < $S(numCol)} {incr col} {
append p "$row,$col \"$MASTER($row,$col)\"\t"
}
}
append p "\n$t}\n"
append p "$t{\n"
foreach arr [lsort -dictionary [array names C *,who]] {
if {$C($arr) eq ""} break
set which [lindex [split $arr ","] 0]
append p "$t$t$which,who \"$C($which,who)\""
append p "\t$which,op \"$C($which,op)\""
append p "\t$which,whom \"$C($which,whom)\"\n"
}
append p "$t}\n"
append p "}"
return $p
}
################################################################
set n -1
set PUZZLE([incr n]) {
"The Greatest Human Being"
{ numCol 3 numElem 4}
{
t,0 "First Name" t,1 "Surname" t,2 "Speciality"
0,0 Isaac 0,1 Newtune 0,2 welder
1,0 Albert 1,1 Eyeline 1,2 gardener
2,0 Marie 2,1 Curious 2,2 cleaner
3,0 Charles 3,1 Darling 3,2 bricklayer
}
{
0,who Albert 0,op "2 above" 0,whom bricklayer
1,who Darling 1,op "1 below" 1,whom Charles
2,who Curious 2,op "2 below" 2,whom welder
}
}
set PUZZLE([incr n]) {
"Tape Teaser"
{ numCol 3 numElem 4 }
{
t,0 Nickname t,1 Surname t,2 Hometown
0,0 Rocky 0,1 Tryson 0,2 Boston
1,0 Sugar 1,1 Holyhead 1,2 Seattle
2,0 Basher 2,1 McCool 2,2 Texas
3,0 Iron 3,1 Freeman 3,2 {New York}
}
{
0,op {1 below} 0,who Freeman 0,whom Boston
1,op {1 above} 1,who Seattle 1,whom Iron
2,op {2 below} 2,who McCool 2,whom Sugar
3,op {} 3,who {} 3,whom {}
4,op {} 4,who {} 4,whom {}
5,op {} 5,who {} 5,whom {}
6,op {} 6,who {} 6,whom {}
7,op {} 7,who {} 7,whom {}
8,op {} 8,who {} 8,whom {}
9,op {} 9,who {} 9,whom {}
}
}
set PUZZLE([incr n]) {
"Puzzle in the Park"
{numCol 3 numElem 4}
{
t,0 "Squirrel" t,1 "Tree" t,2 "Nuts"
0,0 "Gerald" 0,1 "Birch" 0,2 "11"
1,0 "Scamper" 1,1 "Sycamore" 1,2 "12"
2,0 "Basil" 2,1 "Ash" 2,2 "10"
3,0 "Tufty" 3,1 "Oak" 3,2 "9"
}
{
0,who "Sycamore" 0,op "1 below" 0,whom "12"
1,who "10" 1,op "1 above" 1,whom "Tufty"
2,who "Ash" 2,op "2 below" 2,whom "Scamper"
3,who "10" 3,op "is not" 3,whom "second"
}
}
set PUZZLE([incr n]) {
"Beating at Eating"
{numCol 3 numElem 4}
{
t,0 "Name" t,1 "Surname" t,2 "Dessert"
0,0 "Agatha" 0,1 "Greed" 0,2 "cream puffs"
1,0 "Bugsy" 1,1 "Forager" 1,2 "trifle"
2,0 "Delilah" 2,1 "Eatalot" 2,2 "cheesecake"
3,0 "Chuck" 3,1 "Hunk" 3,2 "ice cream"
}
{
0,who "Chuck" 0,op "1 above" 0,whom "ice cream"
1,who "trifle" 1,op "not above" 1,whom "Delilah"
2,who "Greed" 2,op "2 below" 2,whom "Delilah"
3,who "trifle" 3,op "1 above" 3,whom "Forager"
}
}
set PUZZLE([incr n]) {
"Best Book Prize"
{ numCol 4 numElem 4}
{
t,0 "Verb 1" t,1 "Noun" t,2 "Verb 2" t,3 Adverb
0,0 Killing 0,1 Puddings 0,2 Laughing 0,3 Stupidly
1,0 Making 1,1 Sharks 1,2 Jumping 1,3 Loudly
2,0 Hitting 2,1 Cakes 2,2 Running 2,3 Cruelly
3,0 Shooting 3,1 Flies 3,2 Hopping 3,3 Quickly
}
{
0,who Jumping 0,op "not next to" 0,whom Running
1,who Sharks 1,op "1 below" 1,whom Loudly
2,who Killing 2,op "1 above" 2,whom Quickly
3,who Sharks 3,op "is not" 3,whom Running
4,who Making 4,op "1 below" 4,whom Jumping
5,who Cakes 5,op "1 above" 5,whom Running
}
}
set PUZZLE([incr n]) {
"Alien Court"
{numCol 3 numElem 5}
{ t,0 "Captain" t,1 "Planet" t,2 "Spaceship"
0,0 "Ponga" 0,1 "Blink" 0,2 "Outagas"
1,0 "Bleep" 1,1 "Loopy" 1,2 "Boldleego"
2,0 "Arial" 2,1 "Grunt" 2,2 "Rustcan"
3,0 "Tweak" 3,1 "Pobble" 3,2 "Hosspuld"
4,0 "Riddle" 4,1 "Ether" 4,2 "Supersnail"
}
{ 0,who "Boldleego" 0,op "above" 0,whom "Pobble"
1,who "Pobble" 1,op "not above" 1,whom "Rustcan"
2,who "Ponga" 2,op "1 below" 2,whom "Grunt"
3,who "Ponga" 3,op "1 above" 3,whom "Outagas"
4,who "Arial" 4,op "is not" 4,whom "fourth"
5,who "Blink" 5,op "2 above" 5,whom "Riddle"
6,who "Blink" 6,op "1 above" 6,whom "Hosspuld"
}
}
set PUZZLE([incr n]) {
"Court Napping"
{ numCol 3 numElem 5}
{
t,0 Title t,1 Name t,2 "Favorite Game"
0,0 Princess 0,1 Yawny 0,2 hearts
1,0 Duke 1,1 Driftoff 1,2 rummy
2,0 King 2,1 Bleereye 2,2 gin
3,0 Queen 3,1 Mutter 3,2 bridge
4,0 Earl 4,1 Outovit 4,2 poker
}
{
0,who Earl 0,op "1 below" 0,whom Mutter
1,who Outovit 1,op "1 above" 1,whom bridge
2,who King 2,op "is not" 2,whom Mutter
3,who King 3,op "is not" 3,whom bridge
4,who hearts 4,op "1 above" 4,whom Bleereye
5,who Bleereye 5,op "2 below" 5,whom King
6,who Princess 6,op "2 above" 6,whom poker
}
}
set PUZZLE([incr n]) {
"The Feed'em-Fat Diner"
{numCol 3 numElem 5}
{
t,0 "First Name" t,1 "Surname" t,2 "Occupation"
0,0 "Dave" 0,1 "Jaffa" 0,2 "manager"
1,0 "Connie" 1,1 "Fish" 1,2 "receptionist"
2,0 "Bill" 2,1 "Gateau" 2,2 "chef"
3,0 "Eleanor" 3,1 "Ingest" 3,2 "waiter"
4,0 "Anne" 4,1 "Haddock" 4,2 "dishwasher"
}
{
0,who "Haddock" 0,op "2 below" 0,whom "manager"
1,who "Dave" 1,op "2 above" 1,whom "Ingest"
2,who "waiter" 2,op "2 above" 2,whom "Anne"
3,who "Eleanor" 3,op "3 below" 3,whom "receptionist"
4,who "Fish" 4,op "is not" 4,whom "first"
}
}
set PUZZLE([incr n]) {
"Animal Races"
{numCol 3 numElem 6}
{
t,0 "Animal" t,1 "Name" t,2 "Prize"
0,0 "badger" 0,1 "Karen" 0,2 "Porsche"
1,0 "elephant" 1,1 "Harry" 1,2 "spoon"
2,0 "antelope" 2,1 "Lorna" 2,2 "television"
3,0 "cat" 3,1 "Ian" 3,2 "microwave"
4,0 "dog" 4,1 "George" 4,2 "carrot"
5,0 "frog" 5,1 "Jenny" 5,2 "radiator"
}
{
0,who "badger" 0,op "is not" 0,whom "sixth"
1,who "George" 1,op "is not" 1,whom "sixth"
2,who "microwave" 2,op "2 below" 2,whom "Harry"
3,who "microwave" 3,op "1 above" 3,whom "elephant"
4,who "Ian" 4,op "is not" 4,whom "carrot"
5,who "Ian" 5,op "not next to" 5,whom "Lorna"
6,who "spoon" 6,op "3 below" 6,whom "Ian"
7,who "spoon" 7,op "2 below" 7,whom "dog"
8,who "Porsche" 8,op "1 below" 8,whom "Lorna"
9,who "Porsche" 9,op "1 above" 9,whom "antelope"
}
}
set PUZZLE([incr n]) {
"A Meal Out"
{numCol 4 numElem 5}
{
t,0 "Nickname" t,1 "Name" t,2 "Food" t,3 "Beverage"
0,0 "Doghouse" 0,1 "Steve" 0,2 "pork" 0,3 "milkshake"
1,0 "Bigears" 1,1 "Annie" 1,2 "lamb" 1,3 "latte"
2,0 "Tender" 2,1 "Chris" 2,2 "beef" 2,3 "cappuccino"
3,0 "Simple" 3,1 "Jackie" 3,2 "chicken" 3,3 "mocha"
4,0 "Wimpsy" 4,1 "Georgina" 4,2 "fish" 4,3 "tea"
}
{
0,who "Annie" 0,op "1 below" 0,whom "beef"
1,who "pork" 1,op "1 above" 1,whom "Tender"
2,who "pork" 2,op "1 below" 2,whom "tea"
3,who "Chris" 3,op "not next to" 3,whom "Steve"
4,who "fish" 4,op "1 below" 4,whom "mocha"
5,who "fish" 5,op "2 below" 5,whom "Steve"
6,who "Annie" 6,op "is not" 6,whom "fifth"
7,who "Doghouse" 7,op "is not" 7,whom "fifth"
8,who "Bigears" 8,op "1 above" 8,whom "latte"
9,who "Bigears" 9,op "1 below" 9,whom "Chris"
}
}
set PUZZLE([incr n]) {
"Whodunnit?"
{ numCol 4 numElem 5}
{
t,0 "First Name" t,1 Surname t,2 Weapon t,3 Location
0,0 James 0,1 Bracket 0,2 hammer 0,3 kitchen
1,0 Lyn 1,1 Thrust 1,2 rope 1,3 conservatory
2,0 Sid 2,1 Nutter 2,2 gun 2,3 hall
3,0 Alice 3,1 Kilroy 3,2 knife 3,3 library
4,0 Eunice 4,1 Loosenut 4,2 poison 4,3 study
}
{
0,who conservatory 0,op "1 below" 0,whom Nutter
1,who conservatory 1,op "1 above" 1,whom knife
2,who gun 2,op "below" 2,whom Alice
3,who James 3,op "2 above" 3,whom Kilroy
4,who poison 4,op "above" 4,whom Bracket
5,who hall 5,op "1 below" 5,whom gun
6,who hall 6,op "1 above" 6,whom Eunice
7,who Alice 7,op "is" 7,whom library
}
}
set PUZZLE([incr n]) {
"Alien Ages"
{numCol 4 numElem 6}
{
t,0 "Name" t,1 "Race" t,2 "Planet" t,3 "Age"
0,0 "Bleep" 0,1 "Tartan" 0,2 "Parp" 0,3 "213"
1,0 "Ting" 1,1 "Polyp" 1,2 "Dorb" 1,3 "385"
2,0 "Hoot" 2,1 "Bunter" 2,2 "Esther" 2,3 "706"
3,0 "Eek" 3,1 "Crispy" 3,2 "Booper" 3,3 "503"
4,0 "Peep" 4,1 "Winky" 4,2 "Grunt" 4,3 "897"
5,0 "Doodah" 5,1 "Fodder" 5,2 "Flip" 5,3 "32"
}
{
0,who "Grunt" 0,op "1 above" 0,whom "Fodder"
1,who "Booper" 1,op "3 below" 1,whom "Eek"
2,who "Booper" 2,op "2 below" 2,whom "32"
3,who "Doodah" 3,op "2 above" 3,whom "Tartan"
4,who "Doodah" 4,op "1 below" 4,whom "385"
5,who "706" 5,op "3 above" 5,whom "Ting"
6,who "Peep" 6,op "2 below" 6,whom "Bunter"
7,who "Peep" 7,op "1 above" 7,whom "Parp"
8,who "Esther" 8,op "1 above" 8,whom "213"
9,who "Esther" 9,op "3 above" 9,whom "Polyp"
}
}
set S(numCol) 3
set S(numElem) 4
DoDisplay
NewPuzzle 0
returnSee also Solving cryptarithms - Solving cryptograms - Brute force with velvet gloves