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
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
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)
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
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)