Updated 2016-05-03 19:33:30 by gold

Keith Vetter 2006-10-12 : Here's a little program to solve word chains--a list of words where each word differs from its neighbor by exactly one letter. An example of a word chain would be warm - ward - card - cord - cold.

You first enter a starting and ending word both of either three or four letters. Then this program will compute the shortest word chain leading from the starting word and leading to the ending word. Built into this program is a 500+ 3-letter word list and a 2300+ 4-letter word list.

I'm a bit proud of my algorithm for determining all neighboring words for given word. I came up with a 1-liner using regular expressions and lsearch. For example, the neighbors of warm can be found with:
`    lsearch -all -regexp \$wordlist "(.arm)|(w.rm)|(wa.m)|(war.)"`

See also The word-chain game for an abortive start at a similar idea.
``` ##+##########################################################################
#
# WordChain.tcl -- Computes word chains for 3 & 4 letter words
# by Keith Vetter, Oct 12, 2006
#

package require Tk
package require tile

proc DoDisplay {} {
wm title . "Word Chain"

label .title -text "Word Chain" -font {Times 32 bold} -relief raised -fg blue
frame .puzzle
entry .start -textvariable W(start) -width 5
label .arrow -text ">>"
entry .end -textvariable W(end) -width 5

frame .answer -bd 2 -relief ridge
listbox .lb -yscrollcommand ".sb_y set" -bd 0 -listvariable W(answer) \
-exportselection 0 -takefocus 0 -font {Courier 10} -width 11 -height 9
scrollbar .sb_y -orient v -command ".lb yview"
pack .sb_y -in .answer -side right -fill y
pack .lb -in .answer -side left -fill both -expand 1

pack .start .arrow .end -in .puzzle -side left -expand 1

frame .buttons
::ttk::button .go -text "Solve" -command Solve
::ttk::button .rand -text "Random" -command Random
pack .about -side bottom -in .buttons

grid .puzzle .buttons -sticky ns -pady {0 10}

foreach i [trace info variable ::W] { eval trace remove variable ::W \$i }
set ::W(solving) 0
trace variable ::W w Tracer
}

proc Chain {start end {progress {}}} {
if {\$start eq \$end} {return [list \$start \$end]}

set wlen [string length \$start]

QInit
QPush [list \$start -1 0]
QVisited \$start

set cnt 0
while {1} {
foreach {id word . depth} [QPop] break
if {\$id == -1} break                    ;# Failure, empty Q

incr depth
if {([incr cnt] % 100) == 0} {
if {\$progress ne ""} { \$progress \$cnt \$depth }
}
foreach idx [lsearch -all -regexp \$::WORDS(\$wlen) [MakeRE \$word]] {
set next [lindex \$::WORDS(\$wlen) \$idx]
if {[QVisited \$next]} continue      ;# Already done this word, skip
QPush [list \$next \$id \$depth]
if {\$next eq \$end} break
}
if {\$next eq \$end} break
}
if {\$id == -1} { return {} }
return [GetSolution]
}
proc Progress {cnt depth} {
lappend ::W(answer) [format "%2d %5d" \$depth \$cnt]
.lb see end
update
}
proc MakeRE {word} {
set re {}
for {set i 0} {\$i < [string length \$word]} {incr i} {
lappend re "([string replace \$word \$i \$i .])"
}
set re [join \$re "|"]
return \$re
}

proc QInit {} {
unset -nocomplain ::Q
set ::Q(tail) 0                             ;# Tail: last unviewed item
}
proc QPush {token} {
}
proc QPop {} {
if {\$::Q(head) == \$::Q(tail)} { return -1}  ;# Empty Q
set id \$::Q(tail)
incr ::Q(tail)
return [concat \$id \$::Q(\$id)]
}
proc QVisited {word} {
if {[info exists ::Q(v,\$word)]} { return 1 }
set ::Q(v,\$word) 1
return 0
}

proc GetSolution {} {
set id [expr {\$::Q(head) - 1}]              ;# Last item in Q
set chain {}
while {\$id != -1} {
foreach {word id} \$::Q(\$id) break
set chain [concat \$word \$chain]
}
return \$chain
}
proc Shuffle { alist } {
set len [llength \$alist]
set len2 \$len
for {set i 0} {\$i < \$len-1} {incr i} {
set n [expr {int(\$i + \$len2 * rand())}]
incr len2 -1

# Swap elements at i & n
set temp [lindex \$alist \$i]
lset alist \$i [lindex \$alist \$n]
lset alist \$n \$temp
}
return \$alist
}

proc Solve {} {
if {\$::W(solving)} return

set ::WORDS(3) [Shuffle \$::WORDS(3)]
set ::WORDS(4) [Shuffle \$::WORDS(4)]

set ::W(solving) 1
set answer [Chain \$::W(start) \$::W(end) Progress]

set ::W(solving) 0
}
proc Random {} {
if {\$::W(solving)} return
set wlen [expr {rand() > .5 ? 4 : 3}]
set llen [llength \$::WORDS(\$wlen)]
set ::W(start) [lindex \$::WORDS(\$wlen) [expr {int(rand() * \$llen)}]]
set ::W(end) [lindex \$::WORDS(\$wlen) [expr {int(rand() * \$llen)}]]
}
proc Tracer {var1 var2 op} {
if {\$::W(solving)} return
set status disabled
while {1} {
set wlen [string length \$::W(start)]
if {\$wlen != [string length \$::W(end)]} break
if {! [info exists ::WORDS(\$wlen)]} break
if {[lsearch -exact \$::WORDS(\$wlen) \$::W(start)] == -1} break
if {[lsearch -exact \$::WORDS(\$wlen) \$::W(end)] == -1} break
set status normal
break
}
.go config -state \$status
}
set msg "Word Chain\nBy Keith Vetter, Oct 2006"
}
################################################################
set WORDS(3) {
amp and ant any ape apt arc are ark arm art ash ask asp ass ate auf aux awe
awl awn axe aye baa bad bag bah ban bar bat bay bed bee beg bet bib bid big
bin bit boa bob bog boo bop bow box boy bra bud bug bum bun bus but buy bye
cab cad cam can cap car cat caw cay cee chi cob cod cog col con coo cop cot
cow coy cry cub cud cue cup cur cut dab dad dam day dee den dew did die dig
dim din dip doc doe dog don dot dry dub dud due dug dun duo dye ear eat ebb
eel egg ego eke elf elk ell elm emu end eon era ere erg err eta eve ewe eye
fad fag fan far fat fax fay fed fee fen few fey fez fib fie fig fin fir fit
fix flu fly fob foe fog fop for fox fro fry fun fur gab gad gag gal gam gap
gar gas gay gee gel gem get gig gin gnu gob god got gum gun gut guy gym gyp
had hag hah ham has hat haw hay hem hen hep her hew hex hey hid hie him hip
his hit hob hod hoe hog hoi hop hot how hub hue hug huh hum hut ice icy ifs
ilk ill imp ink inn ins ion ire irk its ivy jab jag jam jar jaw jay jet jib
jig job jog jot joy jug jus jut keg ken key kid kin kip kit lab lad lag lam
lap law lax lay lea led lee leg lei let lib lid lie lip lit lob log loo lop
lot low lox lug lye mad man map mar mat maw max may men met mew mid mil min
mix mob mod mom moo mop mow mud mug mum nab nag nap nay nee net new nib nil
nip nit nix nod non nor not now nth nub nun nut oaf oak oar oat obi odd ode
off oft ohm oil old ole one opt orb ore ort our out ova owe owl own pad pal
pan pap par pat paw pay pea pee peg pen pep per pet pew phi pie pig pin pip
pit pix ply pod poi pop pot pow pox pry psi pub pug pun pup pus put rag rah
ram ran rap rat raw ray red ref rep ret rev rex rho rib rid rig rim rip rob
roc rod roe rot row rub rue rug rum run rut rye sac sad sag sap sat saw sax
say sea see seq set sew sex she shy sic sin sip sir sis sit six ski sky sly
sob sod sol son sop sot sow soy spa spy sty sub sue sum sun sup tab tad tag
tam tan tao tap tar tat tau tax tea ted tee ten the thy tic tie tin tip tit
toe tog tom ton too top tor tot tow toy try tub tug tun tux two ump ups urn
use van vat vee vet vex via vie vim viz vow wad wag wan war was wax way web
wed wee wet who why wig win wit woe won woo wow wry yak yam yap yaw yea yen
yes yet yew yip yon you zag zap zed zee zip zoo}
set WORDS(4) {
abbe abed abet able ably abut aced aces ache achy acid acme acne acre acts
acyl adds aero afar agar aged ages agog ague ahem ahoy aide aids ails aims
airs airy ajar akin alai alar alas alba albs alee ales alga alia alit ally
alms aloe alps also alto alum amah ambo amen amid ammo amok amps anal anew
ankh anon ante ants anus aped apes apex apse aqua arch arcs area ares aria
arid arks arms army arts arty arum ashy asks asps assn atom atop aula auld
aunt aura auto avec aver avid avis avow away awed awes awls awns awry axed
axes axil axis axle axon ayah ayes baas babe baby back bade bags bail bait
bake bald bale balk ball balm band bane bang bank bans barb bard bare bark
barn bars base bash bask bass bate bath bats batt baud bawd bawl bays bead
beak beam bean bear beat beau beck beds beef been beep beer bees beet begs
bell belt bema bend bent berg best beta bets bevy bias bibs bide bids bier
bike bile bilk bill bind bins bird bite bits blab bled blew blip blob bloc
blot blow blue blur boar boas boat bobs bock bode body bogs bogy boil bola
bold bole boll bolo bolt bomb bona bond bone bong bony book boom boon boor
boos boot bops bore born bosh boss both bout bowl bows boxy brad brae brag
bran bras brat bray bred brew brig brim brow brut bubo buck buds buff bugs
bulb bulk bull bump bums bung bunk buns bunt buoy burg burl burn burp burr
bury bush buss bust busy butt buys buzz byes byte cabs cads cafe cage cake
calf call calm came camp cams cane cans cant cape caps card care carp cars
cart case cash cask cast cats cava cave cavy caws cays cede cell cent chap
char chat chef chew chic chin chip chit chop chow chub chug chum ciao cite
city clad clam clan clap claw clay clef clew clip clod clog clop clot cloy
club clue coal coat coax cobs coca cock coco coda code cods coed cogs coif
coil coin coke cola cold colt coma comb come cone conk conn cons cony cook
cool coon coop coos coot cope cops copy cord core cork corn cost cote cots
coup cove cowl cows cozy crab crag cram crap craw crew crib crop crow crux
cube cubs cuds cued cues cuff cull cult cups curb curd cure curl curs curt
cusp cuss cute cuts cyan cyst czar dabs dado dads daft dais dale dame damn
damp dams dank dare dark darn dart dash data date daub dawn days daze dead
deaf deal dean dear debt deck deed deem deep deer deft defy deja deli dell
demo dens dent deny desk dewy dhow dial dice dick died diem dies diet digs
dike dill dime dims dine ding dins dint dips dire dirk dirt disc dish disk
diva dive dock docs dodo doer does doff doge dogs dole doll dolt dome done
dong dons doom door dope dorm dory dose dost dote doth dots dour dove down
doze dozy drab drag dram draw dray drew drip drop drub drug drum dual dubs
duck duct dude duds duel dues duet dugs duke dull duly dumb dump dune dung
dunk duns duos dupe dusk dust duty dyad dyed dyer dyes dyne each earl earn
ears ease east easy eats eave ebbs echo ecru eddy edge edgy edit eels egad
eggs egos eked ekes elan elks ells elms else emir emit emus ends envy eons
epee epic eras ergo ergs errs espy etch even ever eves evil ewer ewes exam
exec exes exit eyed face fact fade fads fags fail fair fake fall fame fang
fans fare farm faro fast fate fats faun faux fawn fays faze fear feat feed
feel fees fell felt fend fens fern fete feud fiat fibs fife figs file fill
film find fine fink fins fire firm firs fish fist fits five fizz flag flak
flap flat flaw flax flay flea fled flee flew flex flip flit floc floe flog
flop flow flub flue flux foal foam fobs foci foes fogs fogy foil fold folk
fond font food fool foot fops ford fore fork form fort foul four fowl foxy
frau fray free fret frog from fuel full fume fumy fund funk furl furs fury
fuse fuss fuzz gabs gads gaff gage gags gain gait gala gale gall gals game
gams gamy gang gape gaps garb gars gash gasp gate gaud gave gawk gays gaze
gear geek geld gels gems gene gent germ gets gibe gift gigs gild gill gilt
gins gird girl girt gist give glad glee glen glib glob glow glue glum glut
gnat gnaw gnus goad goal goat gobs gods goes gogo gold golf gone gong good
goof gook goon gore gory gosh gout gown grab grad gram gray grew grey grid
grim grin grip grit grog grot grow grub gulf gull gulp gums gunk guns guru
gush gust guts guys gyms gyps gyre gyro hack haft hags hail hair hake hale
half hall halo halt hams hand hang hank hard hare hark harm harp hart hash
hasp hast hate hath hats haul have hawk haws hays haze hazy head heal heap
hear heat heck heed heel heft heir held hell helm help hemp hems hens herb
herd here hero hers hewn hews hick hide hied hies high hike hill hilt hind
hint hips hire hiss hits hive hoax hobo hobs hock hods hoed hoer hoes hogs
hold hole holy home homo hone honk hood hoof hook hoop hoot hope hops horn
hors hose host hour hove howl hubs huck hued hues huff huge hugs hula hulk
hull hump hums hung hunk hunt hurl hurt hush husk huts hymn hypo iamb ibex
ibid ibis iced ices icon idea ides idle idly idol iffy ills imam imps inch
info inks inky inns into ions iota ipso ires iris irks iron isle itch item
jabs jack jade jags jail jake jamb jams jape jars jaws jays jazz jean jeep
jeer jell jerk jess jest jets jibe jibs jiff jigs jilt jinn jinx jive jobs
jock jogs john joie join joke jolt josh joss jots jour jowl joys judo jugs
jump junk jure jury just jute juts kale kava kayo keel keen keep kegs kelp
kens kepi kept keys khan kick kids kill kiln kilo kilt kind kine king kink
kips kirk kiss kite kith kits kiwi knee knew knit knob knot know kola kung
lame lamp land lane lank laps lard lark lash lass last late lath laud lava
lave lawn laws lays laze lazy lead leaf leak lean leap leas leek leer lees
left legs leis lend lens lent less lest lets levy lewd liar libs lice lice
lick lids lied lief lien lies lieu life lift like lilt lily limb lime limn
limp limy line ling link lint lion lips lisp list live load loaf loam loan
lobe lobs loch loci lock loco lode loft loge logs logy loin loll lone long
look loom loon loop loot lope lops lord lore lose loss lost lots loud lout
love lows lube luck luff lugs lull lump lung lure lurk lush lust lute lyes
lynx lyre mace made magi maid mail maim main make male mall malt mama mane
mans many maps mare mark marl mars mart mash mask mass mast mate math mats
maul maws maze mazy mead meal mean meat meed meek meet meld melt memo mend
menu mere mesa mesh mess mete mewl mews mica mice midi mien miff migs mike
mild mile milk mill mils milt mime mind mine mini mink mins mint minx mire
miry miss mist mite mitt moan moat mobs mock mode moil mold mole moll molt
moms monk mono mood moon moor moos moot mope mops more morn moss most mote
moth move mown mows much muck muff mugs mule mull mums murk muse mush musk
muss must mute mutt myna myth nabs nags nail name nape naps nard nary nave
navy nays neap near neat nebs neck need neon nest nets news newt next nibs
nice nick nigh nine nips nits node nods noel nolo none nons nook noon nope
norm nose nosy note noun nova nubs nude nuke null numb nuns nuts oafs oaks
oars oath oats obey oboe odds odes odor offs ogle ogre ohms oils oily oink
okay okra oleo olio omen omit once ones only onto onus onyx ooze oozy opal
open opts opus oral orbs ores orgy orts otic ouch ours oust outs ouzo oval
oven over ovum owed owes owls owns oxen pace pack pact pads page paid pail
pain pair pale pall palm pals pane pang pans pant papa pare park pars part
pass past pate path pats pave pawl pawn paws pays peak peal pear peas peat
peck peek peel peen peep peer pees pegs pelf pelt pend pens pent peon peps
perk perm pert peso pest pets pews pica pick pied pier pies pigs pike pile
pill pimp pine ping pink pins pint pipe pips pita pith pits pity pixy plan
plat play plea pled plod plop plot plow ploy plug plum plus pock pods poem
poet poke poky pole poll polo poly pomp pond pony pooh pool poop poor pope
pops pore pork port pose posh post posy pots pour pout pows pram pray prep
prey prig prim prix prod prof prom prop prow pubs puce puck puff pugs puke
pull pulp puma pump punk puns punt puny pupa pups pure purl purr push puss
puts putt pyre quad quay quid quip quit quiz race rack racy raft raga rage
rags raid rail rain raja rake ramp rams rang rank rant rape raps rapt rare
rash rasp rate rats rave rays raze razz read real ream reap rear redo reds
reed reef reek reel refs rein rely rend rent rest rets revs rhea ribs rice
rich rick ride rids rife riff rift rigs rile rill rime rims rind ring rink
riot ripe rips rise risk rite rive road roam roan roar robe robs rock rocs
rode rods roes roil role roll romp rood roof rook room root rope rose rosy
rote rots rout rove rows rube rubs ruby rude rued rues ruff rugs ruin rule
rump rums rune rung runs runt ruse rush rusk rust ruts ryes sack sacs safe
saga sage sago sags said sail sake sale salt same sand sane sang sank sans
saps sari sash sass sate save sawn saws says scab scam scan scar scat scow
scud scum seal seam sear seas seat sect seed seek seem seen seep seer sees
self sell semi send sent sera sere serf seta sets sewn sews sexy shad shag
shah sham shaw shay shed shim shin ship shiv shod shoe shoo shop shot show
shun shut sick side sift sigh sign silk sill silo silt sine sing sink sins
sips sire sirs site sits size skew skid skim skin skip skis skit slab slag
slam slap slat slaw slay sled slew slid slim slip slit slob sloe slog slop
slot slow slue slug slum slur slut smog smug smut snag snap snip snob snot
snow snub snug soak soap soar sobs sock soda sods sofa soft soil sold sole
solo sols some song sons soon soot sops sore sort sots soul soup sour sown
sows soya span spar spas spat spay spec sped spew spin spit spot spry spud
spun spur stab stag star stay stem step stet stew stir stop stow stub stud
stun subs such suck suds sued sues suet suey suit sulk sums sung sunk suns
sups sure surf swab swag swam swan swap swat sway swig swim swum sync tabs
tabu tack tact tads taft tags tail take talc tale talk tall tame tamp tams
tang tank tans tape taps tare tarn taro tarp tars tart task tats taut taxi
teak teal team tear teas teat tech teds teed teem teen tees tell temp tend
tens tent term tern test text than that thaw thee them then they thin this
thou thud thug thus tick tics tide tidy tied tier ties tiff tile till tilt
time tine tins tint tiny tips tire tits toad toed toes tofu toga togs toil
toke told toll tomb tome toms tone tong tonk tons took tool toot tope tops
tore torn tort toss tote tots tour tout town tows toys tram trap tray tree
trek trig trim trio trip trod trot troy true tsar tuba tube tubs tuck tufa
tuff tuft tugs tuna tune tung tuns turf turn tusk tutu twig twin twit twos
tyke type typo tyro ugly ulna umps undo unit unto upon urea urge uric urns
used user uses vade vain vale vamp vane vans vary vase vast vats veal veer
vees veil vein vela vend vent verb very vest veto vets vial vice vied vies
view vile vine viol visa vise vita viva vive vivo void vole volt vote vows
ward ware warm warn warp wars wart wary wash wasp watt wave wavy waxy ways
weak weal wean wear webs weds weed week weep weft weir weld well welt wend
went wept were wert west wets wham what when whet whew whey whim whip whir
whit whiz whoa whom whys wick wide wife wigs wild wile will wilt wily wind
wine wing wink wins winy wipe wire wiry wise wish wisp with wits wive woad
woes woke wold wolf womb wont wood woof wool woos word wore work worm worn
wove wows wrap wren writ yaks yams yang yank yaps yard yarn yawl yawn yawp
yaws yeah year yegg yell yelp yens yews yips yoga yogi yoke yolk yore your
yowl yule yurt zany zaps zeal zebu zero zest zeta zinc zing zips zone zoom}

set start amen
set end quay

DoDisplay
Random
return```