Re: Depth First Search and Boggle

It's really simple to write a quick algorithm. I whipped up the program below in about 15 minutes. It's doing the preprocessing of the dictionary for valid prefixes each time - it would be better if you do the preprocessing for prefixes (and valid words) once, using a tied hash and a dbmfile.

Anyway, here's the code:

#!/usr/bin/perl
    
use strict;
use warnings 'all';
        
my $dict = "/usr/share/dict/words";
        
my %prefix;
my %valid;
my %found;
my $board;
     
sub preprocess;
sub init_board;
sub find_words;

preprocess $dict;
init_board;
 
foreach my $x (0 .. @$board - 1) {
    foreach my $y (0 .. @{$board -> [$x]}) {
        find_words $x, $y, "", [];
    }
}
    
                  
                 
sub preprocess {
    my $file = shift;
    open my $fh => $file or die "Failed to open $file: $!\n";
    local $_;
  LINE:
    while (<$fh>) {
        chomp;
        $_ = lc;
        next if /[^a-z]/;
        $valid {$_} = 1;
        while (length) {
            next LINE if $prefix {$_} ++;
            chop;
        }  
    }
}

     
sub init_board {
    local $_;  
    push @$board => [lc =~ /[a-z]/g] while <DATA>;
}


sub find_words {
    my ($x, $y, $word, $seen) = @_;
    
    return unless $x >= 0 && $y >= 0 &&
                  exists $board -> [$x] && exists $board -> [$x] [$y] 
+&&
                 !$seen -> [$x] [$y];
    
    $word .= $board -> [$x] [$y];
                 
    return unless $prefix {$word};
    
    print "$word\n" if $valid {$word} && !$found {$word} ++; 
    
    $seen -> [$x] [$y] = 1;
        
    foreach my $dx (-1 .. 1) {
        foreach my $dy (-1 .. 1) {
            find_words $x + $dx, $y + $dy, $word, $seen if $dx || $dy;
        }
    }
}
           
     
__DATA__
a b c d e
f g h i j
k l m n o
p q r s t
u v w x y
[download]

Running this gives:

bag
chide
fag
gab
hi
hid
hide
him
hint
in
mid
no
to
ton
tons
up

It finds the words in just over a second and a half. And a small test shows it will work on non rectangular boards as well. And it's real easy to make it work on a torus.

Abigail

Comment on Re: Depth First Search and Boggle Download Code

Replies are listed 'Best First'.
Re: Re: Depth First Search and Boggle by Sifmole (Chaplain) on Aug 15, 2002 at 17:07 UTC
It would be even better if there was a way to make it do plurals.	[reply]
Re: Depth First Search and Boggle by Abigail-II (Bishop) on Aug 15, 2002 at 17:23 UTC
Either use a dictionary that already has plurals in it, or use the following preprocess function: `use Lingua::EN::Inflect qw /PL/; sub preprocess { my $file = shift; open my $fh => $file or die "Failed to open $file: $!\n"; local $_; LINE: while (<$fh>) { chomp; $_ = lc; next if /[^a-z]/; WORD: foreach ($_, PL ($_)) { $valid {$_} = 1; while (length) { next WORD if $prefix {$_} ++; chop; } } } }` [download] Abigail	[reply] [d/l]
Re^2: Depth First Search and Boggle by kelan (Deacon) on Sep 26, 2004 at 19:51 UTC
Note to anyone testing this algorithm out, it works well except for a small bug. Because the `$seen` matrix is being passed into sub-calls by reference, any changes to it will still be there when the recursive `find_words` call returns. That messes up further calls to `find_words` because the seen-matrix is lying, in a sense. To fix it, just add this line as the last line of the `find_words` sub (outside of the two for-loops), so that the seen-matrix is properly reset for a given call's ancestors: `$seen->[ $x ][ $y ] = 0;` [download]	[reply] [d/l]