Beefy Boxes and Bandwidth Generously Provided by pair Networks
Do you know where your variables are?
 
PerlMonks  

"Bookworm" solver project

by japhy (Canon)
on May 08, 2005 at 19:50 UTC ( #455038=perlquestion: print w/ replies, xml ) Need Help??
japhy has asked for the wisdom of the Perl Monks concerning the following question:

I'm playing the game "Bookworm" found at Yahoo! Games, and I've decided I'd like to make a Perl application that, given the letter grid in the game, produces all the words that can be made, using a dictionary file for reference.

The letter grid looks like this:

A J S B K F O X G B K T C L G P Y H C L U D M H Q Z I D M V E N I R A J E N W F O
(Update: correction made to available nodes here.) From the "U" you can move to the "P", "T", "Y", "Z", "V", or "Q". You can't use the same letter twice in one word. I'd like to know what modules monks would suggest I use. There are many graphing related modules, and I'm not sure where to start. I could make my own implementation, but it'd probably be faster to use an existing one.

Jeff japhy Pinyan, P.L., P.M., P.O.D, X.S.: Perl, regex, and perl hacker
How can we ever be the sold short or the cheated, we who for every service have long ago been overpaid? ~~ Meister Eckhart

Comment on "Bookworm" solver project
Download Code
Re: "Bookworm" solver project
by tilly (Archbishop) on May 08, 2005 at 20:06 UTC
    Why use a graphing module?

    I would spit out HTML that gives the grid, and then a list of words. Each word is wrapped in a JavaScript link that calls a function which clears existing markings, then proceeds to color the letters in such a way that it is obvious what order the letters make that word.

    One way to do that would be to have multiple arrows which can be set as a background, and set all of the classes of the table cells appropriately to make the right background images show in the right places.

      I meant a graphing module that I would use to store the structure of the board, as opposed to writing a Graph and Node class myself.

      Jeff japhy Pinyan, P.L., P.M., P.O.D, X.S.: Perl, regex, and perl hacker
      How can we ever be the sold short or the cheated, we who for every service have long ago been overpaid? ~~ Meister Eckhart
        Oh, that. You're overdesigning, IMO. Just use a 2-dimensional array for the characters, and have a corresponding 2-dimensional array of functions that know what the neighbours of any cell are. See Re (tilly) 1: 5x5 Puzzle for an example of the approach that I'm talking about.
Re: "Bookworm" solver project
by eibwen (Friar) on May 08, 2005 at 20:15 UTC

    This appears to be Boggle as played on an "oddly" dimensioned hexagonal grid. You may be interested in looking at the source for Games::Maze, which supports hexagonal matricies (albeit for an entirely different purpose).

    Both Games::Boggle and Games::Trackword will solve Boggle boards, but do not appear to support non-square board configurations. However given the above source for supporting hexagonal matricies, it should be possible to create a hexagonal board solver by extending either of these modules.

Re: "Bookworm" solver project
by Zaxo (Archbishop) on May 08, 2005 at 20:23 UTC

    The Graph module could handle the layout structure just fine. The existence of duplicate letters means that you'll need to encode a distinguishing suffix to the node names, or else store the letter as a property of the node.

    It will probably be as important to cook up a data structure for the dictionary which allows sequential lookup by characters. A deep hoh could do that.

    After Compline,
    Zaxo

Re: "Bookworm" solver project
by TedPride (Priest) on May 09, 2005 at 05:11 UTC
    Some sloppy code, which can no doubt be optimized by an order of magnitude or so:
    use strict; my (@data, %words, $my, $mx, $x, $y); for (<DATA>) { chomp; split //; s/ // for @_; push @data, [@_]; } $my = $#data; $mx = $#{$data[0]}; for $y (0..$my) { for $x (0..$mx) { if ($data[$y][$x]) { traverse('', 8, $x, $y, @data); } } } print scalar keys %words; sub traverse { my ($w, $d, $x, $y) = @_[0..3]; my @d = map {[@$_]} @_[4..$#_]; $w .= $d[$y][$x]; $words{$w} = () if !exists $words{$w}; return if !--$d; $d[$y][$x] = ''; if ($y > 0 && $x > 0 && $d[($y-1)][($x-1)]) { traverse($w, $d, ($x +-1), ($y-1), @d); } if ($y < $my && $x > 0 && $d[($y+1)][($x-1)]) { traverse($w, $d, ( +$x-1), ($y+1), @d); } if ($y > 0 && $x < $mx && $d[($y-1)][($x+1)]) { traverse($w, $d, ( +$x+1), ($y-1), @d); } if ($y < $my && $x < $mx && $d[($y+1)][($x+1)]) { traverse($w, $d, + ($x+1), ($y+1), @d); } } __DATA__ A J S B K F O X G B K T C L G P Y H C L U D M H Q Z I D M V E N I R A J E N W F O
    I get 36382 possibles at a max depth of 8 characters. Each of these would need to be matched against the dictionary list, which I don't happen to have handy at the moment.
Re: "Bookworm" solver project
by TedPride (Priest) on Feb 04, 2008 at 02:45 UTC
    By request from robinsj, here's a much neater version. Given, it can be optimized to run a lot faster, for instance by working out partials and killing off paths that don't lead to a word, or by looking ahead to see if there's a letter (saves you one level of function depth), but this should still run in around 2 minutes for the max depth of 10.
    use strict; my $depth = 10; ### Max word length, longer takes more time my (%words, @board, %results, $width, $height); my ($handle, $p, $x, $y); ### Load words from file, one word per line open ($handle, 'dictionary.txt'); while (<$handle>) { chomp; $words{$_} = 1; } close ($handle); ### Load board data while (<DATA>) { chomp; push @board, [split //, $_]; ### Maximum board width $width = $#{$board[-1]} if $#{$board[-1]} > $width; } ### Board height $height = $#board; ### Traverse from each possible starting point for $x (0..$width) { for $y (0..$height) { traverse($x, $y, ''); } } ### Display longest 10 results my $c = 10; for (sort { length($b) <=> length($a) || $a cmp $b } keys %results) { print "$_\n"; exit if !--$c; } sub traverse { my ($x, $y, $word) = @_; ### Letter used up or out of bounds return if !$board[$y][$x] || $board[$y][$x] eq ' '; $word .= $board[$y][$x]; $results{$word} = () if $words{$word}; if (length($word) < $depth) { $board[$y][$x] = undef; if ($x > 0 && $y > 0) { traverse($x-1, $y-1, $word); } if ($x < $width && $y > 0) { traverse($x+1, $y-1, $word); } if ($x < $width - 1) { traverse($x+2, $y, $word); } if ($x < $width && $y < $height) { traverse($x+1, $y+1, $word); } if ($x > 0 && $y < $height) { traverse($x-1, $y+1, $word); } if ($x > 1) { traverse($x-2, $y, $word); } $board[$y][$x] = substr($word, -1, 1); } } __DATA__ A J S B K B O X G B K T C L A P Y H C T U D M H O R I D M I E N I R A J E N W F O
Re: "Bookworm" solver project
by artist (Parson) on Feb 04, 2008 at 16:14 UTC
    This Link can be extremely helpful to you to build the interface.

    --Artist

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://455038]
Approved by thor
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others about the Monastery: (8)
As of 2014-08-20 15:25 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The best computer themed movie is:











    Results (116 votes), past polls