Re: Puzzle Challenge
- To: mathgroup at smc.vnet.net
- Subject: [mg63720] Re: Puzzle Challenge
- From: Jean-Marc Gulliet <jeanmarc.gulliet at gmail.com>
- Date: Wed, 11 Jan 2006 06:49:43 -0500 (EST)
- Organization: The Open University, Milton Keynes, UK
- References: <dojf6m$fqo$1@smc.vnet.net> <dq0395$rfp$1@smc.vnet.net>
- Sender: owner-wri-mathgroup at wolfram.com
Peter Pein wrote: > 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 > Hi Peter, According to the built-in default English dictionary shipped with Mathematica, 124 "words" of the list are not words :-) Moreover, some of them look very very French (epicier, trier, or tripe for instance)... In[1]:= words={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}; In[2]:= <<Miscellaneous`Dictionary` In[3]:= truefalse=DictionaryWordQ/@ToString/@words; In[4]:= Count[truefalse, False] Out[4]= 124 Best regards, /J.M.
