"Bookworm" solver project

[japhy]

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.

[eibwen]

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.

[tilly]

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.

[japhy]

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.

[tilly]

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.

[Zaxo]

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.

[TedPride]

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.

[TedPride]

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

[artist]

This Link can be extremely helpful to you to build the interface.