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))}
