| Subject: | SSSP_DAG() and SSSP_Bellman_Ford() hang in Directed Graphs |
#!/usr/bin/perl
#This is perl, v5.8.0 built for i386-linux-thread-multi
#Graph 0.20101
#Linux bala 2.4.18-6mdk #1 Fri Mar 15 02:59:08 CET 2002 i686 unknown #unknown GNU/Linux
# (Mandake Linux 8.2 patched from Cooker rpms)
use Graph::Directed;
use Graph::Undirected;
@v = qw (a b c );
$g = Graph::Directed->new(@v);
#$g = Graph::Undirected->new(@v);
$g->add_edge('a', 'b');
$g->add_edge('a', 'c');
# these all call Graph::Base::_SSSP_construct
#
#$s = $g->SSSP_DAG('b'); # hangs
#$s = $g->SSSP_Dijkstra('b'); # works
$s = $g->SSSP_Bellman_Ford('b'); # hangs
print join (', ', @{$s->get_attribute('path', 'c')} ), "\n";
# the attached fix cuts the loop that hangs
#--- /usr/lib/perl5/site_perl/5.8.0/Graph/Base.ori.pm
#+++ /usr/lib/perl5/site_perl/5.8.0/Graph/Base.pm
#@@ -2040,7 +2040,7 @@
# if ( $P->{ $u } ne $s ) {
# my $v = $P->{ $u };
#
#- while ( $v ne $s ) {
#+ while ( defined $v && exists $P->{ $v } && $v ne $s ) {
# push @path, $P->{ $v };
# $v = $P->{ $v };
# }
#
#
# This loop should give identical results
# from all SSSP algorithms, right?
#
# Well it does not. Why?
#
# If it a question of algorithms being different, so be it.
# I can not right now find 'Mastering Algorithms in Perl'
# and the pod docs are scanty
#&after_fix;
sub after_fix {
foreach $i (@v) {
foreach $j (@v) {
print "\n------ $i -> $j -----------------\n";
$s = $g->SSSP_DAG($i);
print "DAG: \t\t",
join (', ', @{$s->get_attribute('path', $j)} ), "\n";
$s = $g->SSSP_Dijkstra($i);
print "Dijkstra: \t",
join (', ', @{$s->get_attribute('path', $j)} ), "\n";
$s = $g->SSSP_Bellman_Ford($i);
print "Bellman_Ford:\t",
join (', ', @{$s->get_attribute('path', $j)} ), "\n";
}
}
}
Terveisin,
-Heikki
--- /usr/lib/perl5/site_perl/5.8.0/Graph/Base.ori.pm 2002-11-09 14:47:31.000000000 +0000
+++ /usr/lib/perl5/site_perl/5.8.0/Graph/Base.pm 2002-11-09 15:08:32.000000000 +0000
@@ -2040,7 +2040,7 @@
if ( $P->{ $u } ne $s ) {
my $v = $P->{ $u };
- while ( $v ne $s ) {
+ while ( defined $v && exists $P->{ $v } && $v ne $s ) {
push @path, $P->{ $v };
$v = $P->{ $v };
}