```{- |
Module      : Data.Graph.Analysis.Algorithms.Common
Description : Algorithms for all graph types.
Copyright   : (c) Ivan Lazar Miljenovic 2008
Maintainer  : Ivan.Miljenovic@gmail.com

Defines algorithms that work on both undirected and
directed graphs.
-}
module Data.Graph.Analysis.Algorithms.Common
( -- * Graph decomposition
-- \$connected
componentsOf,
pathTree,
-- * Clique Detection
-- \$cliques
cliquesIn,
cliquesIn',
findRegular,
isRegular,
-- * Cycle Detection
-- \$cycles
cyclesIn,
cyclesIn',
uniqueCycles,
uniqueCycles',
-- * Chain detection
-- \$chains
chainsIn,
chainsIn'
) where

import Data.Graph.Analysis.Types
import Data.Graph.Analysis.Utils

import Data.Graph.Inductive.Graph
-- For linking purposes.  This will throw a warning.
import Data.Graph.Inductive.Query.DFS(components)
import Data.List
import Data.Maybe
import Control.Arrow

-- -----------------------------------------------------------------------------

{- \$connected
Finding connected components.

Whilst the FGL library does indeed have a function 'components'
that returns the connected components of a graph, it returns each
component as a list of 'Node's.  This implementation instead
returns each component as a /graph/, which is much more useful.

Connected components are found by choosing a random node, then
recursively extracting all neighbours of that node until no more
nodes can be removed.

Note that for directed graphs, these are known as the /weakly/
connected components.
-}

-- | Find all connected components of a graph.
componentsOf :: (DynGraph g) => g a b -> [g a b]
componentsOf = unfoldr splitComponent

-- | Find the next component and split it off from the graph.
splitComponent :: (DynGraph g) => g a b -> Maybe (g a b, g a b)
splitComponent g
| isEmpty g = Nothing
| otherwise = Just .          -- Get the type right
first buildGr . -- Create the subgraph
extractNode .   -- Extract components of subgraph
first Just .    -- Getting the types right
matchAny \$ g    -- Choose an arbitrary node to begin with

-- | Extract the given node and all nodes it is transitively
--   connected to from the graph.
extractNode :: (DynGraph g) => Decomp g a b -> ([Context a b], g a b)
extractNode (Nothing,gr) = ([],gr)
extractNode (Just ctxt, gr)
| isEmpty gr = ([ctxt], empty)
| otherwise  = first (ctxt:) \$ foldl' nodeExtractor ([],gr) nbrs
where
nbrs = neighbors' ctxt

-- | Helper function for 'extractNode' above.
nodeExtractor :: (DynGraph g) => ([Context a b], g a b) -> Node
-> ([Context a b], g a b)
nodeExtractor cg@(cs,g) n
| gelem n g = first (++ cs) . extractNode \$ match n g
| otherwise = cg

-- -----------------------------------------------------------------------------

-- | Find all possible paths from this given node, avoiding loops,
--   cycles, etc.
pathTree             :: (DynGraph g) => Decomp g a b -> [NGroup]
pathTree (Nothing,_) = []
pathTree (Just ct,g)
| isEmpty g = []
| null sucs = [[n]]
| otherwise = (:) [n] . map (n:) . concatMap (subPathTree g') \$ sucs
where
n = node' ct
sucs = suc' ct
-- Avoid infinite loops by not letting it continue any further
ct' = makeLeaf ct
g' = ct' & g
subPathTree gr n' = pathTree \$ match n' gr

-- | Remove all outgoing edges
makeLeaf           :: Context a b -> Context a b
makeLeaf (p,n,a,_) = (p', n, a, [])
where
-- Ensure there isn't an edge (n,n)
p' = filter (\(_,n') -> n' /= n) p

-- -----------------------------------------------------------------------------
{- \$cliques
Clique detection routines.  Find cliques by taking out a node, and
seeing which other nodes are all common neighbours (by both 'pre'
and 'suc').
-}

-- | Finds all cliques (i.e. maximal complete subgraphs) in the given graph.
cliquesIn    :: (Graph g) => g a b -> [[LNode a]]
cliquesIn gr = map (addLabels gr) (cliquesIn' gr)

-- | Finds all cliques in the graph, without including labels.
cliquesIn'    :: (Graph g) => g a b -> [NGroup]
cliquesIn' gr = filter (isClique gr) (findRegular gr)

-- | Determine if the given list of nodes is indeed a clique,
--   and not a smaller subgraph of a clique.
isClique       :: (Graph g) => g a b -> NGroup -> Bool
isClique _  [] = False
isClique gr ns = null .
foldl1' intersect .
map ((\\ ns) . corecursive gr) \$ ns

-- | Find all regular subgraphs of the given graph.
findRegular :: (Graph g) => g a b -> [[Node]]
findRegular = concat . unfoldr findRegularOf

-- | Extract the next regular subgraph of a graph.
findRegularOf :: (Graph g) => g a b -> Maybe ([[Node]], g a b)
findRegularOf g
| isEmpty g = Nothing
| otherwise = Just .
first (regularOf g . node') .
matchAny \$ g

-- | Returns all regular subgraphs that include the given node.
regularOf      :: (Graph g) => g a b -> Node -> [[Node]]
regularOf gr n = map (n:) (alsoRegular gr crs)
where
crs = corecursive gr n

-- | Recursively find all regular subgraphs only containing nodes
--   in the given list.
alsoRegular          :: (Graph g) => g a b -> [Node] -> [[Node]]
alsoRegular _ []     = []
alsoRegular _ [n]    = [[n]]
alsoRegular g (n:ns) = [n] : rs ++ (alsoRegular g ns)
where
rs = map (n:) (alsoRegular g \$ intersect crn ns)
crn = corecursive g n

-- | Return all nodes that are co-recursive with the given node
--   (i.e. for n, find all n' such that n->n' and n'->n).
corecursive      :: (Graph g) => g a b -> Node -> [Node]
corecursive gr n = filter (elem n . suc gr) (delete n \$ suc gr n)

-- | Determines if the list of nodes represents a regular subgraph.
isRegular      :: (Graph g) => g a b -> NGroup -> Bool
isRegular g ns = all allCorecursive split
where
-- Node + Rest of list
split = zip ns tns'
tns' = tail \$ tails ns
allCorecursive (n,rs) = null \$ rs \\ (corecursive g n)

-- -----------------------------------------------------------------------------
{- \$cycles
Cycle detection.  Find cycles by finding all paths from a given
node, and seeing if it reaches itself again.
-}

-- | Find all cycles in the given graph.
cyclesIn   :: (DynGraph g) => g a b -> [LNGroup a]
cyclesIn g = map (addLabels g) (cyclesIn' g)

-- | Find all cycles in the given graph, returning just the nodes.
cyclesIn' :: (DynGraph g) => g a b -> [NGroup]
cyclesIn' = filter (not . single) -- Exclude trivial cycles, i.e. loops
. concat . unfoldr findCycles

-- | Find all cycles in the given graph, excluding those that are also cliques.
uniqueCycles   :: (DynGraph g) => g a b -> [LNGroup a]
uniqueCycles g = map (addLabels g) (uniqueCycles' g)

-- | Find all cycles in the given graph, excluding those that are also cliques.
uniqueCycles'   :: (DynGraph g) => g a b -> [NGroup]
uniqueCycles' g = filter (not . isRegular g) (cyclesIn' g)

-- | Find all cycles containing a chosen node.
findCycles :: (DynGraph g) => g a b -> Maybe ([NGroup], g a b)
findCycles g
| isEmpty g = Nothing
| otherwise = Just . getCycles . matchAny \$ g
where
getCycles (ctx,g') = (cyclesFor (ctx, g'), g')

-- | Find all cycles for the given node.
cyclesFor :: (DynGraph g) => GDecomp g a b -> [NGroup]
cyclesFor = map init .
filter isCycle .
pathTree .
first Just
where
isCycle p = (not \$ single p) && ((head p) == (last p))

-- -----------------------------------------------------------------------------

{- \$chains
A chain is a path in a graph where for each interior node, there is
exactly one predecessor and one successor node, i.e. that part of
the graph forms a \"straight line\".  Furthermore, the initial node
should have only one successor, and the final node should have only
one predecessor.  Chains are found by recursively finding the next
successor in the chain, until either a leaf node is reached or no
more nodes match the criteria.
-}

-- | Find all chains in the given graph.
chainsIn   :: (DynGraph g, Eq b) => g a b -> [LNGroup a]
chainsIn g = map (addLabels g)
\$ chainsIn' g

-- | Find all chains in the given graph.
chainsIn'   :: (DynGraph g, Eq b) => g a b -> [NGroup]
chainsIn' g = filter (not . single) -- Remove trivial chains
. map (getChain g')
\$ filterNodes' isChainStart g'
where
-- Try to make this work on two-element cycles, undirected
-- graphs, etc.
g' = oneWay g

-- | Find the chain starting with the given 'Node'.
getChain     :: (Graph g) => g a b -> Node -> NGroup
getChain g n = n : (unfoldr (chainLink g) (chainNext g n))

-- | Find the next link in the chain.
chainLink :: (Graph g) => g a b -> Maybe Node
-> Maybe (Node, Maybe Node)
| isEmpty g         = Nothing
| not \$ hasPrev g n = Nothing
| otherwise         = Just (n, chainNext g n)

-- | Determines if the given node is the start of a chain.
isChainStart     :: (Graph g) => g a b -> Node -> Bool
isChainStart g n = (hasNext g n)
&& case (pre g n \\ [n]) of
[n'] -> not \$ isChainStart g n'
_    -> True

-- | Determine if the given node matches the chain criteria in the given
--   direction, and if so what the next node in that direction is.
chainFind         :: (Graph g) => (g a b -> Node -> NGroup)
-> g a b -> Node -> Maybe Node
chainFind f g n = case ((nub \$ f g n) \\ [n]) of
[n'] -> Just n'
_    -> Nothing

-- | Find the next node in the chain.
chainNext :: (Graph g) => g a b -> Node -> Maybe Node
chainNext = chainFind suc

-- | Determines if this node matches the successor criteria for chains.
hasNext   :: (Graph g) => g a b -> Node -> Bool
hasNext g = isJust . chainNext g

-- | Determines if this node matches the predecessor criteria for chains.
hasPrev   :: (Graph g) => g a b -> Node -> Bool
hasPrev g = isJust . chainFind pre g
```