module Data.Graph.Inductive.Query.BCC(
    bcc
) where


import Data.Graph.Inductive.Graph
import Data.Graph.Inductive.Query.ArtPoint
import Data.Graph.Inductive.Query.DFS


------------------------------------------------------------------------------
-- Given a graph g, this function computes the subgraphs which are
-- g's connected components.
------------------------------------------------------------------------------
gComponents :: (DynGraph gr) => gr a b -> [gr a b]
gComponents :: forall (gr :: * -> * -> *) a b. DynGraph gr => gr a b -> [gr a b]
gComponents gr a b
g = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall (gr :: * -> * -> *) a b.
Graph gr =>
[LNode a] -> [LEdge b] -> gr a b
mkGraph [[(Node, a)]]
ln [[(Node, Node, b)]]
le
            where ln :: [[(Node, a)]]
ln         = forall a b. (a -> b) -> [a] -> [b]
map (\[Node]
x->[(Node
u,a
l)|(Node
u,a
l)<-[(Node, a)]
vs,Node
u forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Node]
x]) [[Node]]
cc
                  le :: [[(Node, Node, b)]]
le         = forall a b. (a -> b) -> [a] -> [b]
map (\[Node]
x->[(Node
u,Node
v,b
l)|(Node
u,Node
v,b
l)<-[(Node, Node, b)]
es,Node
u forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Node]
x]) [[Node]]
cc
                  ([(Node, a)]
vs,[(Node, Node, b)]
es,[[Node]]
cc) = (forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LNode a]
labNodes gr a b
g,forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LEdge b]
labEdges gr a b
g,forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [[Node]]
components gr a b
g)


embedContexts :: (DynGraph gr) => Context a b -> [gr a b] -> [gr a b]
embedContexts :: forall (gr :: * -> * -> *) a b.
DynGraph gr =>
Context a b -> [gr a b] -> [gr a b]
embedContexts (Adj b
_,Node
v,a
l,Adj b
s) [gr a b]
gs = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall (gr :: * -> * -> *) a b.
DynGraph gr =>
Context a b -> gr a b -> gr a b
(&) [(Adj b, Node, a, Adj b)]
lc [gr a b]
gs
                  where lc :: [(Adj b, Node, a, Adj b)]
lc = forall a b. (a -> b) -> [a] -> [b]
map (\Adj b
e->(Adj b
e,Node
v,a
l,Adj b
e)) [Adj b]
lc'
                        lc' :: [Adj b]
lc'= forall a b. (a -> b) -> [a] -> [b]
map (\gr a b
g->[ (b, Node)
e | (b, Node)
e <- Adj b
s, forall (gr :: * -> * -> *) a b. Graph gr => Node -> gr a b -> Bool
gelem (forall a b. (a, b) -> b
snd (b, Node)
e) gr a b
g]) [gr a b]
gs

------------------------------------------------------------------------------
-- Given a node v and a list of graphs, this function returns the graph which
-- v belongs to, together with a list of the remaining graphs.
------------------------------------------------------------------------------
findGraph :: (DynGraph gr) => Node -> [gr a b] -> (Decomp gr a b, [gr a b])
findGraph :: forall (gr :: * -> * -> *) a b.
DynGraph gr =>
Node -> [gr a b] -> (Decomp gr a b, [gr a b])
findGraph Node
_ [] = forall a. HasCallStack => [Char] -> a
error [Char]
"findGraph: empty graph list"
findGraph Node
v (gr a b
g:[gr a b]
gs) = case forall (gr :: * -> * -> *) a b.
Graph gr =>
Node -> gr a b -> Decomp gr a b
match Node
v gr a b
g of
                          (Maybe (Context a b)
Nothing,  gr a b
g') -> let (Decomp gr a b
d, [gr a b]
gs') = forall (gr :: * -> * -> *) a b.
DynGraph gr =>
Node -> [gr a b] -> (Decomp gr a b, [gr a b])
findGraph Node
v [gr a b]
gs
                                            in (Decomp gr a b
d, gr a b
g' forall a. a -> [a] -> [a]
: [gr a b]
gs')
                          (Just Context a b
c,  gr a b
g') -> ((forall a. a -> Maybe a
Just Context a b
c, gr a b
g'), [gr a b]
gs)

------------------------------------------------------------------------------
-- Given a graph g and its articulation points, this function disconnects g
-- for each articulation point and returns the connected components of the
-- resulting disconnected graph.
------------------------------------------------------------------------------
splitGraphs :: (DynGraph gr) => [gr a b] -> [Node] -> [gr a b]
splitGraphs :: forall (gr :: * -> * -> *) a b.
DynGraph gr =>
[gr a b] -> [Node] -> [gr a b]
splitGraphs [gr a b]
gs []     = [gr a b]
gs
splitGraphs [] [Node]
_      = forall a. HasCallStack => [Char] -> a
error [Char]
"splitGraphs: empty graph list"
splitGraphs [gr a b]
gs (Node
v:[Node]
vs) = forall (gr :: * -> * -> *) a b.
DynGraph gr =>
[gr a b] -> [Node] -> [gr a b]
splitGraphs ([gr a b]
gs''forall a. [a] -> [a] -> [a]
++[gr a b]
gs''') [Node]
vs
                        where gs'' :: [gr a b]
gs'' = forall (gr :: * -> * -> *) a b.
DynGraph gr =>
Context a b -> [gr a b] -> [gr a b]
embedContexts Context a b
c [gr a b]
gs'
                              gs' :: [gr a b]
gs' = forall (gr :: * -> * -> *) a b. DynGraph gr => gr a b -> [gr a b]
gComponents gr a b
g'
                              ((Just Context a b
c,gr a b
g'), [gr a b]
gs''') = forall (gr :: * -> * -> *) a b.
DynGraph gr =>
Node -> [gr a b] -> (Decomp gr a b, [gr a b])
findGraph Node
v [gr a b]
gs

{-|
Finds the bi-connected components of an undirected connected graph.
It first finds the articulation points of the graph. Then it disconnects the
graph on each articulation point and computes the connected components.
-}
bcc :: (DynGraph gr) => gr a b -> [gr a b]
bcc :: forall (gr :: * -> * -> *) a b. DynGraph gr => gr a b -> [gr a b]
bcc gr a b
g = forall (gr :: * -> * -> *) a b.
DynGraph gr =>
[gr a b] -> [Node] -> [gr a b]
splitGraphs [gr a b
g] (forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [Node]
ap gr a b
g)