-- | Alternative Maximum Flow
module Data.Graph.Inductive.Query.MaxFlow2(
    Network,
    ekSimple, ekFused, ekList,
) where

--   ekSimple, ekFused, ekList) where


import Data.Maybe

import Data.Graph.Inductive.Graph
import Data.Graph.Inductive.Internal.Queue
import Data.Graph.Inductive.PatriciaTree
import Data.Graph.Inductive.Query.BFS      (bft)

import           Data.Set (Set)
import qualified Data.Set as S

------------------------------------------------------------------------------
-- Data types

-- Network data type
type Network = Gr () (Double, Double)

-- Data type for direction in which an edge is traversed
data Direction = Forward | Backward
    deriving (Direction -> Direction -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Direction -> Direction -> Bool
$c/= :: Direction -> Direction -> Bool
== :: Direction -> Direction -> Bool
$c== :: Direction -> Direction -> Bool
Eq, Eq Direction
Direction -> Direction -> Bool
Direction -> Direction -> Ordering
Direction -> Direction -> Direction
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Direction -> Direction -> Direction
$cmin :: Direction -> Direction -> Direction
max :: Direction -> Direction -> Direction
$cmax :: Direction -> Direction -> Direction
>= :: Direction -> Direction -> Bool
$c>= :: Direction -> Direction -> Bool
> :: Direction -> Direction -> Bool
$c> :: Direction -> Direction -> Bool
<= :: Direction -> Direction -> Bool
$c<= :: Direction -> Direction -> Bool
< :: Direction -> Direction -> Bool
$c< :: Direction -> Direction -> Bool
compare :: Direction -> Direction -> Ordering
$ccompare :: Direction -> Direction -> Ordering
Ord, Node -> Direction -> ShowS
[Direction] -> ShowS
Direction -> String
forall a.
(Node -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Direction] -> ShowS
$cshowList :: [Direction] -> ShowS
show :: Direction -> String
$cshow :: Direction -> String
showsPrec :: Node -> Direction -> ShowS
$cshowsPrec :: Node -> Direction -> ShowS
Show, ReadPrec [Direction]
ReadPrec Direction
Node -> ReadS Direction
ReadS [Direction]
forall a.
(Node -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Direction]
$creadListPrec :: ReadPrec [Direction]
readPrec :: ReadPrec Direction
$creadPrec :: ReadPrec Direction
readList :: ReadS [Direction]
$creadList :: ReadS [Direction]
readsPrec :: Node -> ReadS Direction
$creadsPrec :: Node -> ReadS Direction
Read)

-- Data type for edge with direction of traversal
type DirEdge b = (Node, Node, b, Direction)

type DirPath=[(Node, Direction)]
type DirRTree=[DirPath]

pathFromDirPath :: DirPath -> [Node]
pathFromDirPath :: DirPath -> [Node]
pathFromDirPath = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst

------------------------------------------------------------------------------
-- Example networks

-- Example number 1
-- This network has a maximum flow of 2000
{-
exampleNetwork1 :: Network
exampleNetwork1=mkGraph [ (1,()), (2,()), (3,()), (4,()) ]
    [ (1,2,(1000,0)), (1,3,(1000,0)),
    (2,3,(1,0)), (2,4,(1000,0)), (3,4,(1000,0)) ]

-- Example number 2
-- Taken from "Introduction to Algorithms" (Cormen, Leiserson, Rivest)
-- This network has a maximum flow of 23
exampleNetwork2 :: Network
-- Names of nodes in "Introduction to Algorithms":
-- 1: s
-- 2: v1
-- 3: v2
-- 4: v3
-- 5: v4
-- 6: t
exampleNetwork2=mkGraph [ (1,()), (2,()), (3,()), (4,()), (5,()), (6,()) ]
    [ (1, 2, (16, 0)),
    (1, 3, (13, 0)),
    (2, 3, (10, 0)),
    (3, 2, (4, 0)),
    (2, 4, (12, 0)),
    (3, 5, (14, 0)),
    (4, 3, (9, 0)),
    (5, 4, (7, 0)),
    (4, 6, (20, 0)),
    (5, 6, (4, 0)) ]
-}
------------------------------------------------------------------------------
-- Implementation of Edmonds-Karp algorithm

-- EXTRACT fglEdmondsFused.txt
-- Compute an augmenting path
augPathFused :: Network -> Node -> Node -> Maybe DirPath
augPathFused :: Network -> Node -> Node -> Maybe DirPath
augPathFused Network
g Node
s Node
t = forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$
    forall a. (a -> Bool) -> [a] -> [a]
filter (\((Node
u,Direction
_):DirPath
_) -> Node
uforall a. Eq a => a -> a -> Bool
==Node
t) [DirPath]
tree
    where tree :: [DirPath]
tree = Node -> Network -> [DirPath]
bftForEK Node
s Network
g

-- Breadth First Search wrapper function
bftForEK :: Node -> Network -> DirRTree
bftForEK :: Node -> Network -> [DirPath]
bftForEK Node
v = Queue DirPath -> Network -> [DirPath]
bfForEK (forall a. a -> Queue a -> Queue a
queuePut [(Node
v,Direction
Forward)] forall a. Queue a
mkQueue)

-- Breadth First Search, tailored for Edmonds & Karp
bfForEK :: Queue DirPath -> Network -> DirRTree
bfForEK :: Queue DirPath -> Network -> [DirPath]
bfForEK Queue DirPath
q Network
g
    | forall a. Queue a -> Bool
queueEmpty Queue DirPath
q Bool -> Bool -> Bool
|| forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Bool
isEmpty Network
g = []
    | Bool
otherwise                 = case forall (gr :: * -> * -> *) a b.
Graph gr =>
Node -> gr a b -> Decomp gr a b
match Node
v Network
g of
        (MContext () (Double, Double)
Nothing, Network
g')                     -> Queue DirPath -> Network -> [DirPath]
bfForEK Queue DirPath
q1 Network
g'
        (Just (Adj (Double, Double)
preAdj, Node
_, ()
_, Adj (Double, Double)
sucAdj), Network
g') -> DirPath
pforall a. a -> [a] -> [a]
:Queue DirPath -> Network -> [DirPath]
bfForEK Queue DirPath
q2 Network
g'
            where
                -- Insert successor nodes (with path to root) into queue
                q2 :: Queue DirPath
q2   = forall a. [a] -> Queue a -> Queue a
queuePutList [DirPath]
suc1 forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Queue a -> Queue a
queuePutList [DirPath]
suc2 Queue DirPath
q1
                -- Traverse edges in reverse if flow positive
                suc1 :: [DirPath]
suc1 = [ (Node
preNode, Direction
Backward)forall a. a -> [a] -> [a]
:DirPath
p
                    | ((Double
_, Double
f), Node
preNode) <- Adj (Double, Double)
preAdj, Double
fforall a. Ord a => a -> a -> Bool
>Double
0]
                -- Traverse edges forwards if flow less than capacity
                suc2 :: [DirPath]
suc2 = [ (Node
sucNode,Direction
Forward)forall a. a -> [a] -> [a]
:DirPath
p
                    | ((Double
c, Double
f), Node
sucNode) <- Adj (Double, Double)
sucAdj, Double
cforall a. Ord a => a -> a -> Bool
>Double
f]
    where (p :: DirPath
p@((Node
v,Direction
_):DirPath
_), Queue DirPath
q1)=forall a. Queue a -> (a, Queue a)
queueGet Queue DirPath
q

-- Extract augmenting path from network; return path as a sequence of
-- edges with direction of traversal, and new network with augmenting
-- path removed.
extractPathFused :: Network -> DirPath
    -> ([DirEdge (Double,Double)], Network)
extractPathFused :: Network -> DirPath -> ([DirEdge (Double, Double)], Network)
extractPathFused Network
g []  = ([], Network
g)
extractPathFused Network
g [(Node
_,Direction
_)] = ([], Network
g)
extractPathFused Network
g ((Node
u,Direction
_):rest :: DirPath
rest@((Node
v,Direction
Forward):DirPath
_)) =
    ((Node
u, Node
v, (Double, Double)
l, Direction
Forward)forall a. a -> [a] -> [a]
:[DirEdge (Double, Double)]
tailedges, Network
newerg)
        where ([DirEdge (Double, Double)]
tailedges, Network
newerg) = Network -> DirPath -> ([DirEdge (Double, Double)], Network)
extractPathFused Network
newg DirPath
rest
              Just ((Double, Double)
l, Network
newg)    = forall a b.
Gr a b -> Node -> Node -> (b -> Bool) -> Maybe (b, Gr a b)
extractEdge Network
g Node
u Node
v (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Ord a => a -> a -> Bool
(>))
extractPathFused Network
g ((Node
u,Direction
_):rest :: DirPath
rest@((Node
v,Direction
Backward):DirPath
_)) =
    ((Node
v, Node
u, (Double, Double)
l, Direction
Backward)forall a. a -> [a] -> [a]
:[DirEdge (Double, Double)]
tailedges, Network
newerg)
        where ([DirEdge (Double, Double)]
tailedges, Network
newerg) = Network -> DirPath -> ([DirEdge (Double, Double)], Network)
extractPathFused Network
newg DirPath
rest
              Just ((Double, Double)
l, Network
newg)    = forall a b.
Gr a b -> Node -> Node -> (b -> Bool) -> Maybe (b, Gr a b)
extractEdge Network
g Node
v Node
u (\(Double
_,Double
f)->(Double
fforall a. Ord a => a -> a -> Bool
>Double
0))

ekFusedStep :: EKStepFunc
ekFusedStep :: EKStepFunc
ekFusedStep Network
g Node
s Node
t = case Maybe DirPath
maybePath of
        Just DirPath
_          ->
            forall a. a -> Maybe a
Just (forall (gr :: * -> * -> *) b a.
DynGraph gr =>
[LEdge b] -> gr a b -> gr a b
insEdges ([DirEdge (Double, Double)] -> Double -> [LEdge (Double, Double)]
integrateDelta [DirEdge (Double, Double)]
es Double
delta) Network
newg, Double
delta)
        Maybe DirPath
Nothing   -> forall a. Maybe a
Nothing
    where maybePath :: Maybe DirPath
maybePath     = Network -> Node -> Node -> Maybe DirPath
augPathFused Network
g Node
s Node
t
          ([DirEdge (Double, Double)]
es, Network
newg) = Network -> DirPath -> ([DirEdge (Double, Double)], Network)
extractPathFused Network
g (forall a. HasCallStack => Maybe a -> a
fromJust Maybe DirPath
maybePath)
          delta :: Double
delta         = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum forall a b. (a -> b) -> a -> b
$ [DirEdge (Double, Double)] -> [Double]
getPathDeltas [DirEdge (Double, Double)]
es

ekFused :: Network -> Node -> Node -> (Network, Double)
ekFused :: Network -> Node -> Node -> (Network, Double)
ekFused = EKStepFunc -> Network -> Node -> Node -> (Network, Double)
ekWith EKStepFunc
ekFusedStep
-- ENDEXTRACT

-----------------------------------------------------------------------------
-- Alternative implementation: Use an explicit residual graph

-- EXTRACT fglEdmondsSimple.txt
residualGraph :: Network -> Gr () Double
residualGraph :: Network -> Gr () Double
residualGraph Network
g =
    forall (gr :: * -> * -> *) a b.
Graph gr =>
[LNode a] -> [LEdge b] -> gr a b
mkGraph (forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LNode a]
labNodes Network
g)
        ([(Node
u, Node
v, Double
cforall a. Num a => a -> a -> a
-Double
f) | (Node
u, Node
v, (Double
c,Double
f)) <- forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LEdge b]
labEdges Network
g, Double
cforall a. Ord a => a -> a -> Bool
>Double
f ] forall a. [a] -> [a] -> [a]
++
         [(Node
v, Node
u, Double
f) | (Node
u,Node
v,(Double
_,Double
f)) <- forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LEdge b]
labEdges Network
g, Double
fforall a. Ord a => a -> a -> Bool
>Double
0])

augPath :: Network -> Node -> Node -> Maybe Path
augPath :: Network -> Node -> Node -> Maybe [Node]
augPath Network
g Node
s Node
t = forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (\(Node
u:[Node]
_) -> Node
uforall a. Eq a => a -> a -> Bool
==Node
t) [[Node]]
tree
    where tree :: [[Node]]
tree = forall (gr :: * -> * -> *) a b.
Graph gr =>
Node -> gr a b -> [[Node]]
bft Node
s (Network -> Gr () Double
residualGraph Network
g)

-- Extract augmenting path from network; return path as a sequence of
-- edges with direction of traversal, and new network with augmenting
-- path removed.
extractPath :: Network -> Path -> ([DirEdge (Double,Double)], Network)
extractPath :: Network -> [Node] -> ([DirEdge (Double, Double)], Network)
extractPath Network
g []  = ([], Network
g)
extractPath Network
g [Node
_] = ([], Network
g)
extractPath Network
g (Node
u:Node
v:[Node]
ws) =
    case Maybe ((Double, Double), Network)
fwdExtract of
        Just ((Double, Double)
l, Network
newg) -> ((Node
u, Node
v, (Double, Double)
l, Direction
Forward)forall a. a -> [a] -> [a]
:[DirEdge (Double, Double)]
tailedges, Network
newerg)
            where ([DirEdge (Double, Double)]
tailedges, Network
newerg) = Network -> [Node] -> ([DirEdge (Double, Double)], Network)
extractPath Network
newg (Node
vforall a. a -> [a] -> [a]
:[Node]
ws)
        Maybe ((Double, Double), Network)
Nothing          ->
            case Maybe ((Double, Double), Network)
revExtract of
                Just ((Double, Double)
l, Network
newg) ->
                    ((Node
v, Node
u, (Double, Double)
l, Direction
Backward)forall a. a -> [a] -> [a]
:[DirEdge (Double, Double)]
tailedges, Network
newerg)
                    where ([DirEdge (Double, Double)]
tailedges, Network
newerg) = Network -> [Node] -> ([DirEdge (Double, Double)], Network)
extractPath Network
newg (Node
vforall a. a -> [a] -> [a]
:[Node]
ws)
                Maybe ((Double, Double), Network)
Nothing               -> forall a. HasCallStack => String -> a
error String
"extractPath: revExtract == Nothing"
    where fwdExtract :: Maybe ((Double, Double), Network)
fwdExtract = forall a b.
Gr a b -> Node -> Node -> (b -> Bool) -> Maybe (b, Gr a b)
extractEdge Network
g Node
u Node
v (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Ord a => a -> a -> Bool
(>))
          revExtract :: Maybe ((Double, Double), Network)
revExtract = forall a b.
Gr a b -> Node -> Node -> (b -> Bool) -> Maybe (b, Gr a b)
extractEdge Network
g Node
v Node
u ((forall a. Ord a => a -> a -> Bool
>Double
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)

-- Extract an edge from the graph that satisfies a given predicate
-- Return the label on the edge and the graph without the edge
extractEdge :: Gr a b -> Node -> Node -> (b->Bool) -> Maybe (b, Gr a b)
extractEdge :: forall a b.
Gr a b -> Node -> Node -> (b -> Bool) -> Maybe (b, Gr a b)
extractEdge Gr a b
g Node
u Node
v b -> Bool
p =
    case Maybe (b, Node)
adj of
        Just (b
el, Node
_) -> forall a. a -> Maybe a
Just (b
el, (Adj b
p', Node
node, a
l, Adj b
rest) forall (gr :: * -> * -> *) a b.
DynGraph gr =>
Context a b -> gr a b -> gr a b
& Gr a b
newg)
        Maybe (b, Node)
Nothing      -> forall a. Maybe a
Nothing
    where (Just (Adj b
p', Node
node, a
l, Adj b
s), Gr a b
newg) = forall (gr :: * -> * -> *) a b.
Graph gr =>
Node -> gr a b -> Decomp gr a b
match Node
u Gr a b
g
          (Maybe (b, Node)
adj, Adj b
rest)=forall b. Adj b -> ((b, Node) -> Bool) -> (Maybe (b, Node), Adj b)
extractAdj Adj b
s
              (\(b
l', Node
dest) -> Node
destforall a. Eq a => a -> a -> Bool
==Node
v Bool -> Bool -> Bool
&& b -> Bool
p b
l')

-- Extract an item from an adjacency list that satisfies a given
-- predicate. Return the item and the rest of the adjacency list
extractAdj :: Adj b -> ((b,Node)->Bool) -> (Maybe (b,Node), Adj b)
extractAdj :: forall b. Adj b -> ((b, Node) -> Bool) -> (Maybe (b, Node), Adj b)
extractAdj []         (b, Node) -> Bool
_ = (forall a. Maybe a
Nothing, [])
extractAdj ((b, Node)
adj:[(b, Node)]
adjs) (b, Node) -> Bool
p
    | (b, Node) -> Bool
p (b, Node)
adj     = (forall a. a -> Maybe a
Just (b, Node)
adj, [(b, Node)]
adjs)
    | Bool
otherwise = (Maybe (b, Node)
theone, (b, Node)
adjforall a. a -> [a] -> [a]
:[(b, Node)]
rest)
        where (Maybe (b, Node)
theone, [(b, Node)]
rest)=forall b. Adj b -> ((b, Node) -> Bool) -> (Maybe (b, Node), Adj b)
extractAdj [(b, Node)]
adjs (b, Node) -> Bool
p

getPathDeltas :: [DirEdge (Double,Double)] -> [Double]
getPathDeltas :: [DirEdge (Double, Double)] -> [Double]
getPathDeltas []     = []
getPathDeltas (DirEdge (Double, Double)
e:[DirEdge (Double, Double)]
es) = case DirEdge (Double, Double)
e of
    (Node
_, Node
_, (Double
c,Double
f), Direction
Forward)  -> Double
cforall a. Num a => a -> a -> a
-Double
f forall a. a -> [a] -> [a]
: [DirEdge (Double, Double)] -> [Double]
getPathDeltas [DirEdge (Double, Double)]
es
    (Node
_, Node
_, (Double
_,Double
f), Direction
Backward) -> Double
f forall a. a -> [a] -> [a]
: [DirEdge (Double, Double)] -> [Double]
getPathDeltas [DirEdge (Double, Double)]
es

integrateDelta :: [DirEdge (Double,Double)] -> Double
    -> [LEdge (Double, Double)]
integrateDelta :: [DirEdge (Double, Double)] -> Double -> [LEdge (Double, Double)]
integrateDelta []          Double
_ = []
integrateDelta (DirEdge (Double, Double)
e:[DirEdge (Double, Double)]
es) Double
delta = case DirEdge (Double, Double)
e of
    (Node
u, Node
v, (Double
c, Double
f), Direction
Forward) ->
        (Node
u, Node
v, (Double
c, Double
fforall a. Num a => a -> a -> a
+Double
delta)) forall a. a -> [a] -> [a]
: [DirEdge (Double, Double)] -> Double -> [LEdge (Double, Double)]
integrateDelta [DirEdge (Double, Double)]
es Double
delta
    (Node
u, Node
v, (Double
c, Double
f), Direction
Backward) ->
        (Node
u, Node
v, (Double
c, Double
fforall a. Num a => a -> a -> a
-Double
delta)) forall a. a -> [a] -> [a]
: [DirEdge (Double, Double)] -> Double -> [LEdge (Double, Double)]
integrateDelta [DirEdge (Double, Double)]
es Double
delta

type EKStepFunc = Network -> Node -> Node -> Maybe (Network, Double)

ekSimpleStep :: EKStepFunc
ekSimpleStep :: EKStepFunc
ekSimpleStep Network
g Node
s Node
t = case Maybe [Node]
maybePath of
        Just [Node]
_ ->
            forall a. a -> Maybe a
Just (forall (gr :: * -> * -> *) b a.
DynGraph gr =>
[LEdge b] -> gr a b -> gr a b
insEdges ([DirEdge (Double, Double)] -> Double -> [LEdge (Double, Double)]
integrateDelta [DirEdge (Double, Double)]
es Double
delta) Network
newg, Double
delta)
        Maybe [Node]
Nothing   -> forall a. Maybe a
Nothing
    where maybePath :: Maybe [Node]
maybePath  = Network -> Node -> Node -> Maybe [Node]
augPath Network
g Node
s Node
t
          ([DirEdge (Double, Double)]
es, Network
newg) = Network -> [Node] -> ([DirEdge (Double, Double)], Network)
extractPath Network
g (forall a. HasCallStack => Maybe a -> a
fromJust Maybe [Node]
maybePath)
          delta :: Double
delta      = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum forall a b. (a -> b) -> a -> b
$ [DirEdge (Double, Double)] -> [Double]
getPathDeltas [DirEdge (Double, Double)]
es

ekWith :: EKStepFunc -> Network -> Node -> Node -> (Network, Double)
ekWith :: EKStepFunc -> Network -> Node -> Node -> (Network, Double)
ekWith EKStepFunc
stepfunc Network
g Node
s Node
t = case EKStepFunc
stepfunc Network
g Node
s Node
t of
    Just (Network
newg, Double
delta) -> (Network
finalg, Double
capacityforall a. Num a => a -> a -> a
+Double
delta)
        where (Network
finalg, Double
capacity) = EKStepFunc -> Network -> Node -> Node -> (Network, Double)
ekWith EKStepFunc
stepfunc Network
newg Node
s Node
t
    Maybe (Network, Double)
Nothing            -> (Network
g, Double
0)

ekSimple :: Network -> Node -> Node -> (Network, Double)
ekSimple :: Network -> Node -> Node -> (Network, Double)
ekSimple = EKStepFunc -> Network -> Node -> Node -> (Network, Double)
ekWith EKStepFunc
ekSimpleStep
-- ENDEXTRACT

-----------------------------------------------------------------------------
-- Alternative implementation: Process list of edges to extract path instead
-- of operating on graph structure

extractPathList :: [LEdge (Double, Double)] -> Set (Node,Node)
    -> ([DirEdge (Double, Double)], [LEdge (Double, Double)])
extractPathList :: [LEdge (Double, Double)]
-> Set (Node, Node)
-> ([DirEdge (Double, Double)], [LEdge (Double, Double)])
extractPathList []                 Set (Node, Node)
_ = ([], [])
extractPathList (edge :: LEdge (Double, Double)
edge@(Node
u,Node
v,l :: (Double, Double)
l@(Double
c,Double
f)):[LEdge (Double, Double)]
es) Set (Node, Node)
set
    | (Double
cforall a. Ord a => a -> a -> Bool
>Double
f) Bool -> Bool -> Bool
&& forall a. Ord a => a -> Set a -> Bool
S.member (Node
u,Node
v) Set (Node, Node)
set =
        let ([DirEdge (Double, Double)]
pathrest, [LEdge (Double, Double)]
notrest)=[LEdge (Double, Double)]
-> Set (Node, Node)
-> ([DirEdge (Double, Double)], [LEdge (Double, Double)])
extractPathList [LEdge (Double, Double)]
es (forall a. Ord a => a -> Set a -> Set a
S.delete (Node
u,Node
v) Set (Node, Node)
set)
            in ((Node
u,Node
v,(Double, Double)
l,Direction
Forward)forall a. a -> [a] -> [a]
:[DirEdge (Double, Double)]
pathrest, [LEdge (Double, Double)]
notrest)
    | (Double
fforall a. Ord a => a -> a -> Bool
>Double
0) Bool -> Bool -> Bool
&& forall a. Ord a => a -> Set a -> Bool
S.member (Node
v,Node
u) Set (Node, Node)
set =
        let ([DirEdge (Double, Double)]
pathrest, [LEdge (Double, Double)]
notrest)=[LEdge (Double, Double)]
-> Set (Node, Node)
-> ([DirEdge (Double, Double)], [LEdge (Double, Double)])
extractPathList [LEdge (Double, Double)]
es (forall a. Ord a => a -> Set a -> Set a
S.delete (Node
u,Node
v) Set (Node, Node)
set)
            in ((Node
u,Node
v,(Double, Double)
l,Direction
Backward)forall a. a -> [a] -> [a]
:[DirEdge (Double, Double)]
pathrest, [LEdge (Double, Double)]
notrest)
    | Bool
otherwise                        =
        let ([DirEdge (Double, Double)]
pathrest, [LEdge (Double, Double)]
notrest)=[LEdge (Double, Double)]
-> Set (Node, Node)
-> ([DirEdge (Double, Double)], [LEdge (Double, Double)])
extractPathList [LEdge (Double, Double)]
es Set (Node, Node)
set in
            ([DirEdge (Double, Double)]
pathrest, LEdge (Double, Double)
edgeforall a. a -> [a] -> [a]
:[LEdge (Double, Double)]
notrest)

ekStepList :: EKStepFunc
ekStepList :: EKStepFunc
ekStepList Network
g Node
s Node
t = case Maybe DirPath
maybePath of
        Just DirPath
_  -> forall a. a -> Maybe a
Just (forall (gr :: * -> * -> *) a b.
Graph gr =>
[LNode a] -> [LEdge b] -> gr a b
mkGraph (forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LNode a]
labNodes Network
g) [LEdge (Double, Double)]
newEdges, Double
delta)
        Maybe DirPath
Nothing -> forall a. Maybe a
Nothing
    where newEdges :: [LEdge (Double, Double)]
newEdges      = [DirEdge (Double, Double)] -> Double -> [LEdge (Double, Double)]
integrateDelta [DirEdge (Double, Double)]
es Double
delta forall a. [a] -> [a] -> [a]
++ [LEdge (Double, Double)]
otheredges
          maybePath :: Maybe DirPath
maybePath     = Network -> Node -> Node -> Maybe DirPath
augPathFused Network
g Node
s Node
t
          ([DirEdge (Double, Double)]
es, [LEdge (Double, Double)]
otheredges) = [LEdge (Double, Double)]
-> Set (Node, Node)
-> ([DirEdge (Double, Double)], [LEdge (Double, Double)])
extractPathList (forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LEdge b]
labEdges Network
g)
              (forall a. Ord a => [a] -> Set a
S.fromList (forall a b. [a] -> [b] -> [(a, b)]
zip [Node]
justPath (forall a. [a] -> [a]
tail [Node]
justPath)))
          delta :: Double
delta         = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum forall a b. (a -> b) -> a -> b
$ [DirEdge (Double, Double)] -> [Double]
getPathDeltas [DirEdge (Double, Double)]
es
          justPath :: [Node]
justPath      = DirPath -> [Node]
pathFromDirPath (forall a. HasCallStack => Maybe a -> a
fromJust Maybe DirPath
maybePath)

ekList :: Network -> Node -> Node -> (Network, Double)
ekList :: Network -> Node -> Node -> (Network, Double)
ekList = EKStepFunc -> Network -> Node -> Node -> (Network, Double)
ekWith EKStepFunc
ekStepList
-- ENDEXTRACT