-- (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 :: forall (gr :: * -> * -> *) a b c.
Graph gr =>
([Node] -> gr a b -> c) -> gr a b -> c
fixNodes [Node] -> gr a b -> c
f gr a b
g = [Node] -> gr a b -> c
f (forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [Node]
nodes gr a b
g) gr a b
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 :: forall (gr :: * -> * -> *) a b c.
Graph gr =>
CFun a b [Node] -> CFun a b c -> [Node] -> gr a b -> [c]
xdfsWith CFun a b [Node]
_ CFun a b c
_ []     gr a b
_             = []
xdfsWith CFun a b [Node]
_ CFun a b c
_ [Node]
_      gr a b
g | forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Bool
isEmpty gr a b
g = []
xdfsWith CFun a b [Node]
d CFun a b c
f (Node
v:[Node]
vs) gr a b
g = case forall (gr :: * -> * -> *) a b.
Graph gr =>
Node -> gr a b -> Decomp gr a b
match Node
v gr a b
g of
                         (Just Context a b
c,gr a b
g')  -> CFun a b c
f Context a b
cforall a. a -> [a] -> [a]
:forall (gr :: * -> * -> *) a b c.
Graph gr =>
CFun a b [Node] -> CFun a b c -> [Node] -> gr a b -> [c]
xdfsWith CFun a b [Node]
d CFun a b c
f (CFun a b [Node]
d Context a b
cforall a. [a] -> [a] -> [a]
++[Node]
vs) gr a b
g'
                         (MContext a b
Nothing,gr a b
g') -> forall (gr :: * -> * -> *) a b c.
Graph gr =>
CFun a b [Node] -> CFun a b c -> [Node] -> gr a b -> [c]
xdfsWith CFun a b [Node]
d CFun a b c
f [Node]
vs gr a b
g'


-- | Depth-first search.
dfs :: (Graph gr) => [Node] -> gr a b -> [Node]
dfs :: forall (gr :: * -> * -> *) a b.
Graph gr =>
[Node] -> gr a b -> [Node]
dfs = forall (gr :: * -> * -> *) a b c.
Graph gr =>
CFun a b c -> [Node] -> gr a b -> [c]
dfsWith forall a b. Context a b -> Node
node'

dfsWith :: (Graph gr) => CFun a b c -> [Node] -> gr a b -> [c]
dfsWith :: forall (gr :: * -> * -> *) a b c.
Graph gr =>
CFun a b c -> [Node] -> gr a b -> [c]
dfsWith = forall (gr :: * -> * -> *) a b c.
Graph gr =>
CFun a b [Node] -> CFun a b c -> [Node] -> gr a b -> [c]
xdfsWith forall a b. Context a b -> [Node]
suc'

dfsWith' :: (Graph gr) => CFun a b c -> gr a b -> [c]
dfsWith' :: forall (gr :: * -> * -> *) a b c.
Graph gr =>
CFun a b c -> gr a b -> [c]
dfsWith' CFun a b c
f = forall (gr :: * -> * -> *) a b c.
Graph gr =>
([Node] -> gr a b -> c) -> gr a b -> c
fixNodes (forall (gr :: * -> * -> *) a b c.
Graph gr =>
CFun a b c -> [Node] -> gr a b -> [c]
dfsWith CFun a b c
f)

dfs' :: (Graph gr) => gr a b -> [Node]
dfs' :: forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [Node]
dfs' = forall (gr :: * -> * -> *) a b c.
Graph gr =>
CFun a b c -> gr a b -> [c]
dfsWith' forall a b. Context a b -> Node
node'


-- | Undirected depth-first search, obtained by following edges regardless
--   of their direction.
udfs :: (Graph gr) => [Node] -> gr a b -> [Node]
udfs :: forall (gr :: * -> * -> *) a b.
Graph gr =>
[Node] -> gr a b -> [Node]
udfs = forall (gr :: * -> * -> *) a b c.
Graph gr =>
CFun a b [Node] -> CFun a b c -> [Node] -> gr a b -> [c]
xdfsWith forall a b. Context a b -> [Node]
neighbors' forall a b. Context a b -> Node
node'

udfs' :: (Graph gr) => gr a b -> [Node]
udfs' :: forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [Node]
udfs' = forall (gr :: * -> * -> *) a b c.
Graph gr =>
([Node] -> gr a b -> c) -> gr a b -> c
fixNodes forall (gr :: * -> * -> *) a b.
Graph gr =>
[Node] -> gr a b -> [Node]
udfs


-- | Reverse depth-first search, obtained by following predecessors.
rdfs :: (Graph gr) => [Node] -> gr a b -> [Node]
rdfs :: forall (gr :: * -> * -> *) a b.
Graph gr =>
[Node] -> gr a b -> [Node]
rdfs = forall (gr :: * -> * -> *) a b c.
Graph gr =>
CFun a b [Node] -> CFun a b c -> [Node] -> gr a b -> [c]
xdfsWith forall a b. Context a b -> [Node]
pre' forall a b. Context a b -> Node
node'

rdfs' :: (Graph gr) => gr a b -> [Node]
rdfs' :: forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [Node]
rdfs' = forall (gr :: * -> * -> *) a b c.
Graph gr =>
([Node] -> gr a b -> c) -> gr a b -> c
fixNodes forall (gr :: * -> * -> *) a b.
Graph gr =>
[Node] -> gr a b -> [Node]
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 :: forall (gr :: * -> * -> *) a b c.
Graph gr =>
CFun a b [Node]
-> CFun a b c -> [Node] -> gr a b -> ([Tree c], gr a b)
xdfWith CFun a b [Node]
_ CFun a b c
_ []     gr a b
g             = ([],gr a b
g)
xdfWith CFun a b [Node]
_ CFun a b c
_ [Node]
_      gr a b
g | forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Bool
isEmpty gr a b
g = ([],gr a b
g)
xdfWith CFun a b [Node]
d CFun a b c
f (Node
v:[Node]
vs) gr a b
g = case forall (gr :: * -> * -> *) a b.
Graph gr =>
Node -> gr a b -> Decomp gr a b
match Node
v gr a b
g of
                        (MContext a b
Nothing,gr a b
g1) -> forall (gr :: * -> * -> *) a b c.
Graph gr =>
CFun a b [Node]
-> CFun a b c -> [Node] -> gr a b -> ([Tree c], gr a b)
xdfWith CFun a b [Node]
d CFun a b c
f [Node]
vs gr a b
g1
                        (Just Context a b
c,gr a b
g1)  -> (forall a. a -> [Tree a] -> Tree a
Node (CFun a b c
f Context a b
c) [Tree c]
tsforall a. a -> [a] -> [a]
:[Tree c]
ts',gr a b
g3)
                                 where ([Tree c]
ts,gr a b
g2)  = forall (gr :: * -> * -> *) a b c.
Graph gr =>
CFun a b [Node]
-> CFun a b c -> [Node] -> gr a b -> ([Tree c], gr a b)
xdfWith CFun a b [Node]
d CFun a b c
f (CFun a b [Node]
d Context a b
c) gr a b
g1
                                       ([Tree c]
ts',gr a b
g3) = forall (gr :: * -> * -> *) a b c.
Graph gr =>
CFun a b [Node]
-> CFun a b c -> [Node] -> gr a b -> ([Tree c], gr a b)
xdfWith CFun a b [Node]
d CFun a b c
f [Node]
vs gr a b
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 :: forall (gr :: * -> * -> *) a b c.
Graph gr =>
CFun a b [Node] -> CFun a b c -> [Node] -> gr a b -> [Tree c]
xdffWith CFun a b [Node]
d CFun a b c
f [Node]
vs gr a b
g = forall a b. (a, b) -> a
fst (forall (gr :: * -> * -> *) a b c.
Graph gr =>
CFun a b [Node]
-> CFun a b c -> [Node] -> gr a b -> ([Tree c], gr a b)
xdfWith CFun a b [Node]
d CFun a b c
f [Node]
vs gr a b
g)



-- | Directed depth-first forest.
dff :: (Graph gr) => [Node] -> gr a b -> [Tree Node]
dff :: forall (gr :: * -> * -> *) a b.
Graph gr =>
[Node] -> gr a b -> [Tree Node]
dff = forall (gr :: * -> * -> *) a b c.
Graph gr =>
CFun a b c -> [Node] -> gr a b -> [Tree c]
dffWith forall a b. Context a b -> Node
node'

dffWith :: (Graph gr) => CFun a b c -> [Node] -> gr a b -> [Tree c]
dffWith :: forall (gr :: * -> * -> *) a b c.
Graph gr =>
CFun a b c -> [Node] -> gr a b -> [Tree c]
dffWith = forall (gr :: * -> * -> *) a b c.
Graph gr =>
CFun a b [Node] -> CFun a b c -> [Node] -> gr a b -> [Tree c]
xdffWith forall a b. Context a b -> [Node]
suc'

dffWith' :: (Graph gr) => CFun a b c -> gr a b -> [Tree c]
dffWith' :: forall (gr :: * -> * -> *) a b c.
Graph gr =>
CFun a b c -> gr a b -> [Tree c]
dffWith' CFun a b c
f = forall (gr :: * -> * -> *) a b c.
Graph gr =>
([Node] -> gr a b -> c) -> gr a b -> c
fixNodes (forall (gr :: * -> * -> *) a b c.
Graph gr =>
CFun a b c -> [Node] -> gr a b -> [Tree c]
dffWith CFun a b c
f)

dff' :: (Graph gr) => gr a b -> [Tree Node]
dff' :: forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [Tree Node]
dff' = forall (gr :: * -> * -> *) a b c.
Graph gr =>
CFun a b c -> gr a b -> [Tree c]
dffWith' forall a b. Context a b -> Node
node'



-- | Undirected depth-first forest, obtained by following edges regardless
--   of their direction.
udff :: (Graph gr) => [Node] -> gr a b -> [Tree Node]
udff :: forall (gr :: * -> * -> *) a b.
Graph gr =>
[Node] -> gr a b -> [Tree Node]
udff = forall (gr :: * -> * -> *) a b c.
Graph gr =>
CFun a b c -> [Node] -> gr a b -> [Tree c]
udffWith forall a b. Context a b -> Node
node'

udffWith :: (Graph gr) => CFun a b c -> [Node] -> gr a b -> [Tree c]
udffWith :: forall (gr :: * -> * -> *) a b c.
Graph gr =>
CFun a b c -> [Node] -> gr a b -> [Tree c]
udffWith = forall (gr :: * -> * -> *) a b c.
Graph gr =>
CFun a b [Node] -> CFun a b c -> [Node] -> gr a b -> [Tree c]
xdffWith forall a b. Context a b -> [Node]
neighbors'

udffWith' :: (Graph gr) => CFun a b c -> gr a b -> [Tree c]
udffWith' :: forall (gr :: * -> * -> *) a b c.
Graph gr =>
CFun a b c -> gr a b -> [Tree c]
udffWith' CFun a b c
f = forall (gr :: * -> * -> *) a b c.
Graph gr =>
([Node] -> gr a b -> c) -> gr a b -> c
fixNodes (forall (gr :: * -> * -> *) a b c.
Graph gr =>
CFun a b c -> [Node] -> gr a b -> [Tree c]
udffWith CFun a b c
f)

udff' :: (Graph gr) => gr a b -> [Tree Node]
udff' :: forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [Tree Node]
udff' = forall (gr :: * -> * -> *) a b c.
Graph gr =>
CFun a b c -> gr a b -> [Tree c]
udffWith' forall a b. Context a b -> Node
node'


-- | Reverse depth-first forest, obtained by following predecessors.
rdff :: (Graph gr) => [Node] -> gr a b -> [Tree Node]
rdff :: forall (gr :: * -> * -> *) a b.
Graph gr =>
[Node] -> gr a b -> [Tree Node]
rdff = forall (gr :: * -> * -> *) a b c.
Graph gr =>
CFun a b c -> [Node] -> gr a b -> [Tree c]
rdffWith forall a b. Context a b -> Node
node'

rdffWith :: (Graph gr) => CFun a b c -> [Node] -> gr a b -> [Tree c]
rdffWith :: forall (gr :: * -> * -> *) a b c.
Graph gr =>
CFun a b c -> [Node] -> gr a b -> [Tree c]
rdffWith = forall (gr :: * -> * -> *) a b c.
Graph gr =>
CFun a b [Node] -> CFun a b c -> [Node] -> gr a b -> [Tree c]
xdffWith forall a b. Context a b -> [Node]
pre'

rdffWith' :: (Graph gr) => CFun a b c -> gr a b -> [Tree c]
rdffWith' :: forall (gr :: * -> * -> *) a b c.
Graph gr =>
CFun a b c -> gr a b -> [Tree c]
rdffWith' CFun a b c
f = forall (gr :: * -> * -> *) a b c.
Graph gr =>
([Node] -> gr a b -> c) -> gr a b -> c
fixNodes (forall (gr :: * -> * -> *) a b c.
Graph gr =>
CFun a b c -> [Node] -> gr a b -> [Tree c]
rdffWith CFun a b c
f)

rdff' :: (Graph gr) => gr a b -> [Tree Node]
rdff' :: forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [Tree Node]
rdff' = forall (gr :: * -> * -> *) a b c.
Graph gr =>
CFun a b c -> gr a b -> [Tree c]
rdffWith' forall a b. Context a b -> Node
node'


----------------------------------------------------------------------
-- ALGORITHMS BASED ON DFS
----------------------------------------------------------------------

-- | Collection of connected components
components :: (Graph gr) => gr a b -> [[Node]]
components :: forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [[Node]]
components = forall a b. (a -> b) -> [a] -> [b]
map forall a. Tree a -> [a]
preorder forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [Tree Node]
udff'

-- | Number of connected components
noComponents :: (Graph gr) => gr a b -> Int
noComponents :: forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Node
noComponents = forall (t :: * -> *) a. Foldable t => t a -> Node
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [[Node]]
components

-- | Is the graph connected?
isConnected :: (Graph gr) => gr a b -> Bool
isConnected :: forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Bool
isConnected = (forall a. Eq a => a -> a -> Bool
==Node
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Node
noComponents

-- | Flatten a 'Tree' in reverse order
postflatten :: Tree a -> [a]
postflatten :: forall a. Tree a -> [a]
postflatten (Node a
v [Tree a]
ts) = forall a. [Tree a] -> [a]
postflattenF [Tree a]
ts forall a. [a] -> [a] -> [a]
++ [a
v]

-- | Flatten a forest in reverse order
postflattenF :: [Tree a] -> [a]
postflattenF :: forall a. [Tree a] -> [a]
postflattenF = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. Tree a -> [a]
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 :: forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [Node]
topsort = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Tree a] -> [a]
postflattenF forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [Tree Node]
dff'

-- | 'topsort', returning only the labels of the nodes.
topsort' :: (Graph gr) => gr a b -> [a]
topsort' :: forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [a]
topsort' = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Tree a] -> [a]
postorderF forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (gr :: * -> * -> *) a b c.
Graph gr =>
CFun a b c -> gr a b -> [Tree c]
dffWith' forall a b. Context a b -> a
lab'

-- | Collection of strongly connected components
scc :: (Graph gr) => gr a b -> [[Node]]
scc :: forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [[Node]]
scc gr a b
g = forall a b. (a -> b) -> [a] -> [b]
map forall a. Tree a -> [a]
preorder (forall (gr :: * -> * -> *) a b.
Graph gr =>
[Node] -> gr a b -> [Tree Node]
rdff (forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [Node]
topsort gr a b
g) gr a b
g)

-- | Collection of nodes reachable from a starting point.
reachable :: (Graph gr) => Node -> gr a b -> [Node]
reachable :: forall (gr :: * -> * -> *) a b.
Graph gr =>
Node -> gr a b -> [Node]
reachable Node
v gr a b
g = forall a. [Tree a] -> [a]
preorderF (forall (gr :: * -> * -> *) a b.
Graph gr =>
[Node] -> gr a b -> [Tree Node]
dff [Node
v] gr a b
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 :: forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> gr [Node] ()
condensation gr a b
gr = forall (gr :: * -> * -> *) a b.
Graph gr =>
[LNode a] -> [LEdge b] -> gr a b
mkGraph [(Node, [Node])]
vs [(Node, Node, ())]
es
  where
    sccs :: [[Node]]
sccs = forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [[Node]]
scc gr a b
gr
    vs :: [(Node, [Node])]
vs = forall a b. [a] -> [b] -> [(a, b)]
zip [Node
1..] [[Node]]
sccs
    vMap :: Map [Node] Node
vMap = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> (b, a)
swap [(Node, [Node])]
vs

    getN :: [Node] -> Node
getN = (Map [Node] Node
vMap forall k a. Ord k => Map k a -> k -> a
Map.!)
    es :: [(Node, Node, ())]
es = [ ([Node] -> Node
getN [Node]
c1, [Node] -> Node
getN [Node]
c2, ()) | [Node]
c1 <- [[Node]]
sccs, [Node]
c2 <- [[Node]]
sccs
                                  , ([Node]
c1 forall a. Eq a => a -> a -> Bool
/= [Node]
c2) Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Edge -> Bool
hasEdge gr a b
gr) (forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) [Node]
c1 [Node]
c2) ]