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;
}

[download]

Hope you find it useful,

____________
Arun

In reply to Modification of the Floyd-Warshall Graph Distance Algorithm by arunhorne

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.