#!/usr/bin/perl

# Flow_Ford_Fulkerson
#
#       $F = $G->Flow_Ford_Fulkerson($S)
#
#       Returns the (maximal) flow network of the flow network $G,
#       parameterized by the state $S.  The $G must have 'capacity'
#       attributes on its edges.  $S->{ source } must contain the

#       source vertex and $S->{ sink } the sink vertex, and
#       $S->{ next_augmenting_path } must contain
#       an anonymous routine that takes $F and $S as arguments
#       and returns the next potential augmenting path.
#       Flow_Ford_Fulkerson will do the augmenting.
#       The result graph $F will have 'flow' and (residual) 'capacity'
#       attributes on its edges.
#

sub Flow_Ford_Fulkerson {
    my ( $G, $S ) = @_;

    my $F = (ref $G)->new; # The flow network.
    my @E = $G->edges;
    my ( $u, $v );

    # Copy the edges and the capacities, zero the flows.
    while (($u, $v) = splice(@E, 0, 2)) {
        $F->add_edge( $u, $v );
        $F->set_attribute( 'capacity', $u, $v,
                           $G->get_attribute( 'capacity', $u, $v ) || 0 );
        $F->set_attribute( 'flow',     $u, $v, 0 );
    }

    # Walk the augmenting paths.
    while ( my $ap = $S->{ next_augmenting_path }->( $F, $S ) ) {
        my @aps = @$ap; # augmenting path segments
        my $apr;        # augmenting path residual capacity
        my $psr;        # path segment residual capacity

        # Find the minimum capacity of the path.
        for ( $u = shift @aps; @aps; $u = $v ) {
            $v   = shift @aps;
            $psr = $F->get_attribute( 'capacity', $u, $v ) -
                   $F->get_attribute( 'flow',     $u, $v );
            $apr = $psr
                if $psr >= 0 and ( not defined $apr or $psr < $apr );
        }

        if ( $apr > 0 ) { # Augment the path.
            for ( @aps = @$ap, $u = shift @aps; @aps; $u = $v ) {
                $v = shift @aps;
                $F->set_attribute( 'flow',
                                   $u, $v,
                                   $F->get_attribute( 'flow', $u, $v ) +
                                   $apr );
            }
        }
    }

    return $F;
}