Beefy Boxes and Bandwidth Generously Provided by pair Networks
We don't bite newbies here... much
 
PerlMonks  

Re^2: find all paths of length n in a graph (trie -- boggle solver)

by demerphq (Chancellor)
on Jan 10, 2006 at 22:56 UTC ( [id://522344]=note: print w/replies, xml ) Need Help??


in reply to Re: find all paths of length n in a graph (Boggle solver)
in thread find all paths of length n in a graph

Here is an implementation of the description you gave in the CB of how you would do it. Actually, youd probably do it neater than this somehow or another, but whatever. :-)

Update: Made it start at N and go clockwise instead of at NW. Also, made it run from command line line args. Example usage (and defaults) are below. (added later) cleanup and additional documentation. (and even later) Heh, "Perl-Monk-sHac-kers" can be used to spell "acne", and "sane". :-)

boggle.pl GAUT-PRMR-DOLA-ESIC D:/dict/enable1.txt
# boggle.pl use strict; use warnings; use Storable; use Text::Wrap qw(wrap); # Boggle board board is representated as a flat array # with guard squares surrounding the valid squares on # all sides. Thus the virtual board size is +2 over the # "real" board size. my $RealSize= 4; my $BoardSize= $RealSize + 2; my @board= (" ") x ( $BoardSize ** 2 ); # what do we add to "move" from one square to the next. my @delta= ( -6, -5, 1, 7, 6, 5, -1, -7 ); # N, NE, E, ..., W, NW my %loc_mask; # map valid locations on the board to specifc bits # we use this to prevent visiting a location twice. my @inorder; # valid locations on the board in order of 1,1 to 4,4 my $trie= {}; # trie of words in dictionary # Digit => HoH of possible successor words. # '' => 1 indicates path to this node is a valid word # $trie->{words} holds the count. sub setup { my $file= shift; # first set up the information about the board my $bit= 0; for my $y ( 1 .. $RealSize ) { for my $x ( 1 .. $RealSize ) { my $loc= $x + ( $y * $BoardSize ); $loc_mask{$loc}= 2 ** ($bit++); push @inorder, $loc; } } # Now read the dictionary. If we have already built a trie # of the dictionary it might be available as a Storable image if ( -e "$file.stor" && -M "$file.stor" < -M $file ) { print "Reading stored dictionary... "; $trie = retrieve("$file.stor"); print "$trie->{words} words read\n"; } else { # No up to date storable of the dictionary available. print "Reading dictionary... "; open my $in,"<",$file or die "Can't read '$file':$!"; while (<$in>) { chomp; next if length $_ > 16; my $n=$trie; # add the word to the trie... $n= ( $n->{$_} ||= {} ) for split //, uc $_; # mark the last node visited as an accepting state $n->{''}=!!1; } $trie->{words}= $.; print "$trie->{words} words read\n"; print "Storing..."; store $trie, "$file.stor"; print "Done\n"; } } # recurse through the possible paths on the board # using the trie to determine which paths are legal. sub recurse_find { my ( $loc, $words, $node, $bits, $word )= @_; if ( $node->{''} ) { push @$words,$word; } foreach my $d (@delta) { my $new= $loc+$d; my $char= $board[$new]; if ( $node->{$char} and !($bits & $loc_mask{$new}) ) { recurse_find( $new, $words, $node->{$char}, $bits + $loc_mask{$new}, $word . $char ); } } } sub printboard { local $_= join "",@board; s/^\s+/ /; s/\s+$/ /; s/ /\n /g; print $_,"\n------\n"; } # loop through all the possible starting positions # to see what words we find sub find_words_in_board { @board[@inorder]= split //,uc(shift @_); my @words; printboard(); foreach my $loc ( @inorder ) { my $c=$board[$loc]; next if ! $trie->{$c}; recurse_find( $loc, \@words, $trie->{$c}, $loc_mask{$loc}, $c ); } my %unique; $unique{$_}++ for @words; print "Got ",0+@words," possible words (", 0+keys(%unique)," unique)\n"; print wrap("","",join ", ", map { $unique{$_}>1 ? "$_($unique{$_})" : $_ } sort keys %unique),"\n"; } $|++; my $board= uc(shift @ARGV) || 'GAUTPRMRDOLAESIC'; my $file= shift(@ARGV) || "D:/dict/enable1.txt"; $board=~s/[^A-Z]//g; die "Bad board! '$board'" if length($board)!=16; die "Dictionary '$file' doesn't exist!" unless -e $file; setup($file); find_words_in_board($board); __END__ Reading stored dictionary... 172823 words read GAUT PRMR DOLA ESIC ------ Got 249 possible words (229 unique) AG, AI, AIL, AILS, AIS, AL, ALMA, ALOE, ALOES, ALS, ALSO, AM(2), AMA(2 +), AMTRAC, AMU(2), APOD, APODS, AR(2), ARM(2), ARMOR, AROMA, AROSE, ART, ARUM(2), AURA, AURAL, CALM, CALO, CAM, CAR, CARL, CARLS, CART, CIS, CL +AM, CLAMOR, CLOD, CLODS, CLOP, CLOSE, CLOSED, DE, DO, DOE, DOES, DOL, DOLC +I, DOLMA(2), DOLS, DOM, DOMAL, DOPA, DOR, DORM, DORP, DOS, DOSE, DRAG, DR +AM, DRAMA, DROP, DRUM, ED, ES, GAM, GAMA, GAMUT, GAP, GAR, GARLIC, GAUM, GAUR(2), GRAM, GRAMA, GRUM, GRUMOSE, IS, LA, LAC, LAIC, LAM, LAMA, LAR +, LARUM, LI, LIAR, LIS, LO, LODE, LODES, LOP, LORD, LORDS, LOSE, MA(2), +MAC, MAG, MAIL, MAILS, MALIC, MAP, MAR(2), MARL(2), MARLS(2), MART, MAUT, M +O, MOD, MODE, MODES, MODS, MOIL, MOILS, MOL, MOLA, MOLAR, MOLS, MOP, MOR, MORA, MOS, MU, MURA(2), MURAL, MURALS, MUT, OD, ODE, ODES, ODS, OE, OE +S, OIL, OILS, OM, OP, OR, ORA, OS, OSE, PA, PAM, PAR, PARD, PARDS, PAROL, PAROLS, PARURA, POD, PODS, POI, POIS, POISE, POISED, POL, POLAR, POLIS +, POLS, POM, POSE, POSED, PRAM, PRAU, PRO, PROD, PRODS, PROM, PROS, PROS +E, PROSED, RAG, RAIL, RAILS, RAISE, RAISED, RAM(2), RAMOSE(2), RAMROD, RAMRODS, RAP, ROD, RODE, RODS, ROE, ROES, ROIL, ROILS, ROM, ROSE, ROSE +D, RUM(2), RUMOR, RURAL, RURALISE, RURALISED, RUT(2), SI, SIAL, SIC, SILO +, SILOED, SLAM, SLOE, SLOP, SO, SOD, SOIL, SOL, SOLA, SOLAR, SOLI, SOMA( +2), SOP, SORA, SORD, TRAIL, TRAILS, TRAM, TUMOR, TURD, TURDS, TURMOIL(2), TURMOILS(2), UM, URACIL, URACILS, URD, URDS, UT
---
$world=~s/war/peace/g

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://522344]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others contemplating the Monastery: (6)
As of 2024-03-28 11:00 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found