-- (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) ]