Beefy Boxes and Bandwidth Generously Provided by pair Networks
Welcome to the Monastery
 
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??


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

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


    ---
    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.......

Log In?
Username:
Password:

What's my password?
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 imbibing at the Monastery: (6)
As of 2020-03-31 08:04 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    To "Disagree to disagree" means to:









    Results (180 votes). Check out past polls.

    Notices?