in reply to find all paths of length n in a graph

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.

Replies are listed 'Best First'.
Re^2: find all paths of length n in a graph
by karden (Novice) on Sep 18, 2007 at 11:30 UTC
    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.
        Arghh stupid me!

        Oh no, not a HW. In fact I am a little old for HWs *ashamed*. I am good with Java/C stuff but I am trying to get familiar with Perl for one of my projects so asking whatever comes into my mind. Perl's (incredible) shorthand expressions confuse me often and sometimes I spend needlessly long time trying to figure them out (else part in the code for instance). Though this time, I agree that, I did not consider enough. It was obviously too trivial. Sorry but thank you indeed!