-- | 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) forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Edge]
es = (Int
v,Int
u,b
0)forall a. a -> [a] -> [a]
:forall b. Num b => [Edge] -> [LEdge b]
getRevEdges [Edge]
es
                       | Bool
otherwise          = forall b. Num b => [Edge] -> [LEdge b]
getRevEdges (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 = forall (gr :: * -> * -> *) b c a.
DynGraph gr =>
(b -> c) -> gr a b -> gr a c
emap (\b
i->(b
i,b
0,b
i)) (forall (gr :: * -> * -> *) b a.
DynGraph gr =>
[LEdge b] -> gr a b -> gr a b
insEdges (forall b. Num b => [Edge] -> [LEdge b]
getRevEdges (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 = Adj (b, b, b)
rs forall a. [a] -> [a] -> [a]
++ ((b
x,b
yforall a. Num a => a -> a -> a
+b
cf',b
zforall a. Num a => a -> a -> a
-b
cf'),Int
w) forall a. a -> [a] -> [a]
: Adj (b, b, b)
rs'
  where
    (Adj (b, b, b)
rs, ((b
x,b
y,b
z),Int
w):Adj (b, b, b)
rs') = forall a. (a -> Bool) -> [a] -> ([a], [a])
break ((Int
vforall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) Adj (b, b, b)
s

    cf' :: b
cf' = if Bool
fwd
             then b
cf
             else 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 forall (gr :: * -> * -> *) a b.
Graph gr =>
Int -> gr a b -> Decomp gr a b
match Int
u gr a (b, b, b)
g of
                             (MContext 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') 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 = forall (gr :: * -> * -> *) b a.
(DynGraph gr, Num b) =>
Path -> b -> gr a (b, b, b) -> gr a (b, b, b)
updateFlow (Int
vforall a. a -> [a] -> [a]
:Path
vs) b
cf gr a (b, b, b)
g'
                                 s' :: Adj (b, b, b)
s' = 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' = 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
  | forall (t :: * -> *) a. Foldable t => t a -> Bool
null Path
augPath = gr a (b, b, b)
g
  | Bool
otherwise    = forall (gr :: * -> * -> *) b a.
(DynGraph gr, Num b, Ord b) =>
gr a (b, b, b) -> Int -> Int -> gr a (b, b, b)
mfmg (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        = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum (forall a b. (a -> b) -> [a] -> [b]
map ((\(b
_,b
_,b
z)->b
z)forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> b
snd)(forall a. [a] -> [a]
tail [(Int, (b, b, b))]
augLPath))
    augPath :: Path
augPath     = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Int, (b, b, b))]
augLPath
    LP [(Int, (b, b, b))]
augLPath = 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          = forall (gr :: * -> * -> *) b a.
DynGraph gr =>
(b -> Bool) -> gr a b -> gr a b
elfilter (\(b
_,b
_,b
z)->b
zforall 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 = forall (gr :: * -> * -> *) b a.
(DynGraph gr, Num b, Ord b) =>
gr a (b, b, b) -> Int -> Int -> gr a (b, b, b)
mfmg (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 = 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))
                     forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (gr :: * -> * -> *) b a.
DynGraph gr =>
(b -> Bool) -> gr a b -> gr a b
elfilter (\(b
x,b
_,b
_) -> b
xforall a. Eq a => a -> a -> Bool
/=b
0 )
                     forall a b. (a -> b) -> a -> 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 = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b. LEdge b -> b
edgeLabel) (forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Int -> [LEdge b]
out (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)
------------------------------------------------------------------------------