    -- | 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
    /= :: Direction -> Direction -> Bool
    $c/= :: Direction -> Direction -> Bool
    == :: Direction -> Direction -> Bool
    $c== :: 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
    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
    $cp1Ord :: Eq Direction
    Ord, Int -> Direction -> ShowS
    [Direction] -> ShowS
    Direction -> String
    (Int -> Direction -> ShowS)
    -> (Direction -> String)
    -> ([Direction] -> ShowS)
    -> Show Direction
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [Direction] -> ShowS
    $cshowList :: [Direction] -> ShowS
    show :: Direction -> String
    $cshow :: Direction -> String
    showsPrec :: Int -> Direction -> ShowS
    $cshowsPrec :: Int -> Direction -> ShowS
    Show, ReadPrec [Direction]
    ReadPrec Direction
    Int -> ReadS Direction
    ReadS [Direction]
    (Int -> ReadS Direction)
    -> ReadS [Direction]
    -> ReadPrec Direction
    -> ReadPrec [Direction]
    -> Read Direction
    forall a.
    (Int -> 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 :: Int -> ReadS Direction
    $creadsPrec :: Int -> 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 -> [Int]
    pathFromDirPath = ((Int, Direction) -> Int) -> DirPath -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int, Direction) -> Int
    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 -> Int -> Int -> Maybe DirPath
    augPathFused g :: Network
    g s :: Int
    s t :: Int
    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 (\((u :: Int
    u,_):_) -> Int
    uInt -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Int
    t) [DirPath]
    tree
        where tree :: [DirPath]
    tree = Int -> Network -> [DirPath]
    bftForEK Int
    s Network
    g

    -- Breadth First Search wrapper function
    bftForEK :: Node -> Network -> DirRTree
    bftForEK :: Int -> Network -> [DirPath]
    bftForEK v :: Int
    v = Queue DirPath -> Network -> [DirPath]
    bfForEK (DirPath -> Queue DirPath -> Queue DirPath
    forall a. a -> Queue a -> Queue a
    queuePut [(Int
    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 q :: Queue DirPath
    q g :: Network
    g
        | Queue DirPath -> Bool
    forall a. Queue a -> Bool
    queueEmpty Queue DirPath
    q Bool -> Bool -> Bool
    || Network -> Bool
    forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Bool
    isEmpty Network
    g = []
        | Bool
    otherwise                 = case Int -> Network -> Decomp Gr () (Double, Double)
    forall (gr :: * -> * -> *) a b.
    Graph gr =>
    Int -> gr a b -> Decomp gr a b
    match Int
    v Network
    g of
            (Nothing, g' :: Network
    g')                     -> Queue DirPath -> Network -> [DirPath]
    bfForEK Queue DirPath
    q1 Network
    g'
            (Just (preAdj :: Adj (Double, Double)
    preAdj, _, _, sucAdj :: Adj (Double, Double)
    sucAdj), g' :: 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 = [ (Int
    preNode, Direction
    Backward)(Int, Direction) -> DirPath -> DirPath
    forall a. a -> [a] -> [a]
    :DirPath
    p
                        | ((_, f :: Double
    f), preNode :: Int
    preNode) <- Adj (Double, Double)
    preAdj, Double
    fDouble -> Double -> Bool
    forall a. Ord a => a -> a -> Bool
    >0]
                    -- Traverse edges forwards if flow less than capacity
                    suc2 :: [DirPath]
    suc2 = [ (Int
    sucNode,Direction
    Forward)(Int, Direction) -> DirPath -> DirPath
    forall a. a -> [a] -> [a]
    :DirPath
    p
                        | ((c :: Double
    c, f :: Double
    f), sucNode :: Int
    sucNode) <- Adj (Double, Double)
    sucAdj, Double
    cDouble -> Double -> Bool
    forall a. Ord a => a -> a -> Bool
    >Double
    f]
        where (p :: DirPath
    p@((v :: Int
    v,_):_), q1 :: 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 g :: Network
    g []  = ([], Network
    g)
    extractPathFused g :: Network
    g [(_,_)] = ([], Network
    g)
    extractPathFused g :: Network
    g ((u :: Int
    u,_):rest :: DirPath
    rest@((v :: Int
    v,Forward):_)) =
        ((Int
    u, Int
    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 (tailedges :: [DirEdge (Double, Double)]
    tailedges, newerg :: Network
    newerg) = Network -> DirPath -> ([DirEdge (Double, Double)], Network)
    extractPathFused Network
    newg DirPath
    rest
                  Just (l :: (Double, Double)
    l, newg :: Network
    newg)    = Network
    -> Int
    -> Int
    -> ((Double, Double) -> Bool)
    -> Maybe ((Double, Double), Network)
    forall a b.
    Gr a b -> Int -> Int -> (b -> Bool) -> Maybe (b, Gr a b)
    extractEdge Network
    g Int
    u Int
    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 g :: Network
    g ((u :: Int
    u,_):rest :: DirPath
    rest@((v :: Int
    v,Backward):_)) =
        ((Int
    v, Int
    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 (tailedges :: [DirEdge (Double, Double)]
    tailedges, newerg :: Network
    newerg) = Network -> DirPath -> ([DirEdge (Double, Double)], Network)
    extractPathFused Network
    newg DirPath
    rest
                  Just (l :: (Double, Double)
    l, newg :: Network
    newg)    = Network
    -> Int
    -> Int
    -> ((Double, Double) -> Bool)
    -> Maybe ((Double, Double), Network)
    forall a b.
    Gr a b -> Int -> Int -> (b -> Bool) -> Maybe (b, Gr a b)
    extractEdge Network
    g Int
    v Int
    u (\(_,f :: Double
    f)->(Double
    fDouble -> Double -> Bool
    forall a. Ord a => a -> a -> Bool
    >0))

    ekFusedStep :: EKStepFunc
    ekFusedStep :: EKStepFunc
    ekFusedStep g :: Network
    g s :: Int
    s t :: Int
    t = case Maybe DirPath
    maybePath of
            Just _          ->
                (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)
            Nothing   -> Maybe (Network, Double)
    forall a. Maybe a
    Nothing
        where maybePath :: Maybe DirPath
    maybePath     = Network -> Int -> Int -> Maybe DirPath
    augPathFused Network
    g Int
    s Int
    t
              (es :: [DirEdge (Double, Double)]
    es, newg :: 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 (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 -> Int -> Int -> (Network, Double)
    ekFused = EKStepFunc -> Network -> Int -> Int -> (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 g :: Network
    g =
        [LNode ()] -> [LEdge Double] -> Gr () Double
    forall (gr :: * -> * -> *) a b.
    Graph gr =>
    [LNode a] -> [LEdge b] -> gr a b
    mkGraph (Network -> [LNode ()]
    forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LNode a]
    labNodes Network
    g)
            ([(Int
    u, Int
    v, Double
    cDouble -> Double -> Double
    forall a. Num a => a -> a -> a
    -Double
    f) | (u :: Int
    u, v :: Int
    v, (c :: Double
    c,f :: Double
    f)) <- Network -> [LEdge (Double, Double)]
    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]
    ++
             [(Int
    v, Int
    u, Double
    f) | (u :: Int
    u,v :: Int
    v,(_,f :: Double
    f)) <- Network -> [LEdge (Double, Double)]
    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
    >0])

    augPath :: Network -> Node -> Node -> Maybe Path
    augPath :: Network -> Int -> Int -> Maybe [Int]
    augPath g :: Network
    g s :: Int
    s t :: Int
    t = [[Int]] -> Maybe [Int]
    forall a. [a] -> Maybe a
    listToMaybe ([[Int]] -> Maybe [Int]) -> [[Int]] -> Maybe [Int]
    forall a b. (a -> b) -> a -> b
    $ ([Int] -> [Int]) -> [[Int]] -> [[Int]]
    forall a b. (a -> b) -> [a] -> [b]
    map [Int] -> [Int]
    forall a. [a] -> [a]
    reverse ([[Int]] -> [[Int]]) -> [[Int]] -> [[Int]]
    forall a b. (a -> b) -> a -> b
    $ ([Int] -> Bool) -> [[Int]] -> [[Int]]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\(u :: Int
    u:_) -> Int
    uInt -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Int
    t) [[Int]]
    tree
        where tree :: [[Int]]
    tree = Int -> Gr () Double -> [[Int]]
    forall (gr :: * -> * -> *) a b.
    Graph gr =>
    Int -> gr a b -> [[Int]]
    bft Int
    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 -> [Int] -> ([DirEdge (Double, Double)], Network)
    extractPath g :: Network
    g []  = ([], Network
    g)
    extractPath g :: Network
    g [_] = ([], Network
    g)
    extractPath g :: Network
    g (u :: Int
    u:v :: Int
    v:ws :: [Int]
    ws) =
        case Maybe ((Double, Double), Network)
    fwdExtract of
            Just (l :: (Double, Double)
    l, newg :: Network
    newg) -> ((Int
    u, Int
    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 (tailedges :: [DirEdge (Double, Double)]
    tailedges, newerg :: Network
    newerg) = Network -> [Int] -> ([DirEdge (Double, Double)], Network)
    extractPath Network
    newg (Int
    vInt -> [Int] -> [Int]
    forall a. a -> [a] -> [a]
    :[Int]
    ws)
            Nothing          ->
                case Maybe ((Double, Double), Network)
    revExtract of
                    Just (l :: (Double, Double)
    l, newg :: Network
    newg) ->
                        ((Int
    v, Int
    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 (tailedges :: [DirEdge (Double, Double)]
    tailedges, newerg :: Network
    newerg) = Network -> [Int] -> ([DirEdge (Double, Double)], Network)
    extractPath Network
    newg (Int
    vInt -> [Int] -> [Int]
    forall a. a -> [a] -> [a]
    :[Int]
    ws)
                    Nothing               -> String -> ([DirEdge (Double, Double)], Network)
    forall a. HasCallStack => String -> a
    error "extractPath: revExtract == Nothing"
        where fwdExtract :: Maybe ((Double, Double), Network)
    fwdExtract = Network
    -> Int
    -> Int
    -> ((Double, Double) -> Bool)
    -> Maybe ((Double, Double), Network)
    forall a b.
    Gr a b -> Int -> Int -> (b -> Bool) -> Maybe (b, Gr a b)
    extractEdge Network
    g Int
    u Int
    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
    -> Int
    -> Int
    -> ((Double, Double) -> Bool)
    -> Maybe ((Double, Double), Network)
    forall a b.
    Gr a b -> Int -> Int -> (b -> Bool) -> Maybe (b, Gr a b)
    extractEdge Network
    g Int
    v Int
    u ((Double -> Double -> Bool
    forall a. Ord a => a -> a -> Bool
    >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 :: Gr a b -> Int -> Int -> (b -> Bool) -> Maybe (b, Gr a b)
    extractEdge g :: Gr a b
    g u :: Int
    u v :: Int
    v p :: b -> Bool
    p =
        case Maybe (b, Int)
    adj of
            Just (el :: b
    el, _) -> (b, Gr a b) -> Maybe (b, Gr a b)
    forall a. a -> Maybe a
    Just (b
    el, (Adj b
    p', Int
    node, a
    l, Adj b
    rest) 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)
            Nothing      -> Maybe (b, Gr a b)
    forall a. Maybe a
    Nothing
        where (Just (p' :: Adj b
    p', node :: Int
    node, l :: a
    l, s :: Adj b
    s), newg :: Gr a b
    newg) = Int -> Gr a b -> (Maybe (Context a b), Gr a b)
    forall (gr :: * -> * -> *) a b.
    Graph gr =>
    Int -> gr a b -> Decomp gr a b
    match Int
    u Gr a b
    g
              (adj :: Maybe (b, Int)
    adj, rest :: Adj b
    rest)=Adj b -> ((b, Int) -> Bool) -> (Maybe (b, Int), Adj b)
    forall b. Adj b -> ((b, Int) -> Bool) -> (Maybe (b, Int), Adj b)
    extractAdj Adj b
    s
                  (\(l' :: b
    l', dest :: Int
    dest) -> Int
    destInt -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Int
    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 :: Adj b -> ((b, Int) -> Bool) -> (Maybe (b, Int), Adj b)
    extractAdj []         _ = (Maybe (b, Int)
    forall a. Maybe a
    Nothing, [])
    extractAdj (adj :: (b, Int)
    adj:adjs :: Adj b
    adjs) p :: (b, Int) -> Bool
    p
        | (b, Int) -> Bool
    p (b, Int)
    adj     = ((b, Int) -> Maybe (b, Int)
    forall a. a -> Maybe a
    Just (b, Int)
    adj, Adj b
    adjs)
        | Bool
    otherwise = (Maybe (b, Int)
    theone, (b, Int)
    adj(b, Int) -> Adj b -> Adj b
    forall a. a -> [a] -> [a]
    :Adj b
    rest)
            where (theone :: Maybe (b, Int)
    theone, rest :: Adj b
    rest)=Adj b -> ((b, Int) -> Bool) -> (Maybe (b, Int), Adj b)
    forall b. Adj b -> ((b, Int) -> Bool) -> (Maybe (b, Int), Adj b)
    extractAdj Adj b
    adjs (b, Int) -> Bool
    p

    getPathDeltas :: [DirEdge (Double,Double)] -> [Double]
    getPathDeltas :: [DirEdge (Double, Double)] -> [Double]
    getPathDeltas []     = []
    getPathDeltas (e :: DirEdge (Double, Double)
    e:es :: [DirEdge (Double, Double)]
    es) = case DirEdge (Double, Double)
    e of
        (_, _, (c :: Double
    c,f :: Double
    f), 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
        (_, _, (_,f :: Double
    f), 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 []          _ = []
    integrateDelta (e :: DirEdge (Double, Double)
    e:es :: [DirEdge (Double, Double)]
    es) delta :: Double
    delta = case DirEdge (Double, Double)
    e of
        (u :: Int
    u, v :: Int
    v, (c :: Double
    c, f :: Double
    f), Forward) ->
            (Int
    u, Int
    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
        (u :: Int
    u, v :: Int
    v, (c :: Double
    c, f :: Double
    f), Backward) ->
            (Int
    u, Int
    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 g :: Network
    g s :: Int
    s t :: Int
    t = case Maybe [Int]
    maybePath of
            Just _ ->
                (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)
            Nothing   -> Maybe (Network, Double)
    forall a. Maybe a
    Nothing
        where maybePath :: Maybe [Int]
    maybePath  = Network -> Int -> Int -> Maybe [Int]
    augPath Network
    g Int
    s Int
    t
              (es :: [DirEdge (Double, Double)]
    es, newg :: Network
    newg) = Network -> [Int] -> ([DirEdge (Double, Double)], Network)
    extractPath Network
    g (Maybe [Int] -> [Int]
    forall a. HasCallStack => Maybe a -> a
    fromJust Maybe [Int]
    maybePath)
              delta :: Double
    delta      = [Double] -> Double
    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 -> Int -> Int -> (Network, Double)
    ekWith stepfunc :: EKStepFunc
    stepfunc g :: Network
    g s :: Int
    s t :: Int
    t = case EKStepFunc
    stepfunc Network
    g Int
    s Int
    t of
        Just (newg :: Network
    newg, delta :: Double
    delta) -> (Network
    finalg, Double
    capacityDouble -> Double -> Double
    forall a. Num a => a -> a -> a
    +Double
    delta)
            where (finalg :: Network
    finalg, capacity :: Double
    capacity) = EKStepFunc -> Network -> Int -> Int -> (Network, Double)
    ekWith EKStepFunc
    stepfunc Network
    newg Int
    s Int
    t
        Nothing            -> (Network
    g, 0)

    ekSimple :: Network -> Node -> Node -> (Network, Double)
    ekSimple :: Network -> Int -> Int -> (Network, Double)
    ekSimple = EKStepFunc -> Network -> Int -> Int -> (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 (Int, Int)
    -> ([DirEdge (Double, Double)], [LEdge (Double, Double)])
    extractPathList []                 _ = ([], [])
    extractPathList (edge :: LEdge (Double, Double)
    edge@(u :: Int
    u,v :: Int
    v,l :: (Double, Double)
    l@(c :: Double
    c,f :: Double
    f)):es :: [LEdge (Double, Double)]
    es) set :: Set (Int, Int)
    set
        | (Double
    cDouble -> Double -> Bool
    forall a. Ord a => a -> a -> Bool
    >Double
    f) Bool -> Bool -> Bool
    && (Int, Int) -> Set (Int, Int) -> Bool
    forall a. Ord a => a -> Set a -> Bool
    S.member (Int
    u,Int
    v) Set (Int, Int)
    set =
            let (pathrest :: [DirEdge (Double, Double)]
    pathrest, notrest :: [LEdge (Double, Double)]
    notrest)=[LEdge (Double, Double)]
    -> Set (Int, Int)
    -> ([DirEdge (Double, Double)], [LEdge (Double, Double)])
    extractPathList [LEdge (Double, Double)]
    es ((Int, Int) -> Set (Int, Int) -> Set (Int, Int)
    forall a. Ord a => a -> Set a -> Set a
    S.delete (Int
    u,Int
    v) Set (Int, Int)
    set)
                in ((Int
    u,Int
    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
    >0) Bool -> Bool -> Bool
    && (Int, Int) -> Set (Int, Int) -> Bool
    forall a. Ord a => a -> Set a -> Bool
    S.member (Int
    v,Int
    u) Set (Int, Int)
    set =
            let (pathrest :: [DirEdge (Double, Double)]
    pathrest, notrest :: [LEdge (Double, Double)]
    notrest)=[LEdge (Double, Double)]
    -> Set (Int, Int)
    -> ([DirEdge (Double, Double)], [LEdge (Double, Double)])
    extractPathList [LEdge (Double, Double)]
    es ((Int, Int) -> Set (Int, Int) -> Set (Int, Int)
    forall a. Ord a => a -> Set a -> Set a
    S.delete (Int
    u,Int
    v) Set (Int, Int)
    set)
                in ((Int
    u,Int
    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 (pathrest :: [DirEdge (Double, Double)]
    pathrest, notrest :: [LEdge (Double, Double)]
    notrest)=[LEdge (Double, Double)]
    -> Set (Int, Int)
    -> ([DirEdge (Double, Double)], [LEdge (Double, Double)])
    extractPathList [LEdge (Double, Double)]
    es Set (Int, Int)
    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 g :: Network
    g s :: Int
    s t :: Int
    t = case Maybe DirPath
    maybePath of
            Just _  -> (Network, Double) -> Maybe (Network, Double)
    forall a. a -> Maybe a
    Just ([LNode ()] -> [LEdge (Double, Double)] -> Network
    forall (gr :: * -> * -> *) a b.
    Graph gr =>
    [LNode a] -> [LEdge b] -> gr a b
    mkGraph (Network -> [LNode ()]
    forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LNode a]
    labNodes Network
    g) [LEdge (Double, Double)]
    newEdges, Double
    delta)
            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 -> Int -> Int -> Maybe DirPath
    augPathFused Network
    g Int
    s Int
    t
              (es :: [DirEdge (Double, Double)]
    es, otheredges :: [LEdge (Double, Double)]
    otheredges) = [LEdge (Double, Double)]
    -> Set (Int, Int)
    -> ([DirEdge (Double, Double)], [LEdge (Double, Double)])
    extractPathList (Network -> [LEdge (Double, Double)]
    forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LEdge b]
    labEdges Network
    g)
                  ([(Int, Int)] -> Set (Int, Int)
    forall a. Ord a => [a] -> Set a
    S.fromList ([Int] -> [Int] -> [(Int, Int)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Int]
    justPath ([Int] -> [Int]
    forall a. [a] -> [a]
    tail [Int]
    justPath)))
              delta :: Double
    delta         = [Double] -> Double
    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 :: [Int]
    justPath      = DirPath -> [Int]
    pathFromDirPath (Maybe DirPath -> DirPath
    forall a. HasCallStack => Maybe a -> a
    fromJust Maybe DirPath
    maybePath)

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