content: -- (c) 2000 - 2005 by Martin Erwig [see file COPYRIGHT]
  
  -- | Depth-first search algorithms.
  --
  -- Names consist of:
  --
  --   1. An optional direction parameter, specifying which nodes to visit next.
  --
  --      [@u@] undirectional: ignore edge direction
  --      [@r@] reversed: walk edges in reverse
  --      [@x@] user defined: speciy which paths to follow
  --
  --   2. "df" for depth-first
  --   3. A structure parameter, specifying the type of the result.
  --
  --       [@s@] Flat list of results
  --       [@f@] Structured 'Tree' of results
  --
  --   4. An optional \"With\", which instead of putting the found nodes directly
  --      into the result, adds the result of a computation on them into it.
  --   5. An optional prime character, in which case all nodes of the graph will
  --      be visited, instead of a user-given subset.
  module Data.Graph.Inductive.Query.DFS (
  
      CFun,
  
      -- * Standard
      dfs, dfs', dff, dff',
      dfsWith,  dfsWith', dffWith, dffWith',
      xdfsWith, xdfWith, xdffWith,
  
      -- * Undirected
      udfs, udfs', udff, udff',
      udffWith, udffWith',
  
      -- * Reversed
      rdff, rdff', rdfs, rdfs',
      rdffWith, rdffWith',
  
      -- * Applications of depth first search/forest
      topsort, topsort', scc, reachable,
  
      -- * Applications of undirected depth first search/forest
      components, noComponents, isConnected, condensation
  
  ) where
  
  import Data.Graph.Inductive.Basic
  import Data.Graph.Inductive.Graph
  import Data.Tree
  import qualified Data.Map as Map
  import Control.Monad (liftM2)
  import Data.Tuple (swap)
  
  
  -- | Many functions take a list of nodes to visit as an explicit argument.
  --   fixNodes is a convenience function that adds all the nodes present in a
  --   graph as that list.
  fixNodes :: (Graph gr) => ([Node] -> gr a b -> c) -> gr a b -> c
  fixNodes f g = f (nodes g) g
  
  
  type CFun a b c = Context a b -> c
  
  -- | Most general DFS algorithm to create a list of results. The other
  --   list-returning functions such as 'dfs' are all defined in terms of this
  --   one.
  --
  -- @
  -- 'xdfsWith' d f vs = 'preorderF' . 'xdffWith' d f vs
  -- @
  xdfsWith :: (Graph gr)
      => CFun a b [Node] -- ^ Mapping from a node to its neighbours to be visited
                         --   as well. 'suc'' for example makes 'xdfsWith'
                         --   traverse the graph following the edge directions,
                         --   while 'pre'' means reversed directions.
      -> CFun a b c      -- ^ Mapping from the 'Context' of a node to a result
                         --   value.
      -> [Node]          -- ^ Nodes to be visited.
      -> gr a b
      -> [c]
  xdfsWith _ _ []     _             = []
  xdfsWith _ _ _      g | isEmpty g = []
  xdfsWith d f (v:vs) g = case match v g of
                           (Just c,g')  -> f c:xdfsWith d f (d c++vs) g'
                           (Nothing,g') -> xdfsWith d f vs g'
  
  
  -- | Depth-first search.
  dfs :: (Graph gr) => [Node] -> gr a b -> [Node]
  dfs = dfsWith node'
  
  dfsWith :: (Graph gr) => CFun a b c -> [Node] -> gr a b -> [c]
  dfsWith = xdfsWith suc'
  
  dfsWith' :: (Graph gr) => CFun a b c -> gr a b -> [c]
  dfsWith' f = fixNodes (dfsWith f)
  
  dfs' :: (Graph gr) => gr a b -> [Node]
  dfs' = dfsWith' node'
  
  
  -- | Undirected depth-first search, obtained by following edges regardless
  --   of their direction.
  udfs :: (Graph gr) => [Node] -> gr a b -> [Node]
  udfs = xdfsWith neighbors' node'
  
  udfs' :: (Graph gr) => gr a b -> [Node]
  udfs' = fixNodes udfs
  
  
  -- | Reverse depth-first search, obtained by following predecessors.
  rdfs :: (Graph gr) => [Node] -> gr a b -> [Node]
  rdfs = xdfsWith pre' node'
  
  rdfs' :: (Graph gr) => gr a b -> [Node]
  rdfs' = fixNodes rdfs
  
  
  -- | Most general DFS algorithm to create a forest of results, otherwise very
  --   similar to 'xdfsWith'. The other forest-returning functions such as 'dff'
  --   are all defined in terms of this one.
  xdfWith :: (Graph gr)
      => CFun a b [Node]
      -> CFun a b c
      -> [Node]
      -> gr a b
      -> ([Tree c],gr a b)
  xdfWith _ _ []     g             = ([],g)
  xdfWith _ _ _      g | isEmpty g = ([],g)
  xdfWith d f (v:vs) g = case match v g of
                          (Nothing,g1) -> xdfWith d f vs g1
                          (Just c,g1)  -> (Node (f c) ts:ts',g3)
                                   where (ts,g2)  = xdfWith d f (d c) g1
                                         (ts',g3) = xdfWith d f vs g2
  
  -- | Discard the graph part of the result of 'xdfWith'.
  --
  -- @
  -- xdffWith d f vs g = fst (xdfWith d f vs g)
  -- @
  xdffWith :: (Graph gr)
      => CFun a b [Node]
      -> CFun a b c
      -> [Node]
      -> gr a b
      -> [Tree c]
  xdffWith d f vs g = fst (xdfWith d f vs g)
  
  
  
  -- | Directed depth-first forest.
  dff :: (Graph gr) => [Node] -> gr a b -> [Tree Node]
  dff = dffWith node'
  
  dffWith :: (Graph gr) => CFun a b c -> [Node] -> gr a b -> [Tree c]
  dffWith = xdffWith suc'
  
  dffWith' :: (Graph gr) => CFun a b c -> gr a b -> [Tree c]
  dffWith' f = fixNodes (dffWith f)
  
  dff' :: (Graph gr) => gr a b -> [Tree Node]
  dff' = dffWith' node'
  
  
  
  -- | Undirected depth-first forest, obtained by following edges regardless
  --   of their direction.
  udff :: (Graph gr) => [Node] -> gr a b -> [Tree Node]
  udff = udffWith node'
  
  udffWith :: (Graph gr) => CFun a b c -> [Node] -> gr a b -> [Tree c]
  udffWith = xdffWith neighbors'
  
  udffWith' :: (Graph gr) => CFun a b c -> gr a b -> [Tree c]
  udffWith' f = fixNodes (udffWith f)
  
  udff' :: (Graph gr) => gr a b -> [Tree Node]
  udff' = udffWith' node'
  
  
  -- | Reverse depth-first forest, obtained by following predecessors.
  rdff :: (Graph gr) => [Node] -> gr a b -> [Tree Node]
  rdff = rdffWith node'
  
  rdffWith :: (Graph gr) => CFun a b c -> [Node] -> gr a b -> [Tree c]
  rdffWith = xdffWith pre'
  
  rdffWith' :: (Graph gr) => CFun a b c -> gr a b -> [Tree c]
  rdffWith' f = fixNodes (rdffWith f)
  
  rdff' :: (Graph gr) => gr a b -> [Tree Node]
  rdff' = rdffWith' node'
  
  
  ----------------------------------------------------------------------
  -- ALGORITHMS BASED ON DFS
  ----------------------------------------------------------------------
  
  -- | Collection of connected components
  components :: (Graph gr) => gr a b -> [[Node]]
  components = map preorder . udff'
  
  -- | Number of connected components
  noComponents :: (Graph gr) => gr a b -> Int
  noComponents = length . components
  
  -- | Is the graph connected?
  isConnected :: (Graph gr) => gr a b -> Bool
  isConnected = (==1) . noComponents
  
  -- | Flatten a 'Tree' in reverse order
  postflatten :: Tree a -> [a]
  postflatten (Node v ts) = postflattenF ts ++ [v]
  
  -- | Flatten a forest in reverse order
  postflattenF :: [Tree a] -> [a]
  postflattenF = concatMap postflatten
  
  -- | <http://en.wikipedia.org/wiki/Topological_sorting Topological sorting>,
  --   i.e. a list of 'Node's so that if there's an edge between a source and a
  --   target node, the source appears earlier in the result.
  topsort :: (Graph gr) => gr a b -> [Node]
  topsort = reverse . postflattenF . dff'
  
  -- | 'topsort', returning only the labels of the nodes.
  topsort' :: (Graph gr) => gr a b -> [a]
  topsort' = reverse . postorderF . dffWith' lab'
  
  -- | Collection of strongly connected components
  scc :: (Graph gr) => gr a b -> [[Node]]
  scc g = map preorder (rdff (topsort g) g)
  
  -- | Collection of nodes reachable from a starting point.
  reachable :: (Graph gr) => Node -> gr a b -> [Node]
  reachable v g = preorderF (dff [v] g)
  
  -- | The condensation of the given graph, i.e., the graph of its
  -- strongly connected components.
  condensation :: Graph gr => gr a b -> gr [Node] ()
  condensation gr = mkGraph vs es
    where
      sccs = scc gr
      vs = zip [1..] sccs
      vMap = Map.fromList $ map swap vs
  
      getN = (vMap Map.!)
      es = [ (getN c1, getN c2, ()) | c1 <- sccs, c2 <- sccs
                                    , (c1 /= c2) && any (hasEdge gr) (liftM2 (,) c1 c2) ]
  