in reply to Re^2: Finding All Paths From a Graph From a Given Source and End Node
in thread Finding All Paths From a Graph From a Given Source and End Node

choroba,
The short circuiting approach is slower than the previous one

I suspect this will heavily depend on the test data which neversaint hasn't supplied. In a nutshell, I am recording path information on the basis that it will pay off down the road. If there is no short circuit possibilities then the overhead of tracking will not be paid for and it becomes slower.

This is why I said I was unhappy with it. I am going to let this sit in my feeble brain for a while and if I can't come up with a better approach I will post a new thread for other monks to weigh in on.

Update: The following is the basically the same algorithm with some optimizations. I would be interested in your test data and/or your benchmark. 

#!/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, %done);
    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;
        my $ok;
        NODE:
        for my $node (@{$graph->{$curr}}) {
            my $bit = $node_to_int{$node};
            next if vec($seen, $bit, 1);
            if ($done{$node}) {
                for (keys %{$done{$node}}) {
                    next NODE if $_ eq ($_ & $seen);
                }
            }
            $ok = 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];
        }
        if (! $ok) {
            my @order = reverse split /->/, $path; 
            pop @order;
            for (@order) {
                vec($seen, $node_to_int{$_}, 1) = 0;
                $done{$_}{$seen} = undef;
            }
        }
    }
    return \@solution;
}

[download]

Cheers - L~R

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

Replies are listed 'Best First'.
Re^4: Finding All Paths From a Graph From a Given Source and End Node
by choroba (Cardinal) on Oct 28, 2010 at 23:50 UTC
    Here is my code as it is (your subs removed):
    Read more... (3 kB)
[reply]
[d/l]
Re^4: Finding All Paths From a Graph From a Given Source and End Node
by choroba (Cardinal) on Oct 29, 2010 at 00:15 UTC
    Using your graph and R=>P as the path, the short circuit is the best:
               Rate   breadth    limbic     depth limbic_sc
breadth   158/s        --      -34%      -42%      -60%
limbic    238/s       51%        --      -13%      -39%
depth     274/s       73%       15%        --      -30%
limbic_sc 392/s      148%       65%       43%        --

    [download]
[reply]
[d/l]
      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.
      Read more... (2 kB)

      Cheers - L~R

[reply]
[d/l]
        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 = (
          'read145404_1' => [
                              'read231054_2',
                              'read250449_2'
                            ],
          'read250449_2' => [
                              'read359463_1',
                              'read691358_1',
                              'read937013_1'
                            ],
          'read231054_2' => [
                              'read691358_1',
                              'read359463_1',
                              'read937013_1'
                            ]
        );

my $routes = find_paths('read145404_1', 'read691358_1', \%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;
}

        [download]


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

In Section Seekers of Perl Wisdom