Services & ResourcesWolfram ForumsMathGroup Archive

[Date Index] [Thread Index] [Author Index]

Re: Puzzle Challenge

• To: mathgroup at smc.vnet.net
• Subject: [mg63681] Re: Puzzle Challenge
• From: Peter Pein <petsie at dordos.net>
• Date: Tue, 10 Jan 2006 01:48:37 -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.
...

Well, this is my first try and not elaborated at all (actually, I've stolen 
Maxim's lists). The idea is that every pair of adjacent characters in the word 
to test must be in the set of all possible pairs, which can be built on the 
gameboard:

AbsoluteTiming[Short[
     Module[{wordList=Select[ReadList["word.list",String],StringLength[#]>=5&],
         Lltr=ToLowerCase[{"D","L","O","C","E","P","I","E","A","R","N","R","S",
               "T","A","U"}],
         LLadj={{2,5},{1,3,5,6},{2,4,6,8},{3,7,8},{1,2,6,9},{2,3,5,7,9,10},{3,
               4,6,8,10,11},{4,7,11,12},{5,6,10,13},{6,7,9,11,13,14},{7,8,10,
               12,14,15},{8,11,15,16},{9,10,14},{10,11,13,15},{11,12,14,
               16},{12,15}},
         wl2,allPairs,sol},
   Print["Number of words with 5 or more characters: ",Length[wordList]];
allPairs=Union[Flatten[Thread[{##}]&@@@Transpose[{Lltr,(Lltr[[#]]&)/@LLadj}],{1}]];
wl2=(Partition[Characters[#],2,1]&)/@wordList;
sol=Pick[wordList,(Complement[#,Intersection[#,allPairs]]=={}&)/@wl2];
Print["Solutions: ",Length[sol]];sol]
]]
 From In[1]:=
"Number of words with 5 or more characters: "257435
 From In[1]:=
"Solutions: "668
Out[1]=
{10.1406250Second,
{aerie,aeried,aerier,anana,ananas,<<658>>,urine,urined,urned,urped,ursae}}

The YAWL has been used.

Peter