in reply to Finding All Paths From a Graph From a Given Source and End Node

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

[download]
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.
RIP an inspiration; A true Folk's Guy
  • Comment on Re: Finding All Paths From a Graph From a Given Source and End Node
  • Download Code

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;
        }

    [download]


    ---
    neversaint and everlastingly indebted.......
[reply]
[d/l]

      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

      [download]

      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.
[reply]
[d/l]
        Dear BrowserUK,
        What's the time complexity of findPaths()?
        Thanks so much for improving the subtroutine.

        ---
        neversaint and everlastingly indebted.......
[reply]
[reply]

In Section Seekers of Perl Wisdom