Re: find all paths of length n in a graph

While Graph can certainly do this for you, understanding the graph theory involved is a good idea. Basically, here's what you do:

For each available vertex:
- Select it ($seen{$vertex} = 1)
- Push the vertex to the current path (push @path, $vertex)
- If the number of vertices in the path equals the desired length (@path == $len)
  - Store the path in the master list (push @all_paths, [@path])
- Else:
  - Set "available vertices" to all unseen adjacent vertices (grep { !$seen{$_} } @{ $adjacent{$vertex} })
  - Repeat from top
- Remove the latest vertex added to the path (pop @path)
- Un-select the vertex ($seen{$vertex} = 0)

This is a relatively simple recursive process. The code is basically something like:

my $paths_ref = get_paths(\%adjaceny_matrix, $length);


sub get_paths {
  my ($adj, $len) = @_;
  my @paths;
  _get_paths_helper(\@paths, $adj, $len, [], {}, [keys %$adj]);
  return \@paths;
}


sub _get_paths_helper {
  my ($p, $am, $len, $curr, $seen, $avail) = @_;

  for my $v (@$avail) {
    push @$curr, $v;
    local $seen->{$v} = 1;
    if (@$curr == $len) { push @$p, [@$curr] }
    else {
      _get_paths_helper($p, $am, $len, $curr, $seen, [grep { !$seen->{
+$_} } @{ $am->{$v} }]);
    }
    pop @$curr;
  }
}
[download]

This can be modified to allow you to search for multiple depths without having to call the main function multiple times (which would be terribly inefficient!).

Jeff japhy Pinyan, P.L., P.M., P.O.D, X.S.: Perl, regex, and perl hacker
How can we ever be the sold short or the cheated, we who for every service have long ago been overpaid? ~~ Meister Eckhart

Comment on Re: find all paths of length n in a graph Select or Download Code

Replies are listed 'Best First'.
Re^2: find all paths of length n in a graph by Roy Johnson (Monsignor) on Jan 10, 2006 at 20:47 UTC
Algorithm::Loops' NestedLoops allows a non-recursive implementation: use Algorithm::Loops 'NestedLoops'; sub find_path { my ($adj_list, $length) = @_; my %been_there; NestedLoops([ [sort {$a <=> $b} keys %$adj_list], (sub { # The last value on @_ has just changed, so remove it from %be +en_there # and set the new one my ($last_position, $last_value) = ($#_, $_[-1]); delete $been_there{$_} for grep $been_there{$_} >= $last_posit +ion, keys %been_there; $been_there{$last_value} = $last_position; # Here I grep out the already-visited nodes, but you could als +o exclude # any letters that don't result in prefixes of real words. [ grep !defined($been_there{$_}), @{$adj_list->{$last_value}} +] }) x ($length-1)] ); } my $i = find_path(\%adjacency_list, 3); my @path; print "@path\n" while @path = $i->(); [download] Caution: Contents may have been coded under pressure.	[reply] [d/l]

Replies are listed 'Best First'.

Re^2: find all paths of length n in a graph
by Roy Johnson (Monsignor) on Jan 10, 2006 at 20:47 UTC

Algorithm::Loops

use Algorithm::Loops 'NestedLoops';

sub find_path {
  my ($adj_list, $length) = @_;
  my %been_there;
  NestedLoops([
     [sort {$a <=> $b} keys %$adj_list],
     (sub {
        # The last value on @_ has just changed, so remove it from %be
+en_there
        # and set the new one
        my ($last_position, $last_value) = ($#_, $_[-1]);
        delete $been_there{$_} for grep $been_there{$_} >= $last_posit
+ion, keys %been_there;
        $been_there{$last_value} = $last_position;
        # Here I grep out the already-visited nodes, but you could als
+o exclude
        # any letters that don't result in prefixes of real words.
        [ grep !defined($been_there{$_}), @{$adj_list->{$last_value}} 
+]
      }) x ($length-1)]
  );
}

my $i = find_path(\%adjacency_list, 3);
my @path;
print "@path\n" while @path = $i->();
[download]

Caution: Contents may have been coded under pressure.

[reply]
[d/l]