content: 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.Query.BFS;
     
    getRevEdges ::
                (Num b, Ord b) => [(Node, Node)] -> [(Node, Node, b)];
    getRevEdges [] = [];
    getRevEdges ((u, v) : es)
      | notElem (v, u) es = (v, u, 0) : getRevEdges es
      | otherwise = getRevEdges (delete (v, u) es);
     
    augmentGraph ::
                 (DynGraph gr, Num b, Ord b) => gr a b -> gr a (b, b, b);
    augmentGraph g
      = emap (\ i -> (i, 0, i)) (insEdges (getRevEdges (edges g)) g);
     
    updAdjList ::
               (Num b, Ord b) =>
                 [((b, b, b), Node)] -> Node -> b -> Bool -> [((b, b, b), Node)];
    updAdjList s v cf fwd
      | fwd == True = ((x, y + cf, z - cf), w) : rs
      | otherwise = ((x, y - cf, z + cf), w) : rs
      where { ((x, y, z), w) = head (filter (\ (_, w') -> v == w') s);
              rs = filter (\ (_, w') -> v /= w') s};
     
    updateFlow ::
               (DynGraph gr, Num b, Ord b) =>
                 Path -> b -> gr a (b, b, b) -> gr a (b, b, b);
    updateFlow [] _ g = g;
    updateFlow [_] _ g = g;
    updateFlow (u : v : vs) cf g
      = case match u g of
            { (Nothing, g') -> g';
              (Just (p, u', l, s), g') -> (p', u', l, s') & g2
                where { g2 = updateFlow (v : vs) cf g';
                        s' = updAdjList s v cf True;
                        p' = updAdjList p v cf False}};
     
    mfmg ::
         (DynGraph gr, Num b, Ord b) =>
           gr a (b, b, b) -> Node -> Node -> gr a (b, b, b);
    mfmg g s t
      | augPath == [] = g
      | otherwise = mfmg (updateFlow augPath minC g) s t
      where { minC
                = minimum (map ((\ (_, _, z) -> z) . snd) (tail augLPath));
              augPath = map fst augLPath;
              LP augLPath = lesp s t gf;
              gf = elfilter (\ (_, _, z) -> z /= 0) g};
     
    mf ::
       (DynGraph gr, Num b, Ord b) =>
         gr a b -> Node -> Node -> gr a (b, b, b);
    mf g s t = mfmg (augmentGraph g) s t;
     
    maxFlowgraph ::
                 (DynGraph gr, Num b, Ord b) =>
                   gr a b -> Node -> Node -> gr a (b, b);
    maxFlowgraph g s t = emap (\ (u, v, _) -> (v, u)) g2
      where { g2 = elfilter (\ (x, _, _) -> x /= 0) g1;
              g1 = mf g s t};
     
    maxFlow ::
            (DynGraph gr, Num b, Ord b) => gr a b -> Node -> Node -> b;
    maxFlow g s t
      = foldr (+) 0
          (map (\ (_, _, (x, _)) -> x) (out (maxFlowgraph g s t) s))}
  