Beefy Boxes and Bandwidth Generously Provided by pair Networks
Think about Loose Coupling
 
PerlMonks  

find all paths of length n in a graph

by davidj (Priest)
on Jan 10, 2006 at 17:43 UTC ( #522257=perlquestion: print w/ replies, xml ) Need Help??
davidj has asked for the wisdom of the Perl Monks concerning the following question:

My fellow monks,
I know this smells like homework, but I assure you, it is not.

First, as to what prompts my question: My 7 year old daughter has been turned on to the old Parker Brothers game 'Boggle'. She absolutely LOVES it. For those of you who don't know the game, its quite simple: 16 cubes with letters on each side are arranged into a 4x4 grid of letters from which you need to find words. You have 3 minutes to find as many 3 to 6 letter words of as you can. The rules are simple: 1) the words are created from sequences of adjacent letters (including diagonal), 2) the same position cannot be used more than once in the same word.

So, being the wonderful father that I try to be, I thought 'hmm, I'll program it so she can play it on the computer.' Generating the 16 letters from the actual cube values and arranging them into a 4x4 grid was trivially easy. It took like 5 minutes.

Now, for the vocabulary-building value of the game, I thought it would be cool to list all the words that actually exist. That is where I am stuck. In order to do this I need to generate all paths of lengths 3 to 6 starting with each cube position. I have the grid represented as an adjacency list and I know how to use depth first search to find paths from one node to another, but I am struggling to find a way to use DFS to generate all valid paths of length n, regardless of what the final node is. I would show you what I have but it is less than useful. It doesn't even come close to working.

The numbered grid looks like this:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16
The list looks like this:
my %adjacency_list = ( 1 => [2,5,6], 2 => [1,3,5,6,7], 3 => [2,4,6,7,8], 4 => [3,7,8], 5 => [1,2,6,9,10], 6 => [1,2,3,5,7,9,10,11], 7 => [2,3,4,6,8,10,11,12], 8 => [3,4,7,11,12], 9 => [5,6,10,13,14], 10 => [5,6,7,9,11,13,14,15], 11 => [6,7,8,10,12,14,15,16], 12 => [7,8,11,15,16], 13 => [9,10,14], 14 => [9,10,11,13,15], 15 => [10,11,12,14,16], 16 => [11,12,15] );
what I need is the list of paths of length 3 to 6
1,2,3 1,2,5 1,2,6 1,2,7 1,5,2 1,5,6 ... 16,15,14,13,10,11


After I have the list of paths generated it will be trivial to substitute the appropriate letters and check the possiblities against a a database of age appropriate words.

As always any assistance you can provide will be greatly appreciated by me and my daughter.

davidj

Comment on find all paths of length n in a graph
Select or Download Code
Re: find all paths of length n in a graph
by jZed (Prior) on Jan 10, 2006 at 17:55 UTC
Re: find all paths of length n in a graph
by ambrus (Abbot) on Jan 10, 2006 at 18:07 UTC

    There's a boggle game in the bsd-games package which is pre-installed on many linux systems or can be installed with the packaging system. You may want to look at or even use its C source.

    Update: boggle even has a batch mode when you don't play the game, only get the words in a table you specify.

    boggle -b 'atrieynnilsoelxw' </usr/share/games/bsd-games/boggle/dictio +nary
Re: find all paths of length n in a graph
by ptum (Priest) on Jan 10, 2006 at 18:15 UTC

    Not to take away your fun on what looks like an interesting programming problem, you might also look at Bookworm by PopCap software. I've enjoyed it immensely -- good value for $20.

    Update: And of course, there is always Big Boggle, which uses a 5 x 5 grid -- makes the problem a little more interesting.


    No good deed goes unpunished. -- (attributed to) Oscar Wilde

      Big Boggle? I thought it was called Boggle Master.

      Update: wow, so there's even a Boggle Deluxe too.

      Btw, I have a Boggle Master but we don't play it much as it doesn't work very well in Hungarian.

        Hmmm. Maybe I show my age. :) That's what it was called back when I was a kid ... Big Boggle

Re: find all paths of length n in a graph
by tbone1 (Monsignor) on Jan 10, 2006 at 18:17 UTC
    A couple things:

    1) There is no limit on word length. Well, okay, there is; they can only be up to sixteen characters because you can't re-use a letter.
    2) Using a LOL (list of lists), 4x4, is probably a better way to go. That eliminates the need to carry around %adjacency_list, for one thing.
    Hope this helps.

    --
    tbone1, YAPS (Yet Another Perl Schlub)
    And remember, if he succeeds, so what.
    - Chick McGee

Re: find all paths of length n in a graph
by japhy (Canon) on Jan 10, 2006 at 18:23 UTC
    While Graph can certainly do this for you, understanding the graph theory involved is a good idea. Basically, here's what you do:
    • For each available vertex:
      • Select it ($seen{$vertex} = 1)
      • Push the vertex to the current path (push @path, $vertex)
      • If the number of vertices in the path equals the desired length (@path == $len)
        • Store the path in the master list (push @all_paths, [@path])
      • Else:
        • Set "available vertices" to all unseen adjacent vertices (grep { !$seen{$_} } @{ $adjacent{$vertex} })
        • Repeat from top
      • Remove the latest vertex added to the path (pop @path)
      • Un-select the vertex ($seen{$vertex} = 0)
    This is a relatively simple recursive process. The code is basically something like:
    my $paths_ref = get_paths(\%adjaceny_matrix, $length); sub get_paths { my ($adj, $len) = @_; my @paths; _get_paths_helper(\@paths, $adj, $len, [], {}, [keys %$adj]); return \@paths; } sub _get_paths_helper { my ($p, $am, $len, $curr, $seen, $avail) = @_; for my $v (@$avail) { push @$curr, $v; local $seen->{$v} = 1; if (@$curr == $len) { push @$p, [@$curr] } else { _get_paths_helper($p, $am, $len, $curr, $seen, [grep { !$seen->{ +$_} } @{ $am->{$v} }]); } pop @$curr; } }
    This can be modified to allow you to search for multiple depths without having to call the main function multiple times (which would be terribly inefficient!).

    Jeff japhy Pinyan, P.L., P.M., P.O.D, X.S.: Perl, regex, and perl hacker
    How can we ever be the sold short or the cheated, we who for every service have long ago been overpaid? ~~ Meister Eckhart
      Algorithm::Loops' NestedLoops allows a non-recursive implementation:
      use Algorithm::Loops 'NestedLoops'; sub find_path { my ($adj_list, $length) = @_; my %been_there; NestedLoops([ [sort {$a <=> $b} keys %$adj_list], (sub { # The last value on @_ has just changed, so remove it from %be +en_there # and set the new one my ($last_position, $last_value) = ($#_, $_[-1]); delete $been_there{$_} for grep $been_there{$_} >= $last_posit +ion, keys %been_there; $been_there{$last_value} = $last_position; # Here I grep out the already-visited nodes, but you could als +o exclude # any letters that don't result in prefixes of real words. [ grep !defined($been_there{$_}), @{$adj_list->{$last_value}} +] }) x ($length-1)] ); } my $i = find_path(\%adjacency_list, 3); my @path; print "@path\n" while @path = $i->();

      Caution: Contents may have been coded under pressure.
Re: find all paths of length n in a graph
by Roy Johnson (Monsignor) on Jan 10, 2006 at 18:27 UTC
    Here's some code for finding paths of a given length starting from a given spot. You just need to run through all the starting spots and find the paths of the desired lengths. There will be a lot of them.
    my %adjacency_list = ( 1 => [2,5,6], 2 => [1,3,5,6,7], 3 => [2,4,6,7,8], 4 => [3,7,8], 5 => [1,2,6,9,10], 6 => [1,2,3,5,7,9,10,11], 7 => [2,3,4,6,8,10,11,12], 8 => [3,4,7,11,12], 9 => [5,6,10,13,14], 10 => [5,6,7,9,11,13,14,15], 11 => [6,7,8,10,12,14,15,16], 12 => [7,8,11,15,16], 13 => [9,10,14], 14 => [9,10,11,13,15], 15 => [10,11,12,14,16], 16 => [11,12,15] ); sub find_path { my ($start_at, $length, $been_there) = (@_, {}); if ($length <= 1) { return [$start_at]; } else { my @try_these = grep { ! $been_there->{$_} } @{$adjacency_list{$st +art_at}}; return map { my @cdr_list = find_path($_, $length-1, {%$been_there, $start_at + => 1}); map [$start_at, @$_], @cdr_list; } @try_these; } } # Example usage: print "@$_\n" for (find_path(3, 3));

    Caution: Contents may have been coded under pressure.
      What if we need to find all paths from a node to another specific node? How would we modify the above recursive script?
        You'd pass in your destination node instead of desired length, and your first test would be whether you're starting at your destination. So:
        sub find_path { my ($start_at, $end_at, $been_there) = (@_, {}); if ($start_at == $end_at) { return [$start_at]; } else { my @try_these = grep { ! $been_there->{$_} } @{$adjacency_list{$st +art_at}}; return map { my @cdr_list = find_path($_, $end_at, {%$been_there, $start_at = +> 1}); map [$start_at, @$_], @cdr_list; } @try_these; } }
        Homework?

        Caution: Contents may have been coded under pressure.
Re: find all paths of length n in a graph
by blokhead (Monsignor) on Jan 10, 2006 at 18:29 UTC
    Adjacency matrices are really nice for this problem since they make "paths of length N" problems easy to reason about. Probably just wandering through the graph and keeping track of paths will give simpler code, but I guess I prefer using heavy machinery when it has nice abstraction properties... I also happen to really how you can use the structure of the matrix multiplication algorithm to do a lot of cute graph theory algorithms.

    The idea is that if you have the 0/1 adjacency matrix of a graph, and you take that matrix to the Nth power, then the (i,j) entry of the result tells how many paths of length N there are from vertex i to vertex j (here the length is measured in number of edges traversed) .

    The only trick is instead of just counting the paths, to keep track of all the actual paths themselves. For this you have to slightly modify the matrix multiplication algorithm...

    We modify the adjacency matrix so instead of being 0/1, the (i,j) entry of the matrix is a list of paths from i to j. Then in the matrix multiplication algorithm, instead of multiplying and adding entries, we instead concatenate pairs of paths together and union all of them (respectively). Here's what the code looks like:

    use strict; ## just any old directed graph... my $adj = [ [0,1,1,0,1], [1,0,0,0,1], [0,1,0,0,0], [1,1,1,0,0], [0,0,1,1,0] ]; my $dim = 4; ## size of the graph my $N = 3; ## length of paths (# of edges, not # of vertices). ## convert each entry in the adjacency matrix into a list of paths for my $i (0 .. $dim) { for my $j (0 .. $dim) { $adj->[$i][$j] = $adj->[$i][$j] ? [$j] : []; } } ## compute the $N-th power of the adjacency matrix with our modified ## multiplication my $result = $adj; for (2 .. $N) { print_paths($result); print "========\n"; $result = matrix_mult($result, $adj); } print_paths($result); ## the i,j entry of the matrix is a list of all the paths from i to j, + but ## without "i," at the beginning, so we must add it sub print_paths { my $M = shift; my @paths; for my $i (0 .. $dim) { for my $j (0 .. $dim) { push @paths, map { "$i,$_" } @{ $M->[$i][$j] }; } } print map "$_\n", sort @paths; } ## modified matrix multiplication. instead of multiplication, we ## combine paths from i->k and k->j to get paths from i->j (this is wh +y ## we include the endpoint in the path, but not the starting point). ## then instead of addition, we union all these paths from i->j sub matrix_mult { my ($A, $B) = @_; my $result; for my $i (0 .. $dim) { for my $j (0 .. $dim) { my @result; for my $k (0 .. $dim) { push @result, combine_paths( $A->[$i][$k], $B->[$k][$j] ); } $result->[$i][$j] = \@result; } } $result; } ## the sub to combine i->k paths and k->j paths into i->j paths -- ## we simply concatenate with a comma in between. sub combine_paths { my ($x, $y) = @_; my @result; for my $i (@$x) { for my $j (@$y) { push @result, "$i,$j"; } } @result; }
    Output snippet:
    0,1 0,2 ... ======== 0,1,0 0,1,4 0,2,1 0,4,2 ... ======== ... 0,4,2,1 0,4,3,0 0,4,3,1 0,4,3,2 1,0,1,0 1,0,1,4 1,0,2,1 ...

    blokhead

      Sorry for restarting a closed thread. Can this be updated to find acyclic paths. i.e. I don't get these :- 1,0,1,0 1,0,1,4 1,0,2,1 Yes I can eliminate them after I've found them but that would mean a lot of work. Thank You, Himanshu
        Depending on what you mean by acyclic paths, you might be able to. I would assume that if you can reach a point with a path of length 2, you don't want to count it again if you can reach it with a path of length 4. This situation might occur if these two points were a part of a path, and they could connect the short way--via two edges, or the long way--using 4 edges. In this case, just define an element wise subtraction operation and subtract all the shorter paths. Aka, calculate A^4 - A^3 - A^2 - A. You might be able to make this faster by leaving markers in your matrix. For example, if two points have been connected using a shorter path, place a -1 into the matrix and force your multiplication algorithm to copy it when the matrix is multiplied. I.e., -1 always maps to -1.
Re: find all paths of length n in a graph
by pKai (Priest) on Jan 10, 2006 at 19:16 UTC

    I like that sort of problems. If only to construct recursive algorithms for them.

    Here is a recursive procedure to construct and print out all paths of given length from a last visited node, provided a head path is already given and we know what nodes are left for a potential visit:

    use strict; use warnings; my %adj = ( 1 => [2,5,6], 2 => [1,3,5,6,7], 3 => [2,4,6,7,8], 4 => [3,7,8], 5 => [1,2,6,9,10], 6 => [1,2,3,5,7,9,10,11], 7 => [2,3,4,6,8,10,11,12], 8 => [3,4,7,11,12], 9 => [5,6,10,13,14], 10 => [5,6,7,9,11,13,14,15], 11 => [6,7,8,10,12,14,15,16], 12 => [7,8,11,15,16], 13 => [9,10,14], 14 => [9,10,11,13,15], 15 => [10,11,12,14,16], 16 => [11,12,15] ); sub boggle { my ($sofar, $last, $remains, $lentogo) = @_; return print "@$sofar\n" unless $lentogo; return () unless @$remains; my (@right, @left) = @$remains; while (my $next = shift @right) { boggle([@$sofar, $next], $next, [@left, @right], $lentogo-1) i +f grep {$next==$_} @{$adj{$last}}; push(@left, $next); } } for my $len (3 .. 6) { # len 3 .. 6 for my $start (1 .. 16) { # all starting points boggle([$start],$start,[1..$start-1,$start+1..16], $len); } };

    the last lines show the application to print out all paths of lengths 3 .. 6 starting anywhere on the 16 grid points.

    Edit: fixed a bug in the while loop.

Re: find all paths of length n in a graph (trie)
by tye (Cardinal) on Jan 10, 2006 at 20:19 UTC

    I would think that "all letter arrangements of length N" would not be what you'd want to use for Boggle, because there are a ton of them and if you start with "q" and go to "qz", there is no point in looking up all possible Boggle sequences on the board in your dictionary to see if any of these "qz*" things are words.

    Spelling dictionaries are often stored in a trie which is like a big nested hash (but more efficient) where you feed in the letters of your potential word one at a time and can see when you've reached the point where no word starts with those letters.

    So I'd recurse over the board and over the trie in parallel, having the trie tell me when to move on (and when I've found a word).

    - tye        

Re: find all paths of length n in a graph (Boggle solver)
by tye (Cardinal) on Jan 10, 2006 at 22:54 UTC

    And here is my solution that walks a trie and the boggle board in parallel. You need to have a dictionary file which is a just list of words, one per line. Then you run the code like:

    # To get a random 4x4 board and solve it: boggle < dictionary # To get a random board of a different size: boggle 5 < dictionary # To use a specific board: boggle gaut prmr dola esic < dictionary

    An example run on the above sample board finds 229 words plus 20 repeats using the 172823 words in my copy of the enable1 word list.

    #!/usr/bin/perl -w use strict; $|= 1; my $width= 4; my @board; if( 1 == @ARGV ) { $width= shift @ARGV; } if( @ARGV ) { $width= @ARGV; die "Invalid board (@ARGV).\n" if @ARGV != grep /^[a-z]{$width}$/, @ARGV; @board= ( '!', ('!') x $width, map( {; '!', /./g } @ARGV ), '!', ('!') x $width, '!', ); } my %trie; my %freq; my $nWords= 0; my $nLets= 0; while( <STDIN> ) { chomp; $nWords++; my $pos= \%trie; for my $let ( /./g ) { $freq{$let}++; $nLets++; $pos= $pos->{$let} ||= {}; } undef $pos->{'.'}; } print "$nWords words added to %trie.\n"; if( ! @board ) { @board= ( '!', ('!') x $width, map( {; '!', map( randLet(), 1..$width ) } 1..$width ), '!', ('!') x $width, '!', ); } my @dir= ( -$width-2, -$width-1, -$width, -1, +1, +$width, +$width+1, +$width+2 ); for( 1..$width ) { print join ' ', '', @board[ $_*($width+1)+1 .. ($_+1)*($width+1)-1 + ], $/; } my %found; my $repeats= 0; for my $start ( grep '!' ne $board[$_], 0..$#board ) { my @used; my @pos= $start; my @idx; my $word= ''; my @tree= \%trie; while( @pos ) { my $let= $board[$pos[-1]]; my $tree= $tree[-1]{$let}; if( ! $tree ) { pop @pos; } else { $used[$pos[-1]]= 1; push @tree, $tree; push @idx, 0+@dir; $word .= $let; if( exists $tree[-1]{'.'} ) { if( ! $found{$word}++ ) { print 0+keys(%found), " $word\n"; } else { $repeats++; } } } while( @pos ) { if( ! $idx[-1] ) { chop $word; $used[$pos[-1]]= 0; pop @pos; pop @idx; pop @tree; } else { my $pos= $pos[-1] + $dir[--$idx[-1]]; if( ! $used[$pos] ) { push @pos, $pos; last; } } } } } print "plus $repeats repeats\n"; sub randLet { my $cnt= int rand $nLets; for( keys %freq ) { $cnt -= $freq{$_}; return $_ if $cnt < 0; } die "Impossible"; }

    Update: Removed off-by-one error in counts displayed for found words.

    - tye        

      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

Re: find all paths of length n in a graph
by davidj (Priest) on Jan 11, 2006 at 04:06 UTC
    My Fellow Monks,
    Once again I am awed and impressed by the abilities of this community. Your responses are much valued and have given me much 'salt' for further learning.

    thank you so much,
    davidj
Re: find all paths of length n in a graph
by artist (Parson) on Jan 11, 2006 at 12:39 UTC
    Free online version with goodies. WeBoggle
    --Artist
Re: find all paths of length n in a graph
by Anonymous Monk on Jan 17, 2006 at 16:35 UTC
    I'm surprised that the adjacency list is hardcoded in many of these answers. That's the sort of thing the program should work out, so that you can scale the grid to arbitrary sizes. I would have chosen to reference tiles by a co-ordinate pair rather than a plain numbers, so for a grid of size $p by $q, the neighbours of each tile ($x,$y) can be calculated like this:
    for (my $y = 1; $y <= $q; $y++) { for (my $x = 1; $x <= $p; $x++) { for (my $ny=$y-1; $ny<=$y+1; $ny++) { next if ($ny < 1 || $ny > $q); for (my $nx=$x-1; $nx<=$x+1; $nx++) { next if ($nx < 1 || $nx > $p || ($nx == $x && $ny == $y)); push @{$adjlist{"$x,$y"}}, [$nx,$ny]; } } } }
    But it's easy enough to calculate tile numbers from the co-ordinates in this loop if required. Note the optimisation where we don't bother to go into the deepest loop if we're off the top or bottom edge. You could also do it the opposite way, looping through tile numbers from 1 to ($p*$q) and then effectively calculating the x and y position of the current tile in order to work out whether you are near an edge, but this strikes me as likely to be slower as it involves more arithmetic.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://522257]
Approved by Old_Gray_Bear
Front-paged by Old_Gray_Bear
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others drinking their drinks and smoking their pipes about the Monastery: (11)
As of 2014-07-25 19:13 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My favorite superfluous repetitious redundant duplicative phrase is:









    Results (174 votes), past polls