{-# LANGUAGE CPP, Safe #-}
module Data.Graph.SCC
( scc
, sccList
, sccListR
, sccGraph
, stronglyConnComp
, stronglyConnCompR
) where
#ifdef USE_MAPS
import Data.Graph.MapSCC
#else
import Data.Graph.ArraySCC
#endif
import Data.Graph(SCC(..),Graph,Vertex,graphFromEdges')
import Data.Array as A
import Data.List(nub)
sccList :: Graph -> [SCC Vertex]
sccList :: Graph -> [SCC Vertex]
sccList g :: Graph
g = [SCC Vertex] -> [SCC Vertex]
forall a. [a] -> [a]
reverse ([SCC Vertex] -> [SCC Vertex]) -> [SCC Vertex] -> [SCC Vertex]
forall a b. (a -> b) -> a -> b
$ ((Vertex, [Vertex]) -> SCC Vertex)
-> [(Vertex, [Vertex])] -> [SCC Vertex]
forall a b. (a -> b) -> [a] -> [b]
map (Graph -> (Vertex -> Vertex) -> (Vertex, [Vertex]) -> SCC Vertex
to_scc Graph
g Vertex -> Vertex
lkp) [(Vertex, [Vertex])]
cs
where (cs :: [(Vertex, [Vertex])]
cs,lkp :: Vertex -> Vertex
lkp) = Graph -> ([(Vertex, [Vertex])], Vertex -> Vertex)
scc Graph
g
sccListR :: Graph -> [SCC (Vertex,[Vertex])]
sccListR :: Graph -> [SCC (Vertex, [Vertex])]
sccListR g :: Graph
g = [SCC (Vertex, [Vertex])] -> [SCC (Vertex, [Vertex])]
forall a. [a] -> [a]
reverse ([SCC (Vertex, [Vertex])] -> [SCC (Vertex, [Vertex])])
-> [SCC (Vertex, [Vertex])] -> [SCC (Vertex, [Vertex])]
forall a b. (a -> b) -> a -> b
$ ((Vertex, [Vertex]) -> SCC (Vertex, [Vertex]))
-> [(Vertex, [Vertex])] -> [SCC (Vertex, [Vertex])]
forall a b. (a -> b) -> [a] -> [b]
map (Vertex, [Vertex]) -> SCC (Vertex, [Vertex])
cvt [(Vertex, [Vertex])]
cs
where (cs :: [(Vertex, [Vertex])]
cs,lkp :: Vertex -> Vertex
lkp) = Graph -> ([(Vertex, [Vertex])], Vertex -> Vertex)
scc Graph
g
cvt :: (Vertex, [Vertex]) -> SCC (Vertex, [Vertex])
cvt (n :: Vertex
n,[v :: Vertex
v]) = let adj :: [Vertex]
adj = Graph
g Graph -> Vertex -> [Vertex]
forall i e. Ix i => Array i e -> i -> e
! Vertex
v
in if Vertex
n Vertex -> [Vertex] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Vertex -> Vertex) -> [Vertex] -> [Vertex]
forall a b. (a -> b) -> [a] -> [b]
map Vertex -> Vertex
lkp [Vertex]
adj
then [(Vertex, [Vertex])] -> SCC (Vertex, [Vertex])
forall vertex. [vertex] -> SCC vertex
CyclicSCC [(Vertex
v,[Vertex]
adj)]
else (Vertex, [Vertex]) -> SCC (Vertex, [Vertex])
forall vertex. vertex -> SCC vertex
AcyclicSCC (Vertex
v,[Vertex]
adj)
cvt (_,vs :: [Vertex]
vs) = [(Vertex, [Vertex])] -> SCC (Vertex, [Vertex])
forall vertex. [vertex] -> SCC vertex
CyclicSCC [ (Vertex
v, Graph
g Graph -> Vertex -> [Vertex]
forall i e. Ix i => Array i e -> i -> e
! Vertex
v) | Vertex
v <- [Vertex]
vs ]
sccGraph :: Graph -> [(SCC Int, Int, [Int])]
sccGraph :: Graph -> [(SCC Vertex, Vertex, [Vertex])]
sccGraph g :: Graph
g = ((Vertex, [Vertex]) -> (SCC Vertex, Vertex, [Vertex]))
-> [(Vertex, [Vertex])] -> [(SCC Vertex, Vertex, [Vertex])]
forall a b. (a -> b) -> [a] -> [b]
map (Vertex, [Vertex]) -> (SCC Vertex, Vertex, [Vertex])
to_node [(Vertex, [Vertex])]
cs
where (cs :: [(Vertex, [Vertex])]
cs,lkp :: Vertex -> Vertex
lkp) = Graph -> ([(Vertex, [Vertex])], Vertex -> Vertex)
scc Graph
g
to_node :: (Vertex, [Vertex]) -> (SCC Vertex, Vertex, [Vertex])
to_node x :: (Vertex, [Vertex])
x@(n :: Vertex
n,this :: [Vertex]
this) = ( Graph -> (Vertex -> Vertex) -> (Vertex, [Vertex]) -> SCC Vertex
to_scc Graph
g Vertex -> Vertex
lkp (Vertex, [Vertex])
x
, Vertex
n
, [Vertex] -> [Vertex]
forall a. Eq a => [a] -> [a]
nub ([Vertex] -> [Vertex]) -> [Vertex] -> [Vertex]
forall a b. (a -> b) -> a -> b
$ (Vertex -> [Vertex]) -> [Vertex] -> [Vertex]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Vertex -> Vertex) -> [Vertex] -> [Vertex]
forall a b. (a -> b) -> [a] -> [b]
map Vertex -> Vertex
lkp ([Vertex] -> [Vertex])
-> (Vertex -> [Vertex]) -> Vertex -> [Vertex]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Graph
g Graph -> Vertex -> [Vertex]
forall i e. Ix i => Array i e -> i -> e
!)) [Vertex]
this
)
stronglyConnComp :: Ord key => [(node, key, [key])] -> [SCC node]
stronglyConnComp :: [(node, key, [key])] -> [SCC node]
stronglyConnComp es :: [(node, key, [key])]
es = [SCC node] -> [SCC node]
forall a. [a] -> [a]
reverse ([SCC node] -> [SCC node]) -> [SCC node] -> [SCC node]
forall a b. (a -> b) -> a -> b
$ ((Vertex, [Vertex]) -> SCC node)
-> [(Vertex, [Vertex])] -> [SCC node]
forall a b. (a -> b) -> [a] -> [b]
map (Vertex, [Vertex]) -> SCC node
cvt [(Vertex, [Vertex])]
cs
where (g :: Graph
g,back :: Vertex -> (node, key, [key])
back) = [(node, key, [key])] -> (Graph, Vertex -> (node, key, [key]))
forall key node.
Ord key =>
[(node, key, [key])] -> (Graph, Vertex -> (node, key, [key]))
graphFromEdges' [(node, key, [key])]
es
(cs :: [(Vertex, [Vertex])]
cs,lkp :: Vertex -> Vertex
lkp) = Graph -> ([(Vertex, [Vertex])], Vertex -> Vertex)
scc Graph
g
cvt :: (Vertex, [Vertex]) -> SCC node
cvt (n :: Vertex
n,[v :: Vertex
v]) = let (node :: node
node,_,_) = Vertex -> (node, key, [key])
back Vertex
v
in if Vertex
n Vertex -> [Vertex] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Vertex -> Vertex) -> [Vertex] -> [Vertex]
forall a b. (a -> b) -> [a] -> [b]
map Vertex -> Vertex
lkp (Graph
g Graph -> Vertex -> [Vertex]
forall i e. Ix i => Array i e -> i -> e
! Vertex
v)
then [node] -> SCC node
forall vertex. [vertex] -> SCC vertex
CyclicSCC [node
node]
else node -> SCC node
forall vertex. vertex -> SCC vertex
AcyclicSCC node
node
cvt (_,vs :: [Vertex]
vs) = [node] -> SCC node
forall vertex. [vertex] -> SCC vertex
CyclicSCC [ node
node | (node :: node
node,_,_) <- (Vertex -> (node, key, [key])) -> [Vertex] -> [(node, key, [key])]
forall a b. (a -> b) -> [a] -> [b]
map Vertex -> (node, key, [key])
back [Vertex]
vs ]
stronglyConnCompR :: Ord key => [(node, key, [key])] -> [SCC (node, key, [key])]
stronglyConnCompR :: [(node, key, [key])] -> [SCC (node, key, [key])]
stronglyConnCompR es :: [(node, key, [key])]
es = [SCC (node, key, [key])] -> [SCC (node, key, [key])]
forall a. [a] -> [a]
reverse ([SCC (node, key, [key])] -> [SCC (node, key, [key])])
-> [SCC (node, key, [key])] -> [SCC (node, key, [key])]
forall a b. (a -> b) -> a -> b
$ ((Vertex, [Vertex]) -> SCC (node, key, [key]))
-> [(Vertex, [Vertex])] -> [SCC (node, key, [key])]
forall a b. (a -> b) -> [a] -> [b]
map (Vertex, [Vertex]) -> SCC (node, key, [key])
cvt [(Vertex, [Vertex])]
cs
where (g :: Graph
g,back :: Vertex -> (node, key, [key])
back) = [(node, key, [key])] -> (Graph, Vertex -> (node, key, [key]))
forall key node.
Ord key =>
[(node, key, [key])] -> (Graph, Vertex -> (node, key, [key]))
graphFromEdges' [(node, key, [key])]
es
(cs :: [(Vertex, [Vertex])]
cs,lkp :: Vertex -> Vertex
lkp) = Graph -> ([(Vertex, [Vertex])], Vertex -> Vertex)
scc Graph
g
cvt :: (Vertex, [Vertex]) -> SCC (node, key, [key])
cvt (n :: Vertex
n,[v :: Vertex
v]) = if Vertex
n Vertex -> [Vertex] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Vertex -> Vertex) -> [Vertex] -> [Vertex]
forall a b. (a -> b) -> [a] -> [b]
map Vertex -> Vertex
lkp (Graph
g Graph -> Vertex -> [Vertex]
forall i e. Ix i => Array i e -> i -> e
! Vertex
v)
then [(node, key, [key])] -> SCC (node, key, [key])
forall vertex. [vertex] -> SCC vertex
CyclicSCC [Vertex -> (node, key, [key])
back Vertex
v]
else (node, key, [key]) -> SCC (node, key, [key])
forall vertex. vertex -> SCC vertex
AcyclicSCC (Vertex -> (node, key, [key])
back Vertex
v)
cvt (_,vs :: [Vertex]
vs) = [(node, key, [key])] -> SCC (node, key, [key])
forall vertex. [vertex] -> SCC vertex
CyclicSCC ((Vertex -> (node, key, [key])) -> [Vertex] -> [(node, key, [key])]
forall a b. (a -> b) -> [a] -> [b]
map Vertex -> (node, key, [key])
back [Vertex]
vs)
to_scc :: Graph -> (Vertex -> Int) -> (Int,[Vertex]) -> SCC Vertex
to_scc :: Graph -> (Vertex -> Vertex) -> (Vertex, [Vertex]) -> SCC Vertex
to_scc g :: Graph
g lkp :: Vertex -> Vertex
lkp (n :: Vertex
n,[v :: Vertex
v]) = if Vertex
n Vertex -> [Vertex] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Vertex -> Vertex) -> [Vertex] -> [Vertex]
forall a b. (a -> b) -> [a] -> [b]
map Vertex -> Vertex
lkp (Graph
g Graph -> Vertex -> [Vertex]
forall i e. Ix i => Array i e -> i -> e
! Vertex
v) then [Vertex] -> SCC Vertex
forall vertex. [vertex] -> SCC vertex
CyclicSCC [Vertex
v]
else Vertex -> SCC Vertex
forall vertex. vertex -> SCC vertex
AcyclicSCC Vertex
v
to_scc _ _ (_,vs :: [Vertex]
vs) = [Vertex] -> SCC Vertex
forall vertex. [vertex] -> SCC vertex
CyclicSCC [Vertex]
vs