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

{-|
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 = [gr a b] -> [Int] -> [gr a b]
forall (gr :: * -> * -> *) a b.
DynGraph gr =>
[gr a b] -> [Int] -> [gr a b]
splitGraphs [gr a b
g] (gr a b -> [Int]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [Int]
ap gr a b
g)