# maximum-flow-g.pkg
# This module implements max (s, t) flow.
#
# -- Allen Leung
# Compiled by:
# src/lib/graph/graphs.lib# See also:
# src/lib/graph/test-max-flow.pkg# src/lib/compiler/back/low/doc/latex/graphs.tex
### "In the Universe the
### difficult things are done
### as if they were easy."
###
### -- Lao Tzu
stipulate
package odg = oop_digraph; # oop_digraph is from src/lib/graph/oop-digraph.pkg package vec = rw_vector; # rw_vector is from src/lib/std/src/rw-vector.pkgherein
generic package maximum_flow_g (num: Abelian_Group) # Abelian_Group is from src/lib/graph/group.api #
: (weak) Maximum_Flow # Maximum_Flow is from src/lib/graph/maximum-flow.api {
package num = num;
# Use Goldberg's preflow-push approach.
# This algorithm is presented in the book by Cormen, Leiserson and Rivest.
fun max_flow { graph=>odg::DIGRAPH ggg, s, t, capacity, flows }
=
{ if (s == t)
raise exception odg::BAD_GRAPH "maxflow";
fi;
nnn = ggg.capacity ();
mmm = ggg.order ();
zero = num::zero;
neighbors = vec::make_rw_vector (nnn,[]);
dist = vec::make_rw_vector (nnn, 0);
excess = vec::make_rw_vector (nnn, zero);
current = vec::make_rw_vector (nnn,[]);
fun min (a, b)
=
if (num::(<) (a, b) ) a; else b;fi;
fun is_zero a
=
num::(====) (a, zero);
my (-_) = num::neg;
fun set_up_preflow ()
=
{ fun add_edge (e as (u, _, _))
=
vec::set (neighbors, u, e ! vec::get (neighbors, u));
ggg.forall_edges
( \\ e as (u, v, e')
=
{ c = capacity e;
if (u == s)
f = REF c;
f' = REF(-c);
add_edge (u, v, (f, c, f', TRUE, e'));
add_edge (v, u, (f', zero, f, FALSE, e'));
vec::set (excess, v, num::(+)(c, vec::get (excess, v)));
else
f = REF zero;
f' = REF zero;
add_edge (u, v, (f, c, f', TRUE, e'));
add_edge (v, u, (f', zero, f, FALSE, e'));
fi;
}
);
vec::set (dist, s, mmm);
};
# Push d_f (u, v) = min (e[u], c (u, v)) units of flow from u to v
# Returns the new e_u
fun push (e_u, (u, v, (flow, cap, flow', x, _)))
=
{ c_f = num::(-) (cap,*flow);
d_f = min (e_u, c_f);
e_v = vec::get (excess, v);
flow := num::(+) (*flow, d_f);
flow' := -(*flow);
vec::set (excess, v, num::(+) (e_v, d_f));
num::(-) (e_u, d_f);
};
# Lift a vertex
# dist[v] := 1 + min { dist[w] | (v, w) \in E_f }
# Returns the new dist[v]
fun lift v
=
d_v
where
fun loop ([], d_v)
=>
d_v;
loop((v, w, (f, c, _, _, _)) ! es, d_v)
=>
if (num::(<) (*f, c)) loop (es, int::min (vec::get (dist, w), d_v));
else loop (es, d_v); fi;
end;
d_v = loop (vec::get (neighbors, v), 1000000000) + 1;
vec::set (dist, v, d_v);
end;
# Push all excess flow thru admissible edges to neighboring vertices
# until all excess flow has been discharged.
fun discharge v
=
{ e_v = vec::get (excess, v);
if (is_zero e_v)
FALSE;
else
fun loop (d_v, e_v, (e as (v, w, (f, c, _, _, _))) ! es)
=>
if (num::(<) (*f, c) and d_v == vec::get (dist, w) + 1)
e_v = push (e_v, e);
if (is_zero e_v) (d_v, es);
else loop (d_v, e_v, es); fi;
else
loop (d_v, e_v, es);
fi;
loop (_, e_v,[])
=>
loop (lift v, e_v, vec::get (neighbors, v));
end;
d_v = vec::get (dist, v);
my (d_v', es)
=
loop (d_v, e_v, vec::get (current, v));
vec::set (excess, v, zero); # e[v] must be zero
vec::set (current, v, es);
d_v != d_v';
fi;
}; # fun discharge
fun lift_to_front ()
=
{ set_up_preflow();
iterate(
[],
list::fold_backward
( \\ ((u, _), l)
=
if (u == s or u == t)
#
l;
else
vec::set (current, u, vec::get (neighbors, u));
u ! l;
fi
)
[]
(ggg.nodes ())
);
}
also
fun iterate (_,[]) => ();
iterate (f, u ! b)
=>
if (discharge u) iterate([u], reverse f@b);
else iterate (u ! f, b);
fi;
end;
lift_to_front ();
ggg.forall_nodes
(\\ (i, _)
=
apply
(\\ (i, j, (f, _, _, x, e'))
=
if x
flows ((i, j, e'), *f);
fi
)
(vec::get (neighbors, i))
);
list::fold_backward
(\\ ((_, _, (f, _, _, _, _)), n) = num::(+) (*f, n))
zero
(vec::get (neighbors, s));
};
fun min_cost_max_flow { graph=>odg::DIGRAPH ggg, s, t, capacity, cost, flows }
=
raise exception odg::UNIMPLEMENTED;
};
end;