The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Bio::ConnectDots::SimpleGraph::ShortestPaths;
use vars qw(@ISA @AUTO_ATTRIBUTES @OTHER_ATTRIBUTES %SYNONYMS %DEFAULTS);
use Class::AutoClass;
use Bio::ConnectDots::SimpleGraph;
use strict;
@ISA = qw(Class::AutoClass); # AutoClass must be first!!

@AUTO_ATTRIBUTES=qw(graph);
@OTHER_ATTRIBUTES=qw();
%SYNONYMS=();
%DEFAULTS=();
Class::AutoClass::declare(__PACKAGE__);

# Floyd-Warshall All Pairs Shortest Paths algorithm
# adapted from http://www.comp.nus.edu.sg/~stevenha/programming/prog_graph6.html

sub _init_self {
  my($self,$class,$args)=@_;
  return unless $class eq __PACKAGE__; # to prevent subclasses from re-running this
}

my($dist,$path);		# global variables in algorithm

sub paths {
  my($self,$graph)=@_;
  $graph or $graph=$self->graph;
  return unless $graph;
  # initialization
  my $nodes=$graph->nodes;
  $dist={};
  $path={};
  for (my $i=0; $i<@$nodes; $i++) { # start from i
    my $node0=$nodes->[$i];
    for (my $j=0; $j<@$nodes; $j++) { # end at j
      my $node1=$nodes->[$j];
      if ($i==$j) {
	$dist->{$i,$j}=0;
	next;
      }
      next unless $graph->has_edge($node0,$node1);
      $dist->{$i,$j}=1;
      $path->{$i,$j}=[$i,$j];
    }
  }
  # compute paths
  for (my $k=0; $k<@$nodes; $k++) {        # k is intermediate point
    for (my $i=0; $i<@$nodes-1; $i++) {    # start from i
      next unless defined $dist->{$i,$k};
      for (my $j=$i+1; $j<@$nodes; $j++) { # NG 04-02-10 added optimization
#      for (my $j=0; $j<@$nodes; $j++) { # end at j
	next unless defined $dist->{$k,$j};
	# path i..k..j exists -- is it shorter than what we already have?
	if (!defined $dist->{$i,$j} || $dist->{$i,$k}+$dist->{$k,$j} < $dist->{$i,$j}) {
	  $dist->{$i,$j}=$dist->{$i,$k}+$dist->{$k,$j};
	  $path->{$i,$j}=join_paths($i,$k,$j);
#	  # NG 04-02-10 next two lines needed for optimization above
	  $dist->{$j,$i}=$dist->{$i,$j};
	  $path->{$j,$i}=[reverse @{$path->{$i,$j}}];
	}
      }
    }
  }
  # convert node indices (i,j,..) into nodes
  my $paths={};
  for (my $i=0; $i<@$nodes-1; $i++) {    # start from i
    my $nodei=$nodes->[$i];
    for (my $j=$i+1; $j<@$nodes; $j++) { # end at j
      my $p=$path->{$i,$j};
      my $nodej=$nodes->[$j];
      my $path_nodes=[map {$nodes->[$_]} @$p];
      if ("$nodei" lt "$nodej") {
	$paths->{$nodei,$nodej}=$path_nodes;
      } else {
	$paths->{$nodej,$nodei}=[reverse @$path_nodes];
      }
    }
  }
  $paths;
}

sub join_paths {
  my($i,$k,$j)=@_;
  my $path0=$path->{$i,$k} || [];
  my $path1=$path->{$k,$j} || [];
  my $last0=@$path0-1;
  my $last1=@$path1-1;
  my $result=[];
  @$result=(@$path0[0..$last0-1],$k,@$path1[1..$last1]);
  $path->{$i,$j}=$result;
}



1;