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.
| [reply] |
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. | [reply] |
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.
| [reply] |
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.
| [reply] |
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.
| [reply] |
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. | [reply] [d/l] |
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
| [reply] [d/l] |
This Link can be extremely helpful to you to build the interface.
| [reply] [d/l] |