Keep It Simple, Stupid PerlMonks

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

by Limbic~Region (Chancellor)
 on Oct 29, 2010 at 01:04 UTC ( #868195=note: print w/replies, xml ) Need Help??

choroba,
As I indicated before, certain graphs, order of traversal and endpoints will determine how well the short circuiting approach fairs. I have asked for advice concerning this at Short Circuiting DFS Graph Traversal. My fastest normal solution is below.
```#!/usr/bin/perl
use strict;
use warnings;

my %graph = (
R => [qw/L J Z/], L => [qw/R J X/], J => [qw/R L X Z/], Z => [qw/R
+ J X/], X => [qw/L J Z F D/],
F => [qw/X D/],   D => [qw/Q F X/], Q => [qw/B U D/],   B => [qw/Q
+ P M/], P => [qw/B U/],
U => [qw/Q P S/], M => [qw/B S/],   S => [qw/U M/],
);

my \$n;
my %node_to_int = map {\$_ => \$n++} keys %graph;

my \$routes = find_paths('D', 'M', \%graph);
print "\$_\n" for @\$routes;

sub find_paths {
my (\$beg, \$end, \$graph) = @_;
my (@work, @solution);
for (@{\$graph->{\$beg}}) {
if (\$_ eq \$end) {
push @solution, "\$beg->\$end";
next;
}
my \$seen = '';
vec(\$seen, \$node_to_int{\$_}, 1) = 1;
vec(\$seen, \$node_to_int{\$beg}, 1) = 1;
push @work, ["\$beg->\$_", \$_, \$seen];
}
while (@work) {
my \$item = pop @work;
my (\$path, \$curr, \$seen) = @\$item;
for my \$node (@{\$graph->{\$curr}}) {
my \$bit = \$node_to_int{\$node};
next if vec(\$seen, \$bit, 1);
if (\$node eq \$end) {
push @solution, "\$path->\$end";
next;
}
my \$new_seen = \$seen;
vec(\$new_seen, \$bit, 1) = 1;
push @work, ["\$path->\$node", \$node, \$new_seen];
}
}
return \@solution;
}

Cheers - L~R

• Comment on Re^5: Finding All Paths From a Graph From a Given Source and End Node

Replies are listed 'Best First'.
Re^6: Finding All Paths From a Graph From a Given Source and End Node
by neversaint (Deacon) on Nov 01, 2010 at 04:59 UTC
Dear Limbic,
I tried the following graph and predertimined start and position in code below. But why It gives empty result? Please refer to the visualization of the graph here (http://graph.gafol.net/cESwUMeNd) .
```
my %graph2 = (
],
],
]
);

sub find_paths {
my (\$beg, \$end, \$graph) = @_;

my \$n;
my %node_to_int = map {\$_ => \$n++} keys %graph;

my (@work, @solution);
for (@{\$graph->{\$beg}}) {
if (\$_ eq \$end) {
push @solution, "\$beg->\$end";
next;
}
my \$seen = '';
vec(\$seen, \$node_to_int{\$_}, 1) = 1;

vec(\$seen, \$node_to_int{\$beg}, 1) = 1;

push @work, ["\$beg->\$_", \$_, \$seen];
}
while (@work) {
my \$item = pop @work;
my (\$path, \$curr, \$seen) = @\$item;
for my \$node (@{\$graph->{\$curr}}) {
my \$bit = \$node_to_int{\$node};
next if vec(\$seen, \$bit, 1);
if (\$node eq \$end) {
push @solution, "\$path \$end";
next;
}
my \$new_seen = \$seen;
vec(\$new_seen, \$bit, 1) = 1;
push @work, ["\$path->\$node", \$node, \$new_seen];
}
}

# Return
print Dumper \@solution;
return \@solution;
}

---
neversaint and everlastingly indebted.......
neversaint,
The problem was that the %node_to_int lookup assumed all possible nodes would also be keys in graph. One way to fix it would be to have nodes that don't connect anywhere as node => [] (empty array ref). I chose to provide a solution below that doesn't require the user to type more than is necessary when building the graph.

Cheers - L~R

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

How do I use this? | Other CB clients
Other Users?
Others making s'mores by the fire in the courtyard of the Monastery: (7)
As of 2020-04-08 18:54 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
The most amusing oxymoron is:

Results (45 votes). Check out past polls.

Notices?