[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 .answer -in .puzzle -side bottom -pady {10 0} 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 ::ttk::button .about -text About -command About pack .go .rand -in .buttons -side top -padx 10 -pady 5 pack .about -side bottom -in .buttons grid .title - -pady 10 -padx 10 -ipadx 10 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(head) 0 ;# Head: 1 ahead of first item set ::Q(tail) 0 ;# Tail: last unviewed item } proc QPush {token} { set ::Q($::Q(head)) $token incr ::Q(head) } 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 ::W(answer) "Solving..." set answer [Chain $::W(start) $::W(end) Progress] if {$answer eq ""} {set answer impossible} set ::W(answer) $answer 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)}]] set ::W(answer) "" } 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 } proc About {} { set msg "Word Chain\nBy Keith Vetter, Oct 2006" tk_messageBox -title "About" -message $msg } ################################################################ set WORDS(3) { ace act add ade ado ads adz aft age ago aha aid ail aim air alb ale all alp 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 labs lace lack lacy lade lads lady lags laid lain lair lake laky lama lamb 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 wade wadi wads waft wage wags waif wail wait wake walk wall wand wane want 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 ====== ---- [http://img25.imageshack.us/img25/2392/tclwikiwordchainpngth7.png] <> Games | Tcl/Tk Games | Application