-- | 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 :: forall b. Num b => [Edge] -> [LEdge b]
getRevEdges [] = []
getRevEdges ((Int
u,Int
v):[Edge]
es) | (Int
v,Int
u) Edge -> [Edge] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Edge]
es = (Int
v,Int
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 (Int
v,Int
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 :: forall (gr :: * -> * -> *) b a.
(DynGraph gr, Num b) =>
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 :: forall b.
Num b =>
Adj (b, b, b) -> Int -> b -> Bool -> Adj (b, b, b)
updAdjList Adj (b, b, b)
s Int
v b
cf Bool
fwd =
  case (((b, b, b), Int) -> Bool)
-> Adj (b, b, b) -> (Adj (b, b, b), Adj (b, b, b))
forall a. (a -> Bool) -> [a] -> ([a], [a])
break ((Int
vInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==) (Int -> Bool)
-> (((b, b, b), Int) -> Int) -> ((b, b, b), Int) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((b, b, b), Int) -> Int
forall a b. (a, b) -> b
snd) Adj (b, b, b)
s of
    (Adj (b, b, b)
rs, ((b
x,b
y,b
z),Int
w):Adj (b, b, b)
rs') -> 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'),Int
w) ((b, b, b), Int) -> Adj (b, b, b) -> Adj (b, b, b)
forall a. a -> [a] -> [a]
: Adj (b, b, b)
rs'
    (Adj (b, b, b), Adj (b, b, b))
_ -> [Char] -> Adj (b, b, b)
forall a. HasCallStack => [Char] -> a
error [Char]
"updAdjList: invalid node"
  where
    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 :: forall (gr :: * -> * -> *) b a.
(DynGraph gr, Num b) =>
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 [Int
_]       b
_ gr a (b, b, b)
g = gr a (b, b, b)
g
updateFlow (Int
u:Int
v:Path
vs) b
cf gr a (b, b, b)
g = case Int -> gr a (b, b, b) -> Decomp gr a (b, b, b)
forall a b. Int -> gr a b -> Decomp gr a b
forall (gr :: * -> * -> *) a b.
Graph gr =>
Int -> gr a b -> Decomp gr a b
match Int
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,Int
u',a
l,Adj (b, b, b)
s),gr a (b, b, b)
g') -> (Adj (b, b, b)
p',Int
u',a
l,Adj (b, b, b)
s') Context a (b, b, b) -> gr a (b, b, b) -> gr a (b, b, b)
forall a b. Context a b -> gr a b -> gr a 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 (Int
vInt -> 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) -> Int -> b -> Bool -> Adj (b, b, b)
forall b.
Num b =>
Adj (b, b, b) -> Int -> b -> Bool -> Adj (b, b, b)
updAdjList Adj (b, b, b)
s Int
v b
cf Bool
True
                                 p' :: Adj (b, b, b)
p' = Adj (b, b, b) -> Int -> b -> Bool -> Adj (b, b, b)
forall b.
Num b =>
Adj (b, b, b) -> Int -> b -> Bool -> Adj (b, b, b)
updAdjList Adj (b, b, b)
p Int
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 :: forall (gr :: * -> * -> *) b a.
(DynGraph gr, Num b, Ord b) =>
gr a (b, b, b) -> Int -> Int -> gr a (b, b, b)
mfmg gr a (b, b, b)
g Int
s Int
t
  | Path -> Bool
forall a. [a] -> 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) -> Int -> Int -> gr a (b, b, b)
forall (gr :: * -> * -> *) b a.
(DynGraph gr, Num b, Ord b) =>
gr a (b, b, b) -> Int -> Int -> 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) Int
s Int
t
  where
    minC :: b
minC        = [b] -> b
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum (((Int, (b, b, b)) -> b) -> [(Int, (b, b, b))] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map ((\(b
_,b
_,b
z)->b
z)((b, b, b) -> b)
-> ((Int, (b, b, b)) -> (b, b, b)) -> (Int, (b, b, b)) -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int, (b, b, b)) -> (b, b, b)
forall a b. (a, b) -> b
snd)([(Int, (b, b, b))] -> [(Int, (b, b, b))]
forall a. HasCallStack => [a] -> [a]
tail [(Int, (b, b, b))]
augLPath))
    augPath :: Path
augPath     = ((Int, (b, b, b)) -> Int) -> [(Int, (b, b, b))] -> Path
forall a b. (a -> b) -> [a] -> [b]
map (Int, (b, b, b)) -> Int
forall a b. (a, b) -> a
fst [(Int, (b, b, b))]
augLPath
    LP [(Int, (b, b, b))]
augLPath = Int -> Int -> gr a (b, b, b) -> LPath (b, b, b)
forall (gr :: * -> * -> *) a b.
Graph gr =>
Int -> Int -> gr a b -> LPath b
lesp Int
s Int
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 :: forall (gr :: * -> * -> *) b a.
(DynGraph gr, Num b, Ord b) =>
gr a b -> Int -> Int -> gr a (b, b, b)
mf gr a b
g = gr a (b, b, b) -> Int -> Int -> gr a (b, b, b)
forall (gr :: * -> * -> *) b a.
(DynGraph gr, Num b, Ord b) =>
gr a (b, b, b) -> Int -> Int -> 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 :: forall (gr :: * -> * -> *) b a.
(DynGraph gr, Num b, Ord b) =>
gr a b -> Int -> Int -> gr a (b, b)
maxFlowgraph gr a b
g Int
s Int
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 -> Int -> Int -> gr a (b, b, b)
forall (gr :: * -> * -> *) b a.
(DynGraph gr, Num b, Ord b) =>
gr a b -> Int -> Int -> gr a (b, b, b)
mf gr a b
g Int
s Int
t

-- | Compute the value of a maximumflow
maxFlow :: (DynGraph gr, Num b, Ord b) => gr a b -> Node -> Node -> b
maxFlow :: forall (gr :: * -> * -> *) b a.
(DynGraph gr, Num b, Ord b) =>
gr a b -> Int -> Int -> b
maxFlow gr a b
g Int
s Int
t = [b] -> b
forall a. Num a => [a] -> a
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) -> Int -> [LEdge (b, b)]
forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Int -> [LEdge b]
out (gr a b -> Int -> Int -> gr a (b, b)
forall (gr :: * -> * -> *) b a.
(DynGraph gr, Num b, Ord b) =>
gr a b -> Int -> Int -> gr a (b, b)
maxFlowgraph gr a b
g Int
s Int
t) Int
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)
------------------------------------------------------------------------------