Beefy Boxes and Bandwidth Generously Provided by pair Networks
Keep It Simple, Stupid
 
PerlMonks  

Modification of the Floyd-Warshall Graph Distance Algorithm

by arunhorne (Pilgrim)
on Jul 19, 2002 at 16:43 UTC ( #183305=CUFP: print w/replies, xml ) Need Help??

Below are my completed set of modifications to the Floyd_Warshall algorithm to apply the constraint that the search must leave the node before coming back, i.e. the distance from a vertex V is >0 rather than equal to zero as the algorithm defaults to when the start node is the same as the end node.

I would like to point out that I am responsible for the modifications only which are clearly marked. The original code is Copyright 1999, O'Reilly & Associates and freely available under the same terms as Perl is distributed under. I have provided my modifications merely to help others if they have the same requirement I had

sub Aruns_APSP_Floyd_Warshall { my $G = shift; my @V = $G->vertices; my @E = $G->edges; my (%V2I, @I2V); my (@P, @W); # Compute the vertex <-> index mappings. @V2I{ @V } = 0..$#V; @I2V[ 0..$#V ] = @V; # Initialize the predecessor matrix @P and the weight matrix @W. # (The graph is converted into adjacency-matrix representation.) # (The matrix is a list of lists.) # ********* START OF MANUAL EDIT BY ABH ************ #foreach my $i ( 0..$#V ) { $W[ $i ][ $i ] = 0 } # ********* END OF MANUAL EDIT BY ABH ************** while ( my ($u, $v) = splice(@E, 0, 2) ) { my ( $ui, $vi ) = ( $V2I{ $u }, $V2I{ $v } ); # ********* START OF MANUAL EDIT BY ABH ******** $P[ $ui ][ $vi ] = $ui; #unless $ui == $vi; # ********* END OF MANUAL EDIT BY ABH ********** $W[ $ui ][ $vi ] = $G->get_attribute( 'weight', $u, $v ); } # Do the O(N**3) loop. for ( my $k = 0; $k < @V; $k++ ) { my (@nP, @nW); # new @P, new @W for ( my $i = 0; $i < @V; $i++ ) { for ( my $j = 0; $j < @V; $j++ ) { my $w_ij = $W[ $i ][ $j ]; my $w_ik_kj = $W[ $i ][ $k ] + $W[ $k ][ $j ] if defined $W[ $i ][ $k ] and defined $W[ $k ][ $j ]; # Choose the minimum of w_ij and w_ik_kj. if ( defined $w_ij ) { if ( defined $w_ik_kj ) { if ( $w_ij <= $w_ik_kj ) { $nP[ $i ][ $j ] = $P[ $i ][ $j ]; $nW[ $i ][ $j ] = $w_ij; } else { $nP[ $i ][ $j ] = $P[ $k ][ $j ]; $nW[ $i ][ $j ] = $w_ik_kj; } } else { $nP[ $i ][ $j ] = $P[ $i ][ $j ]; $nW[ $i ][ $j ] = $w_ij; } } elsif ( defined $w_ik_kj ) { $nP[ $i ][ $j ] = $P[ $k ][ $j ]; $nW[ $i ][ $j ] = $w_ik_kj; } } } @P = @nP; @W = @nW; # Update the predecessors and weights. } # Now construct the APSP graph. my $APSP = (ref $G)->new; $APSP->directed( $G->directed ); # Copy the directedness. # Convert the adjacency-matrix representation # into a Graph (adjacency-list representation). for ( my $i = 0; $i < @V; $i++ ) { my $iv = $I2V[ $i ]; for ( my $j = 0; $j < @V; $j++ ) { # ********* START OF MANUAL EDIT BY ABH ******** #if ( $i == $j ) { # $APSP->add_weighted_edge( $iv, 0, $iv ); # $APSP->set_attribute("path", $iv, $iv, [ $iv ]); # next; #} # ********* END OF MANUAL EDIT BY ABH ********** next unless defined $W[ $i ][ $j ]; my $jv = $I2V[ $j ]; $APSP->add_weighted_edge( $iv, $W[ $i ][ $j ], $jv ); my @path = ( $jv ); if ( $P[ $i ][ $j ] != $i ) { my $k = $P[ $i ][ $j ]; # Walk back the path. while ( $k != $i ) { push @path, $I2V[ $k ]; $k = $P[ $i ][ $k ]; # Keep walking. } } $APSP->set_attribute( "path", $iv, $jv, [ $iv, reverse @pa +th ] ); } } return $APSP; }

Hope you find it useful,

____________
Arun

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: CUFP [id://183305]
Approved by footpad
Front-paged by jarich
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 2018-12-12 19:31 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    How many stories does it take before you've heard them all?







    Results (60 votes). Check out past polls.

    Notices?
    • (Sep 10, 2018 at 22:53 UTC) Welcome new users!