good chemistry is complicated,and a little bit messy -LW PerlMonks

### Re: Finding All Paths From a Graph From a Given Source and End Node

by BrowserUk (Pope)
 on Oct 29, 2010 at 00:44 UTC ( #868190=note: print w/replies, xml ) Need Help??

I finally got my recursive version to work. How it compares with the iterative versions I haven't tested:

```#! perl -slw
use strict;
use Data::Dump qw[ pp ];

my %graph =(
F => ['B','C','E'],
A => ['B','C'],
D => ['B'],
C => ['A','E','F'],
E => ['C','F'],
B => ['A','E','F']
);

sub findPaths {
my( \$seen,  \$start, \$end ) = @_;

return [[\$end]] if \$start eq \$end;

\$seen->{ \$start } = 1;
my @paths;
for my \$node ( @{ \$graph{ \$start } } ) {
my %seen = %{\$seen};
next if exists \$seen{ \$node };
push @paths, [ \$start, @\$_ ] for @{ findPaths( \%seen, \$node,
+\$end ) };
}
return \@paths;
}

my( \$start, \$end ) = @ARGV;

print "@\$_" for @{ findPaths( {}, \$start, \$end ) };

__END__
c:\test>868031 B E
B A C E
B A C F E
B E
B F C E
B F E

c:\test>868031 A F
A B E C F
A B E F
A B F
A C E F
A C F

c:\test>868031 A C
A B E C
A B E F C
A B F C
A B F E C
A C

Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
"Science is about questioning the status quo. Questioning authority".
In the absence of evidence, opinion is indistinguishable from prejudice.
• Comment on Re: Finding All Paths From a Graph From a Given Source and End Node

Replies are listed 'Best First'.
Re^2: Finding All Paths From a Graph From a Given Source and End Node
by neversaint (Deacon) on Nov 01, 2010 at 06:24 UTC
Dear BrowserUK, I have successfully generalize your code above so that it just take %graph, \$start,\$end as input and return final array. Thanks so much. BTW, what's the time complexity of your subroutine?
```sub findPathsAll {
my (\$graph,\$start,\$end) = @_;

my \$findPaths_sub;
\$findPaths_sub = sub {
my( \$seen, \$start, \$end ) = @_;

return [[\$end]] if \$start eq \$end;

\$seen->{ \$start } = 1;
my @paths;
for my \$node ( @{ \$graph->{ \$start } } ) {
my %seen = %{\$seen};
next if exists \$seen{ \$node };
push @paths, [ \$start, @\$_ ]
for @{ \$findPaths_sub->( \%seen, \$node, \$end ) };
}
return \@paths;
};

my @all;
push @all,[@\$_]  for @{ \$findPaths_sub->( {}, \$start, \$end )
+ };
return @all;
}

---
neversaint and everlastingly indebted.......

The usual thing to do when you have a recursive routine that needs an IUO parameter, is to use a 'helper' wrapper that supplies it.

Here's a cleaned up and simplified version that does that:

```#! perl -slw
#! perl -slw
use strict;
use List::Util qw[ shuffle ];
use Data::Dump qw[ pp ];

my %graph = map {
( chr( 64 + \$_ ) => [ (shuffle 'A'...'Z')[ 0 .. 1+ int( rand 10 )] ]
+ )
} 1, (shuffle 2 .. 25)[ 0.. int( rand 20 )], 26;

pp \%graph;

sub _findPaths {
my( \$graph, \$start, \$end, \$seen ) = @_;

return [\$end] if \$start eq \$end;

\$seen->{ \$start } = 1;
map {
map [ \$start, @\$_ ], _findPaths( \$graph, \$_, \$end, {%\$seen} );
}  grep !\$seen->{ \$_ }, @{ \$graph->{ \$start } };
}

sub findPaths { _findPaths( @_, {} ); }

my( \$start, \$end ) = @ARGV;

print "@\$_" for findPaths( \%graph, \$start, \$end );

__END__
c:\test>868031 A Z
{
A => ["M", "L", "V", "Y", "C", "T", "X", "B", "U", "G", "J"],
B => ["U", "W", "E", "Q", "M", "G", "N"],
H => ["K", "L", "I", "S", "B", "H", "M", "P", "Q", "N", "T"],
L => ["Q", "X", "E", "D", "L", "S", "N", "K"],
P => ["D", "O", "Y", "R", "I", "W", "Q", "V", "N"],
Q => ["P", "A", "N", "X", "R", "M", "T", "H", "O", "V"],
R => ["O", "A", "S", "V", "M"],
T => ["J", "Z", "F", "T", "Q", "X", "S"],
V => ["L", "E", "Z", "V"],
Y => ["M", "X", "Y", "I", "K", "U", "G", "S"],
Z => ["M", "F", "A", "P", "I"],
}

A L Q P R V Z
A L Q P V Z
A L Q R V Z
A L Q T Z
A L Q H P R V Z
A L Q H P V Z
A L Q H T Z
A L Q V Z
A V L Q T Z
A V L Q H T Z
A V Z
A T Z
A T Q P R V Z
A T Q P V Z
A T Q R V Z
A T Q H P R V Z
A T Q H P V Z
A T Q V Z
A B Q P R V Z
A B Q P V Z
A B Q R V Z
A B Q T Z
A B Q H P R V Z
A B Q H P V Z
A B Q H T Z
A B Q V Z

Be warned. The random tree generator can generate some pretty big results sets.

Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
"Science is about questioning the status quo. Questioning authority".
In the absence of evidence, opinion is indistinguishable from prejudice.
Dear BrowserUK,
What's the time complexity of findPaths()?
Thanks so much for improving the subtroutine.

---
neversaint and everlastingly indebted.......

Create A New User
Node Status?
node history
Node Type: note [id://868190]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others surveying the Monastery: (4)
As of 2021-01-23 02:08 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
The STEM quote I most wish I'd made is:

Results (250 votes). Check out past polls.

Notices?