Updated 2012-11-22 04:16:25 by RLE

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 [1].

Anyway, recently I received the fun book Challenging Logic Puzzles by Barry R. Clarke [2].

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.
``` ##+##########################################################################
#
# 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
DrawMaster
DrawConstraints

bind all <Key-Return> [bind all <Key-Tab>]
bind all <Key-F2> {console show}
}

.m.game add command -label "Save Puzzle" -under 0 -command SavePuzzle
.m.game add command -label "Blank Puzzle" -under 0 -command BlankDlg
.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]
-command [list NewPuzzle \$cnt]
}
}
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 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)
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
}

# http://wiki.tcl.tk/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]
}
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
}
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
}
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]
-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
return```

See also Solving cryptarithms - Solving cryptograms - Brute force with velvet gloves