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 :: gr a b -> [gr a b]
gComponents gr a b
g = ([LNode a] -> [LEdge b] -> gr a b)
-> [[LNode a]] -> [[LEdge b]] -> [gr a b]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith [LNode a] -> [LEdge b] -> gr a b
forall (gr :: * -> * -> *) a b.
Graph gr =>
[LNode a] -> [LEdge b] -> gr a b
mkGraph [[LNode a]]
ln [[LEdge b]]
le
            where ln :: [[LNode a]]
ln         = ([Node] -> [LNode a]) -> [[Node]] -> [[LNode a]]
forall a b. (a -> b) -> [a] -> [b]
map (\[Node]
x->[(Node
u,a
l)|(Node
u,a
l)<-[LNode a]
vs,Node
u Node -> [Node] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Node]
x]) [[Node]]
cc
                  le :: [[LEdge b]]
le         = ([Node] -> [LEdge b]) -> [[Node]] -> [[LEdge b]]
forall a b. (a -> b) -> [a] -> [b]
map (\[Node]
x->[(Node
u,Node
v,b
l)|(Node
u,Node
v,b
l)<-[LEdge b]
es,Node
u Node -> [Node] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Node]
x]) [[Node]]
cc
                  ([LNode a]
vs,[LEdge b]
es,[[Node]]
cc) = (gr a b -> [LNode a]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LNode a]
labNodes gr a b
g,gr a b -> [LEdge b]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LEdge b]
labEdges gr a b
g,gr a b -> [[Node]]
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 :: Context a b -> [gr a b] -> [gr a b]
embedContexts (Adj b
_,Node
v,a
l,Adj b
s) [gr a b]
gs = (Context a b -> gr a b -> gr a b)
-> [Context a b] -> [gr a b] -> [gr a b]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Context a b -> gr a b -> gr a b
forall (gr :: * -> * -> *) a b.
DynGraph gr =>
Context a b -> gr a b -> gr a b
(&) [Context a b]
lc [gr a b]
gs
                  where lc :: [Context a b]
lc = (Adj b -> Context a b) -> [Adj b] -> [Context a b]
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'= (gr a b -> Adj b) -> [gr a b] -> [Adj b]
forall a b. (a -> b) -> [a] -> [b]
map (\gr a b
g->[ (b, Node)
e | (b, Node)
e <- Adj b
s, Node -> gr a b -> Bool
forall (gr :: * -> * -> *) a b. Graph gr => Node -> gr a b -> Bool
gelem ((b, Node) -> Node
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 :: Node -> [gr a b] -> (Decomp gr a b, [gr a b])
findGraph Node
_ [] = [Char] -> (Decomp gr a b, [gr a b])
forall a. HasCallStack => [Char] -> a
error [Char]
"findGraph: empty graph list"
findGraph Node
v (gr a b
g:[gr a b]
gs) = case Node -> gr a b -> Decomp gr a b
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') = Node -> [gr a b] -> (Decomp gr a b, [gr a b])
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' gr a b -> [gr a b] -> [gr a b]
forall a. a -> [a] -> [a]
: [gr a b]
gs')
                          (Just Context a b
c,  gr a b
g') -> ((Context a b -> Maybe (Context a b)
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 :: [gr a b] -> [Node] -> [gr a b]
splitGraphs [gr a b]
gs []     = [gr a b]
gs
splitGraphs [] [Node]
_      = [Char] -> [gr a b]
forall a. HasCallStack => [Char] -> a
error [Char]
"splitGraphs: empty graph list"
splitGraphs [gr a b]
gs (Node
v:[Node]
vs) = [gr a b] -> [Node] -> [gr a b]
forall (gr :: * -> * -> *) a b.
DynGraph gr =>
[gr a b] -> [Node] -> [gr a b]
splitGraphs ([gr a b]
gs''[gr a b] -> [gr a b] -> [gr a b]
forall a. [a] -> [a] -> [a]
++[gr a b]
gs''') [Node]
vs
                        where gs'' :: [gr a b]
gs'' = Context a b -> [gr a b] -> [gr a b]
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' = gr a b -> [gr a b]
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''') = Node -> [gr a b] -> ((Maybe (Context a b), gr a b), [gr a b])
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 :: gr a b -> [gr a b]
bcc gr a b
g = [gr a b] -> [Node] -> [gr a b]
forall (gr :: * -> * -> *) a b.
DynGraph gr =>
[gr a b] -> [Node] -> [gr a b]
splitGraphs [gr a b
g] (gr a b -> [Node]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [Node]
ap gr a b
g)