MathGroup Archive 2006

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

Search the Archive

Re: Puzzle Challenge

  • To: mathgroup at smc.vnet.net
  • Subject: [mg63619] Re: Puzzle Challenge
  • From: Maxim <m.r at inbox.ru>
  • Date: Sat, 7 Jan 2006 03:13:52 -0500 (EST)
  • References: <dojf6m$fqo$1@smc.vnet.net>
  • Sender: owner-wri-mathgroup at wolfram.com

On Sat, 24 Dec 2005 12:33:26 +0000 (UTC), <gleam at flashmail.com> wrote:

>
> 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
>
>

Here's a brute force search approach; we simply create another dictionary  
of all possible prefixes and at each step perform a binary search in the  
two dictionaries:

dict = ReadList[$InstallationDirectory <>
     "/SystemFiles/Dictionaries/English/dictionary.txt",
    String] // ToLowerCase;

dict2 = Rest@ FoldList[StringJoin, "", #]& /@ Characters@ dict //
   Flatten // Union;

Module[{step, wordQ, Lltr, LLadj, ans = {}},
   Lltr = {"D", "L", "O", "C",
           "E", "P", "I", "E",
           "A", "R", "N", "R",
           "S", "T", "A", "U"} // ToLowerCase;
   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}};
   step[str_, pos_] :=
     If[wordQ[dict2, str],
       If[wordQ[dict, str],
         AppendTo[ans, str]
       ];
       step[str <> Lltr[[#]], #]& /@ LLadj[[pos]]
     ];
   wordQ[dict_, str_ ] := Module[{a, b, c},
       {a, b} = {1, Length@ dict};
       While[a <= b,
         c = Quotient[a + b, 2];
         Switch[Order[dict[[c]], str],
           0, Return[True],
           1, a = c + 1,
           -1, b = c - 1
       ]];
       False
   ];
   step[Lltr[[#]], #]& /@ Range@ Length@ Lltr;
   Select[Union@ ans, StringLength@ # >= 5&]
]

{"anent", "apart", "apiece", "ararat", "arena", "astana", "centaur",  
"centric", "cents", "coled", "coped", "copier", "copra", "dears",  
"depart", "departs", "earner", "earpiece", "easts", "elope", "eloped",  
"enrico", "entrap", "ernie", "icier", "inane", "inaner", "leaped",  
"learn", "learner", "least", "loped", "nauru", "nicene", "nicer",  
"nicole", "niece", "opine", "papas", "paras", "partner", "parts", "pasta",  
"pasts", "pears", "pepin", "piece", "pinata", "pinier", "pints", "piped",  
"pleas", "poled", "price", "pricier", "prier", "print", "prints", "rants",  
"raped", "rapier", "rapine", "rarer", "recent", "recipe", "recipient",  
"recipients", "rents", "reran", "ricer", "riped", "sapient", "sarnie",  
"stare", "starer", "stats", "strap", "strip", "stripe", "striped",  
"stripier", "tantra", "tatar", "trice", "trier", "trina", "tripe",  
"triple", "tripled"}

Maxim Rytin
m.r at inbox.ru


  • Prev by Date: Re: Re: Re: Taking either a sequence or a list
  • Next by Date: Re: A beginer's simple question about Mathematica...
  • Previous by thread: Re: Puzzle Challenge
  • Next by thread: Re: Puzzle Challenge