    -- | 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
    (Direction -> Direction -> Bool)
    -> (Direction -> Direction -> Bool) -> Eq Direction
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Direction -> Direction -> Bool
    == :: Direction -> Direction -> Bool
    $c/= :: Direction -> Direction -> Bool
    /= :: Direction -> Direction -> Bool
    Eq, Eq Direction
    Eq Direction
    -> (Direction -> Direction -> Ordering)
    -> (Direction -> Direction -> Bool)
    -> (Direction -> Direction -> Bool)
    -> (Direction -> Direction -> Bool)
    -> (Direction -> Direction -> Bool)
    -> (Direction -> Direction -> Direction)
    -> (Direction -> Direction -> Direction)
    -> Ord 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
    $ccompare :: Direction -> Direction -> Ordering
    compare :: Direction -> Direction -> Ordering
    $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
    >= :: Direction -> Direction -> Bool
    $cmax :: Direction -> Direction -> Direction
    max :: Direction -> Direction -> Direction
    $cmin :: Direction -> Direction -> Direction
    min :: Direction -> Direction -> Direction
    Ord, Node -> Direction -> ShowS
    [Direction] -> ShowS
    Direction -> String
    (Node -> Direction -> ShowS)
    -> (Direction -> String)
    -> ([Direction] -> ShowS)
    -> Show Direction
    forall a.
    (Node -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Node -> Direction -> ShowS
    showsPrec :: Node -> Direction -> ShowS
    $cshow :: Direction -> String
    show :: Direction -> String
    $cshowList :: [Direction] -> ShowS
    showList :: [Direction] -> ShowS
    Show, ReadPrec [Direction]
    ReadPrec Direction
    Node -> ReadS Direction
    ReadS [Direction]
    (Node -> ReadS Direction)
    -> ReadS [Direction]
    -> ReadPrec Direction
    -> ReadPrec [Direction]
    -> Read Direction
    forall a.
    (Node -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: Node -> ReadS Direction
    readsPrec :: Node -> ReadS Direction
    $creadList :: ReadS [Direction]
    readList :: ReadS [Direction]
    $creadPrec :: ReadPrec Direction
    readPrec :: ReadPrec Direction
    $creadListPrec :: ReadPrec [Direction]
    readListPrec :: ReadPrec [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 = ((Node, Direction) -> Node) -> DirPath -> [Node]
    forall a b. (a -> b) -> [a] -> [b]
    map (Node, Direction) -> Node
    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 = [DirPath] -> Maybe DirPath
    forall a. [a] -> Maybe a
    listToMaybe ([DirPath] -> Maybe DirPath) -> [DirPath] -> Maybe DirPath
    forall a b. (a -> b) -> a -> b
    $ (DirPath -> DirPath) -> [DirPath] -> [DirPath]
    forall a b. (a -> b) -> [a] -> [b]
    map DirPath -> DirPath
    forall a. [a] -> [a]
    reverse ([DirPath] -> [DirPath]) -> [DirPath] -> [DirPath]
    forall a b. (a -> b) -> a -> b
    $
        (DirPath -> Bool) -> [DirPath] -> [DirPath]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\((Node
    u,Direction
    _):DirPath
    _) -> Node
    uNode -> Node -> Bool
    forall 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 (DirPath -> Queue DirPath -> Queue DirPath
    forall a. a -> Queue a -> Queue a
    queuePut [(Node
    v,Direction
    Forward)] Queue DirPath
    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
        | Queue DirPath -> Bool
    forall a. Queue a -> Bool
    queueEmpty Queue DirPath
    q Bool -> Bool -> Bool
    || Network -> Bool
    forall a b. Gr a b -> Bool
    forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Bool
    isEmpty Network
    g = []
        | Bool
    otherwise                 = case Node -> Network -> Decomp Gr () (Double, Double)
    forall a b. Node -> Gr a b -> Decomp Gr a b
    forall (gr :: * -> * -> *) a b.
    Graph gr =>
    Node -> gr a b -> Decomp gr a b
    match Node
    v Network
    g of
            (Maybe (Context () (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
    pDirPath -> [DirPath] -> [DirPath]
    forall 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   = [DirPath] -> Queue DirPath -> Queue DirPath
    forall a. [a] -> Queue a -> Queue a
    queuePutList [DirPath]
    suc1 (Queue DirPath -> Queue DirPath) -> Queue DirPath -> Queue DirPath
    forall a b. (a -> b) -> a -> b
    $ [DirPath] -> Queue DirPath -> Queue DirPath
    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)(Node, Direction) -> DirPath -> DirPath
    forall a. a -> [a] -> [a]
    :DirPath
    p
                        | ((Double
    _, Double
    f), Node
    preNode) <- Adj (Double, Double)
    preAdj, Double
    fDouble -> Double -> Bool
    forall a. Ord a => a -> a -> Bool
    >Double
    0]
                    -- Traverse edges forwards if flow less than capacity
                    suc2 :: [DirPath]
    suc2 = [ (Node
    sucNode,Direction
    Forward)(Node, Direction) -> DirPath -> DirPath
    forall a. a -> [a] -> [a]
    :DirPath
    p
                        | ((Double
    c, Double
    f), Node
    sucNode) <- Adj (Double, Double)
    sucAdj, Double
    cDouble -> Double -> Bool
    forall a. Ord a => a -> a -> Bool
    >Double
    f]
        where (p :: DirPath
    p@((Node
    v,Direction
    _):DirPath
    _), Queue DirPath
    q1)=Queue DirPath -> (DirPath, Queue DirPath)
    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)DirEdge (Double, Double)
    -> [DirEdge (Double, Double)] -> [DirEdge (Double, Double)]
    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)    = Network
    -> Node
    -> Node
    -> ((Double, Double) -> Bool)
    -> Maybe ((Double, Double), Network)
    forall a b.
    Gr a b -> Node -> Node -> (b -> Bool) -> Maybe (b, Gr a b)
    extractEdge Network
    g Node
    u Node
    v ((Double -> Double -> Bool) -> (Double, Double) -> Bool
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry Double -> Double -> Bool
    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)DirEdge (Double, Double)
    -> [DirEdge (Double, Double)] -> [DirEdge (Double, Double)]
    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)    = Network
    -> Node
    -> Node
    -> ((Double, Double) -> Bool)
    -> Maybe ((Double, Double), Network)
    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
    fDouble -> Double -> Bool
    forall 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
    _          ->
                (Network, Double) -> Maybe (Network, Double)
    forall a. a -> Maybe a
    Just ([LEdge (Double, Double)] -> Network -> Network
    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   -> Maybe (Network, Double)
    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 (Maybe DirPath -> DirPath
    forall a. HasCallStack => Maybe a -> a
    fromJust Maybe DirPath
    maybePath)
              delta :: Double
    delta         = [Double] -> Double
    forall a. Ord a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    minimum ([Double] -> Double) -> [Double] -> Double
    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 =
        [LNode ()] -> [LEdge Double] -> Gr () Double
    forall a b. [LNode a] -> [LEdge b] -> Gr a b
    forall (gr :: * -> * -> *) a b.
    Graph gr =>
    [LNode a] -> [LEdge b] -> gr a b
    mkGraph (Network -> [LNode ()]
    forall a b. Gr a b -> [LNode a]
    forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LNode a]
    labNodes Network
    g)
            ([(Node
    u, Node
    v, Double
    cDouble -> Double -> Double
    forall a. Num a => a -> a -> a
    -Double
    f) | (Node
    u, Node
    v, (Double
    c,Double
    f)) <- Network -> [LEdge (Double, Double)]
    forall a b. Gr a b -> [LEdge b]
    forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LEdge b]
    labEdges Network
    g, Double
    cDouble -> Double -> Bool
    forall a. Ord a => a -> a -> Bool
    >Double
    f ] [LEdge Double] -> [LEdge Double] -> [LEdge Double]
    forall a. [a] -> [a] -> [a]
    ++
             [(Node
    v, Node
    u, Double
    f) | (Node
    u,Node
    v,(Double
    _,Double
    f)) <- Network -> [LEdge (Double, Double)]
    forall a b. Gr a b -> [LEdge b]
    forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LEdge b]
    labEdges Network
    g, Double
    fDouble -> Double -> Bool
    forall 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 = [[Node]] -> Maybe [Node]
    forall a. [a] -> Maybe a
    listToMaybe ([[Node]] -> Maybe [Node]) -> [[Node]] -> Maybe [Node]
    forall a b. (a -> b) -> a -> b
    $ ([Node] -> [Node]) -> [[Node]] -> [[Node]]
    forall a b. (a -> b) -> [a] -> [b]
    map [Node] -> [Node]
    forall a. [a] -> [a]
    reverse ([[Node]] -> [[Node]]) -> [[Node]] -> [[Node]]
    forall a b. (a -> b) -> a -> b
    $ ([Node] -> Bool) -> [[Node]] -> [[Node]]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\(Node
    u:[Node]
    _) -> Node
    uNode -> Node -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Node
    t) [[Node]]
    tree
        where tree :: [[Node]]
    tree = Node -> Gr () Double -> [[Node]]
    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)DirEdge (Double, Double)
    -> [DirEdge (Double, Double)] -> [DirEdge (Double, Double)]
    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
    vNode -> [Node] -> [Node]
    forall 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)DirEdge (Double, Double)
    -> [DirEdge (Double, Double)] -> [DirEdge (Double, Double)]
    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
    vNode -> [Node] -> [Node]
    forall a. a -> [a] -> [a]
    :[Node]
    ws)
                    Maybe ((Double, Double), Network)
    Nothing               -> String -> ([DirEdge (Double, Double)], Network)
    forall a. HasCallStack => String -> a
    error String
    "extractPath: revExtract == Nothing"
        where fwdExtract :: Maybe ((Double, Double), Network)
    fwdExtract = Network
    -> Node
    -> Node
    -> ((Double, Double) -> Bool)
    -> Maybe ((Double, Double), Network)
    forall a b.
    Gr a b -> Node -> Node -> (b -> Bool) -> Maybe (b, Gr a b)
    extractEdge Network
    g Node
    u Node
    v ((Double -> Double -> Bool) -> (Double, Double) -> Bool
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry Double -> Double -> Bool
    forall a. Ord a => a -> a -> Bool
    (>))
              revExtract :: Maybe ((Double, Double), Network)
    revExtract = Network
    -> Node
    -> Node
    -> ((Double, Double) -> Bool)
    -> Maybe ((Double, Double), Network)
    forall a b.
    Gr a b -> Node -> Node -> (b -> Bool) -> Maybe (b, Gr a b)
    extractEdge Network
    g Node
    v Node
    u ((Double -> Double -> Bool
    forall a. Ord a => a -> a -> Bool
    >Double
    0) (Double -> Bool)
    -> ((Double, Double) -> Double) -> (Double, Double) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Double, Double) -> Double
    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
    _) -> (b, Gr a b) -> Maybe (b, Gr a b)
    forall a. a -> Maybe a
    Just (b
    el, (Adj b
    p', Node
    node, a
    l, Adj b
    rest) Context a b -> Gr a b -> Gr a 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
    newg)
            Maybe (b, Node)
    Nothing      -> Maybe (b, Gr a b)
    forall a. Maybe a
    Nothing
        where (Just (Adj b
    p', Node
    node, a
    l, Adj b
    s), Gr a b
    newg) = Node -> Gr a b -> (MContext a b, Gr a b)
    forall a b. Node -> Gr a b -> Decomp Gr a b
    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)=Adj b -> ((b, Node) -> Bool) -> (Maybe (b, Node), Adj b)
    forall b. Adj b -> ((b, Node) -> Bool) -> (Maybe (b, Node), Adj b)
    extractAdj Adj b
    s
                  (\(b
    l', Node
    dest) -> Node
    destNode -> Node -> Bool
    forall 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
    _ = (Maybe (b, Node)
    forall a. Maybe a
    Nothing, [])
    extractAdj ((b, Node)
    adj:[(b, Node)]
    adjs) (b, Node) -> Bool
    p
        | (b, Node) -> Bool
    p (b, Node)
    adj     = ((b, Node) -> Maybe (b, Node)
    forall a. a -> Maybe a
    Just (b, Node)
    adj, [(b, Node)]
    adjs)
        | Bool
    otherwise = (Maybe (b, Node)
    theone, (b, Node)
    adj(b, Node) -> [(b, Node)] -> [(b, Node)]
    forall a. a -> [a] -> [a]
    :[(b, Node)]
    rest)
            where (Maybe (b, Node)
    theone, [(b, Node)]
    rest)=[(b, Node)]
    -> ((b, Node) -> Bool) -> (Maybe (b, Node), [(b, Node)])
    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
    cDouble -> Double -> Double
    forall a. Num a => a -> a -> a
    -Double
    f Double -> [Double] -> [Double]
    forall a. a -> [a] -> [a]
    : [DirEdge (Double, Double)] -> [Double]
    getPathDeltas [DirEdge (Double, Double)]
    es
        (Node
    _, Node
    _, (Double
    _,Double
    f), Direction
    Backward) -> Double
    f Double -> [Double] -> [Double]
    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
    fDouble -> Double -> Double
    forall a. Num a => a -> a -> a
    +Double
    delta)) LEdge (Double, Double)
    -> [LEdge (Double, Double)] -> [LEdge (Double, Double)]
    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
    fDouble -> Double -> Double
    forall a. Num a => a -> a -> a
    -Double
    delta)) LEdge (Double, Double)
    -> [LEdge (Double, Double)] -> [LEdge (Double, Double)]
    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]
    _ ->
                (Network, Double) -> Maybe (Network, Double)
    forall a. a -> Maybe a
    Just ([LEdge (Double, Double)] -> Network -> Network
    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   -> Maybe (Network, Double)
    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 (Maybe [Node] -> [Node]
    forall a. HasCallStack => Maybe a -> a
    fromJust Maybe [Node]
    maybePath)
              delta :: Double
    delta      = [Double] -> Double
    forall a. Ord a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    minimum ([Double] -> Double) -> [Double] -> Double
    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
    capacityDouble -> Double -> Double
    forall 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
    cDouble -> Double -> Bool
    forall a. Ord a => a -> a -> Bool
    >Double
    f) Bool -> Bool -> Bool
    && (Node, Node) -> Set (Node, Node) -> 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 ((Node, Node) -> Set (Node, Node) -> Set (Node, Node)
    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)DirEdge (Double, Double)
    -> [DirEdge (Double, Double)] -> [DirEdge (Double, Double)]
    forall a. a -> [a] -> [a]
    :[DirEdge (Double, Double)]
    pathrest, [LEdge (Double, Double)]
    notrest)
        | (Double
    fDouble -> Double -> Bool
    forall a. Ord a => a -> a -> Bool
    >Double
    0) Bool -> Bool -> Bool
    && (Node, Node) -> Set (Node, Node) -> 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 ((Node, Node) -> Set (Node, Node) -> Set (Node, Node)
    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)DirEdge (Double, Double)
    -> [DirEdge (Double, Double)] -> [DirEdge (Double, Double)]
    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)
    edgeLEdge (Double, Double)
    -> [LEdge (Double, Double)] -> [LEdge (Double, Double)]
    forall 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
    _  -> (Network, Double) -> Maybe (Network, Double)
    forall a. a -> Maybe a
    Just ([LNode ()] -> [LEdge (Double, Double)] -> Network
    forall a b. [LNode a] -> [LEdge b] -> Gr a b
    forall (gr :: * -> * -> *) a b.
    Graph gr =>
    [LNode a] -> [LEdge b] -> gr a b
    mkGraph (Network -> [LNode ()]
    forall a b. Gr a b -> [LNode a]
    forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LNode a]
    labNodes Network
    g) [LEdge (Double, Double)]
    newEdges, Double
    delta)
            Maybe DirPath
    Nothing -> Maybe (Network, Double)
    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 [LEdge (Double, Double)]
    -> [LEdge (Double, Double)] -> [LEdge (Double, Double)]
    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 (Network -> [LEdge (Double, Double)]
    forall a b. Gr a b -> [LEdge b]
    forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LEdge b]
    labEdges Network
    g)
                  ([(Node, Node)] -> Set (Node, Node)
    forall a. Ord a => [a] -> Set a
    S.fromList ([Node] -> [Node] -> [(Node, Node)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Node]
    justPath ([Node] -> [Node]
    forall a. HasCallStack => [a] -> [a]
    tail [Node]
    justPath)))
              delta :: Double
    delta         = [Double] -> Double
    forall a. Ord a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    minimum ([Double] -> Double) -> [Double] -> Double
    forall a b. (a -> b) -> a -> b
    $ [DirEdge (Double, Double)] -> [Double]
    getPathDeltas [DirEdge (Double, Double)]
    es
              justPath :: [Node]
    justPath      = DirPath -> [Node]
    pathFromDirPath (Maybe DirPath -> DirPath
    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