Beefy Boxes and Bandwidth Generously Provided by pair Networks
laziness, impatience, and hubris
 
PerlMonks  

comment on

( [id://3333]=superdoc: print w/replies, xml ) Need Help??

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


In reply to Re^2: find all paths of length n in a graph (trie -- boggle solver) by demerphq
in thread find all paths of length n in a graph by davidj

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others wandering the Monastery: (4)
As of 2024-04-24 21:11 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found