-- | Maximum Flow algorithm
--
-- We are given a flow network @G=(V,E)@ with source @s@ and sink @t@
-- where each edge @(u,v)@ in @E@ has a nonnegative capacity
-- @c(u,v)>=0@, and we wish to find a flow of maximum value from @s@
-- to @t@.
--
-- A flow in @G=(V,E)@ is a real-valued function @f:VxV->R@ that
-- satisfies:
--
-- @
-- For all u,v in V, f(u,v)\<=c(u,v)
-- For all u,v in V, f(u,v)=-f(v,u)
-- For all u in V-{s,t}, Sum{f(u,v):v in V } = 0
-- @
--
-- The value of a flow f is defined as @|f|=Sum {f(s,v)|v in V}@, i.e.,
-- the total net flow out of the source.
--
-- In this module we implement the Edmonds-Karp algorithm, which is
-- the Ford-Fulkerson method but using the shortest path from @s@ to
-- @t@ as the augmenting path along which the flow is incremented.

module Data.Graph.Inductive.Query.MaxFlow(
    getRevEdges, augmentGraph, updAdjList, updateFlow, mfmg, mf, maxFlowgraph,
    maxFlow
) where


import Data.List

import Data.Graph.Inductive.Basic
import Data.Graph.Inductive.Graph
--import Data.Graph.Inductive.Tree
import Data.Graph.Inductive.Query.BFS

-- |
-- @
--                 i                                 0
-- For each edge a--->b this function returns edge b--->a .
--          i
-- Edges a\<--->b are ignored
--          j
-- @
getRevEdges :: (Num b) => [Edge] -> [LEdge b]
getRevEdges :: [Edge] -> [LEdge b]
getRevEdges [] = []
getRevEdges ((Node
u,Node
v):[Edge]
es) | (Node
v,Node
u) Edge -> [Edge] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Edge]
es = (Node
v,Node
u,b
0)LEdge b -> [LEdge b] -> [LEdge b]
forall a. a -> [a] -> [a]
:[Edge] -> [LEdge b]
forall b. Num b => [Edge] -> [LEdge b]
getRevEdges [Edge]
es
                       | Bool
otherwise          = [Edge] -> [LEdge b]
forall b. Num b => [Edge] -> [LEdge b]
getRevEdges (Edge -> [Edge] -> [Edge]
forall a. Eq a => a -> [a] -> [a]
delete (Node
v,Node
u) [Edge]
es)

-- |
-- @
--                 i                                  0
-- For each edge a--->b insert into graph the edge a\<---b . Then change the
--                            i         (i,0,i)
-- label of every edge from a---->b to a------->b
-- @
--
-- where label (x,y,z)=(Max Capacity, Current flow, Residual capacity)
augmentGraph :: (DynGraph gr, Num b) => gr a b -> gr a (b,b,b)
augmentGraph :: gr a b -> gr a (b, b, b)
augmentGraph gr a b
g = (b -> (b, b, b)) -> gr a b -> gr a (b, b, b)
forall (gr :: * -> * -> *) b c a.
DynGraph gr =>
(b -> c) -> gr a b -> gr a c
emap (\b
i->(b
i,b
0,b
i)) ([LEdge b] -> gr a b -> gr a b
forall (gr :: * -> * -> *) b a.
DynGraph gr =>
[LEdge b] -> gr a b -> gr a b
insEdges ([Edge] -> [LEdge b]
forall b. Num b => [Edge] -> [LEdge b]
getRevEdges (gr a b -> [Edge]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [Edge]
edges gr a b
g)) gr a b
g)

-- | Given a successor or predecessor list for node @u@ and given node @v@, find
--   the label corresponding to edge @(u,v)@ and update the flow and
--   residual capacity of that edge's label. Then return the updated
--   list.
updAdjList::(Num b) => Adj (b,b,b) -> Node -> b -> Bool -> Adj (b,b,b)
updAdjList :: Adj (b, b, b) -> Node -> b -> Bool -> Adj (b, b, b)
updAdjList Adj (b, b, b)
s Node
v b
cf Bool
fwd = Adj (b, b, b)
rs Adj (b, b, b) -> Adj (b, b, b) -> Adj (b, b, b)
forall a. [a] -> [a] -> [a]
++ ((b
x,b
yb -> b -> b
forall a. Num a => a -> a -> a
+b
cf',b
zb -> b -> b
forall a. Num a => a -> a -> a
-b
cf'),Node
w) ((b, b, b), Node) -> Adj (b, b, b) -> Adj (b, b, b)
forall a. a -> [a] -> [a]
: Adj (b, b, b)
rs'
  where
    (Adj (b, b, b)
rs, ((b
x,b
y,b
z),Node
w):Adj (b, b, b)
rs') = (((b, b, b), Node) -> Bool)
-> Adj (b, b, b) -> (Adj (b, b, b), Adj (b, b, b))
forall a. (a -> Bool) -> [a] -> ([a], [a])
break ((Node
vNode -> Node -> Bool
forall a. Eq a => a -> a -> Bool
==) (Node -> Bool)
-> (((b, b, b), Node) -> Node) -> ((b, b, b), Node) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((b, b, b), Node) -> Node
forall a b. (a, b) -> b
snd) Adj (b, b, b)
s

    cf' :: b
cf' = if Bool
fwd
             then b
cf
             else b -> b
forall a. Num a => a -> a
negate b
cf

-- | Update flow and residual capacity along augmenting path from @s@ to @t@ in
--   graph @@G. For a path @[u,v,w,...]@ find the node @u@ in @G@ and
--   its successor and predecessor list, then update the corresponding
--   edges @(u,v)@ and @(v,u)@ on those lists by using the minimum
--   residual capacity of the path.
updateFlow :: (DynGraph gr, Num b) => Path -> b -> gr a (b,b,b) -> gr a (b,b,b)
updateFlow :: Path -> b -> gr a (b, b, b) -> gr a (b, b, b)
updateFlow []        b
_ gr a (b, b, b)
g = gr a (b, b, b)
g
updateFlow [Node
_]       b
_ gr a (b, b, b)
g = gr a (b, b, b)
g
updateFlow (Node
u:Node
v:Path
vs) b
cf gr a (b, b, b)
g = case Node -> gr a (b, b, b) -> Decomp gr a (b, b, b)
forall (gr :: * -> * -> *) a b.
Graph gr =>
Node -> gr a b -> Decomp gr a b
match Node
u gr a (b, b, b)
g of
                             (Maybe (Context a (b, b, b))
Nothing,gr a (b, b, b)
g')         -> gr a (b, b, b)
g'
                             (Just (Adj (b, b, b)
p,Node
u',a
l,Adj (b, b, b)
s),gr a (b, b, b)
g') -> (Adj (b, b, b)
p',Node
u',a
l,Adj (b, b, b)
s') Context a (b, b, b) -> gr a (b, b, b) -> gr a (b, b, b)
forall (gr :: * -> * -> *) a b.
DynGraph gr =>
Context a b -> gr a b -> gr a b
& gr a (b, b, b)
g2
                               where
                                 g2 :: gr a (b, b, b)
g2 = Path -> b -> gr a (b, b, b) -> gr a (b, b, b)
forall (gr :: * -> * -> *) b a.
(DynGraph gr, Num b) =>
Path -> b -> gr a (b, b, b) -> gr a (b, b, b)
updateFlow (Node
vNode -> Path -> Path
forall a. a -> [a] -> [a]
:Path
vs) b
cf gr a (b, b, b)
g'
                                 s' :: Adj (b, b, b)
s' = Adj (b, b, b) -> Node -> b -> Bool -> Adj (b, b, b)
forall b.
Num b =>
Adj (b, b, b) -> Node -> b -> Bool -> Adj (b, b, b)
updAdjList Adj (b, b, b)
s Node
v b
cf Bool
True
                                 p' :: Adj (b, b, b)
p' = Adj (b, b, b) -> Node -> b -> Bool -> Adj (b, b, b)
forall b.
Num b =>
Adj (b, b, b) -> Node -> b -> Bool -> Adj (b, b, b)
updAdjList Adj (b, b, b)
p Node
v b
cf Bool
False

-- | Compute the flow from @s@ to @t@ on a graph whose edges are labeled with
--   @(x,y,z)=(max capacity,current flow,residual capacity)@ and all
--   edges are of the form @a\<---->b@. First compute the residual
--   graph, that is, delete those edges whose residual capacity is
--   zero. Then compute the shortest augmenting path from @s@ to @t@,
--   and finally update the flow and residual capacity along that path
--   by using the minimum capacity of that path. Repeat this process
--   until no shortest path from @s@ to @t@ exist.
mfmg :: (DynGraph gr, Num b, Ord b) => gr a (b,b,b) -> Node -> Node -> gr a (b,b,b)
mfmg :: gr a (b, b, b) -> Node -> Node -> gr a (b, b, b)
mfmg gr a (b, b, b)
g Node
s Node
t
  | Path -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Path
augPath = gr a (b, b, b)
g
  | Bool
otherwise    = gr a (b, b, b) -> Node -> Node -> gr a (b, b, b)
forall (gr :: * -> * -> *) b a.
(DynGraph gr, Num b, Ord b) =>
gr a (b, b, b) -> Node -> Node -> gr a (b, b, b)
mfmg (Path -> b -> gr a (b, b, b) -> gr a (b, b, b)
forall (gr :: * -> * -> *) b a.
(DynGraph gr, Num b) =>
Path -> b -> gr a (b, b, b) -> gr a (b, b, b)
updateFlow Path
augPath b
minC gr a (b, b, b)
g) Node
s Node
t
  where
    minC :: b
minC        = [b] -> b
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum (((Node, (b, b, b)) -> b) -> [(Node, (b, b, b))] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map ((\(b
_,b
_,b
z)->b
z)((b, b, b) -> b)
-> ((Node, (b, b, b)) -> (b, b, b)) -> (Node, (b, b, b)) -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Node, (b, b, b)) -> (b, b, b)
forall a b. (a, b) -> b
snd)([(Node, (b, b, b))] -> [(Node, (b, b, b))]
forall a. [a] -> [a]
tail [(Node, (b, b, b))]
augLPath))
    augPath :: Path
augPath     = ((Node, (b, b, b)) -> Node) -> [(Node, (b, b, b))] -> Path
forall a b. (a -> b) -> [a] -> [b]
map (Node, (b, b, b)) -> Node
forall a b. (a, b) -> a
fst [(Node, (b, b, b))]
augLPath
    LP [(Node, (b, b, b))]
augLPath = Node -> Node -> gr a (b, b, b) -> LPath (b, b, b)
forall (gr :: * -> * -> *) a b.
Graph gr =>
Node -> Node -> gr a b -> LPath b
lesp Node
s Node
t gr a (b, b, b)
gf
    gf :: gr a (b, b, b)
gf          = ((b, b, b) -> Bool) -> gr a (b, b, b) -> gr a (b, b, b)
forall (gr :: * -> * -> *) b a.
DynGraph gr =>
(b -> Bool) -> gr a b -> gr a b
elfilter (\(b
_,b
_,b
z)->b
zb -> b -> Bool
forall a. Eq a => a -> a -> Bool
/=b
0) gr a (b, b, b)
g

-- | Compute the flow from s to t on a graph whose edges are labeled with
--   @x@, which is the max capacity and where not all edges need to be
--   of the form a\<---->b. Return the flow as a graph whose edges are
--   labeled with (x,y,z)=(max capacity,current flow,residual
--   capacity) and all edges are of the form a\<---->b
mf :: (DynGraph gr, Num b, Ord b) => gr a b -> Node -> Node -> gr a (b,b,b)
mf :: gr a b -> Node -> Node -> gr a (b, b, b)
mf gr a b
g = gr a (b, b, b) -> Node -> Node -> gr a (b, b, b)
forall (gr :: * -> * -> *) b a.
(DynGraph gr, Num b, Ord b) =>
gr a (b, b, b) -> Node -> Node -> gr a (b, b, b)
mfmg (gr a b -> gr a (b, b, b)
forall (gr :: * -> * -> *) b a.
(DynGraph gr, Num b) =>
gr a b -> gr a (b, b, b)
augmentGraph gr a b
g)

-- | Compute the maximum flow from s to t on a graph whose edges are labeled
--   with x, which is the max capacity and where not all edges need to
--   be of the form a\<---->b. Return the flow as a graph whose edges
--   are labeled with (y,x) = (current flow, max capacity).
maxFlowgraph :: (DynGraph gr, Num b, Ord b) => gr a b -> Node -> Node -> gr a (b,b)
maxFlowgraph :: gr a b -> Node -> Node -> gr a (b, b)
maxFlowgraph gr a b
g Node
s Node
t = ((b, b, b) -> (b, b)) -> gr a (b, b, b) -> gr a (b, b)
forall (gr :: * -> * -> *) b c a.
DynGraph gr =>
(b -> c) -> gr a b -> gr a c
emap (\(b
u,b
v,b
_)->(b
v,b
u))
                     (gr a (b, b, b) -> gr a (b, b))
-> (gr a (b, b, b) -> gr a (b, b, b))
-> gr a (b, b, b)
-> gr a (b, b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((b, b, b) -> Bool) -> gr a (b, b, b) -> gr a (b, b, b)
forall (gr :: * -> * -> *) b a.
DynGraph gr =>
(b -> Bool) -> gr a b -> gr a b
elfilter (\(b
x,b
_,b
_) -> b
xb -> b -> Bool
forall a. Eq a => a -> a -> Bool
/=b
0 )
                     (gr a (b, b, b) -> gr a (b, b)) -> gr a (b, b, b) -> gr a (b, b)
forall a b. (a -> b) -> a -> b
$ gr a b -> Node -> Node -> gr a (b, b, b)
forall (gr :: * -> * -> *) b a.
(DynGraph gr, Num b, Ord b) =>
gr a b -> Node -> Node -> gr a (b, b, b)
mf gr a b
g Node
s Node
t

-- | Compute the value of a maximumflow
maxFlow :: (DynGraph gr, Num b, Ord b) => gr a b -> Node -> Node -> b
maxFlow :: gr a b -> Node -> Node -> b
maxFlow gr a b
g Node
s Node
t = [b] -> b
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((LEdge (b, b) -> b) -> [LEdge (b, b)] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map ((b, b) -> b
forall a b. (a, b) -> a
fst ((b, b) -> b) -> (LEdge (b, b) -> (b, b)) -> LEdge (b, b) -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LEdge (b, b) -> (b, b)
forall b. LEdge b -> b
edgeLabel) (gr a (b, b) -> Node -> [LEdge (b, b)]
forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Node -> [LEdge b]
out (gr a b -> Node -> Node -> gr a (b, b)
forall (gr :: * -> * -> *) b a.
(DynGraph gr, Num b, Ord b) =>
gr a b -> Node -> Node -> gr a (b, b)
maxFlowgraph gr a b
g Node
s Node
t) Node
s))

------------------------------------------------------------------------------
-- Some test cases: clr595 is from the CLR textbook, page 595. The value of
-- the maximum flow for s=1 and t=6 (23) coincides with the example but the
-- flow itself is slightly different since the textbook does not compute the
-- shortest augmenting path from s to t, but just any path. However remember
-- that for a given flow graph the maximum flow is not unique.
-- (gr595 is defined in GraphData.hs)
------------------------------------------------------------------------------