Re: Puzzle Challenge
- To: mathgroup at smc.vnet.net
- Subject: [mg63707] Re: Puzzle Challenge
- From: Peter Pein <petsie at dordos.net>
- Date: Tue, 10 Jan 2006 04:50:34 -0500 (EST)
- References: <dojf6m$fqo$1@smc.vnet.net>
- Sender: owner-wri-mathgroup at wolfram.com
gleam at flashmail.com schrieb: > A Merry Christmas to all! > > > I offer the following word puzzle as a friendly challenge to list participants. > > Please consider the game board: > > http://www.mathematica-users.org/mediawiki/images/0/03/hexagonpuzzle.gif > __ > __/C \__ > __/O \__/E \__ > __/L \__/I \__/R \__ > /D \__/P \__/N \__/U \ > \__/E \__/R \__/A \__/ > \__/A \__/T \__/ > \__/S \__/ > \__/ > > The goal is to find as many words as possible of length five or > greater that each can be spelled by starting on a hexagonal token and > hopping from one token to the next. > > You may use a token multiple times while spelling a word, but not > twice in a row. For example, you may spell APART but not COOLED. > > Your program should work on a puzzle with arbitrarily chosen letters. > > Your solution will not be judged, but please put effort into your > algorithm, and tell us what makes it excel. For example, was your > goal to write the most concise function? The most > elegant? Fastest? Unusual? A a robust function that will solve a > larger set of puzzles? > > You will need word lists (dictionary files) and I recommend ENABLE2k > or the even larger YAWL, both available from: > > http://personal.riverusers.com/~thegrendel/software.html > > I hope you will really enjoy working this puzzle, as well as seeing > each other's results! > > Paul > > My last posting based on an error. Some letters appear more than once on the board. But the concept can be used to reduce the size of the dictionary significantly. So the search can use a very compact book. board = Partition[ ToString /@ {d, l, o, c, e, p, i, e, a, r, n, r, s, t, a, u}, 4]; adj = Table[Select[ {{i - 1, j}, {i - 1, j + 1}, {i, j - 1}, {i, j + 1}, {i + 1, j - 1}, {i + 1, j}}, FreeQ[#, 0 | 5] &], {i, 4}, {j, 4}]; allPairs = Flatten[Table[ {board[[i, j]], #} & /@ Extract[board, adj[[i, j]]], {i, 4}, {j, 4}], 2] // Union; search[{x_, y_}, depth_, word_, candidates_] := Module[{w2, c2, r}, If[candidates == {}, {}, w2 = word <> board[[x, y]]; c2 = Select[candidates, StringMatchQ[#, w2 ~~ ___] &]; r = search[#, depth + 1, w2, c2] & /@ adj[[x, y]]; If[depth â?¥ 5 && MemberQ[candidates, word], r = {word, r}]; Flatten[r] ]] Length[wordList = ReadList["word.list", String]] (* YAWL *) --> 264061 {t1, l} = Timing@Length[smallWL = Pick[wordList, Complement[#, Intersection[#, allPairs]] == {} &[ Partition[Characters[#], 2, 1]] & /@ wordList]] --> {8.547 Second, 994} {t2, solution} = Timing[Flatten[ Table[search[{i, j}, 0, "", smallWL], {i, 4}, {j, 4}]] // Union]; t1 + t2 Length[solution] --> 9.703 Second --> 207 compared to {t3, slow} = Timing[Flatten[Table[search[{i, j}, 0, "", wordList], {i, 4}, {j, 4}]] // Union]; t3 Length[slow] --> 21.438 Second --> 207 slow == solution --> True solution -->{anana,anent,antar,antara,antra,apart,apiece,apiol,apocope,apocopic,arars, areic,arena,arere,astare,atrip,aurar,aurei,centare,centaur,centner,centra, centric,centriole,cents,cerne,cocinera,coiner,coirs,coled,copartner,coped, copier,copra,copras,dearie,dearn,dears,deled,delope,deloped,depart,departs, earner,earpiece,earst,easts,eloin,eloiner,elope,eloped,entrap,epicene,epicier, epiploic,icier,inane,inaner,intra,leaped,learier,learn,learner,learnt,lears, least,leasts,lepra,lepras,loipe,loirs,loped,natant,nicer,nicol,niece,nipas, oints,olpae,opepe,opine,papas,parae,paras,parped,parpoint,parpoints,partan, partner,parts,pasta,pasts,pears,pearst,peart,picene,picine,piece,piecen, piecener,piecer,pinata,pinene,pinier,pinta,pints,pipas,piped,pipier,pirnie, pleaed,pleas,point,points,poled,poprin,price,pricer,pricier,prier,print, prints,ranine,rants,raped,rapier,rapine,rapini,rarer,rasta,ratan,ratatat, ratatats,recent,recipe,recipient,recipients,recoin,renin,rents,reran,rerent, rerents,ricer,ricier,ricin,riped,ripieni,riprap,ruana,sapele,sapient,sarape, sarin,sarnie,sarsa,sarsar,sarsars,sarsas,sasarara,sasararas,sastra,sastras, stane,stanine,stare,starer,starn,starnie,statant,stats,strae,strap,strine, strip,stripe,striped,stripier,tanrec,tantara,tantarara,tantra,tantras,tantric, tarantara,taratantara,tatar,trape,traped,trice,triene,trier,trine,triol, tripart,tripe,tripier,triple,tripled,tsarina,tsars,uranic,uranin,urare,ureic, urena,urent} This list contains some (many?) words, which seem strange to me - but english isn't my mother tongue... (I like especially "tantarara" and "sasararas" :-)) ) Peter
