{-# 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 Int]
sccList Graph
g = [SCC Int] -> [SCC Int]
forall a. [a] -> [a]
reverse ([SCC Int] -> [SCC Int]) -> [SCC Int] -> [SCC Int]
forall a b. (a -> b) -> a -> b
$ ((Int, [Int]) -> SCC Int) -> [(Int, [Int])] -> [SCC Int]
forall a b. (a -> b) -> [a] -> [b]
map (Graph -> (Int -> Int) -> (Int, [Int]) -> SCC Int
to_scc Graph
g Int -> Int
lkp) [(Int, [Int])]
cs
where ([(Int, [Int])]
cs,Int -> Int
lkp) = Graph -> ([(Int, [Int])], Int -> Int)
scc Graph
g
sccListR :: Graph -> [SCC (Vertex,[Vertex])]
sccListR :: Graph -> [SCC (Int, [Int])]
sccListR Graph
g = [SCC (Int, [Int])] -> [SCC (Int, [Int])]
forall a. [a] -> [a]
reverse ([SCC (Int, [Int])] -> [SCC (Int, [Int])])
-> [SCC (Int, [Int])] -> [SCC (Int, [Int])]
forall a b. (a -> b) -> a -> b
$ ((Int, [Int]) -> SCC (Int, [Int]))
-> [(Int, [Int])] -> [SCC (Int, [Int])]
forall a b. (a -> b) -> [a] -> [b]
map (Int, [Int]) -> SCC (Int, [Int])
cvt [(Int, [Int])]
cs
where ([(Int, [Int])]
cs,Int -> Int
lkp) = Graph -> ([(Int, [Int])], Int -> Int)
scc Graph
g
cvt :: (Int, [Int]) -> SCC (Int, [Int])
cvt (Int
n,[Int
v]) = let adj :: [Int]
adj = Graph
g Graph -> Int -> [Int]
forall i e. Ix i => Array i e -> i -> e
! Int
v
in if Int
n Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Int
lkp [Int]
adj
then [(Int, [Int])] -> SCC (Int, [Int])
forall vertex. [vertex] -> SCC vertex
CyclicSCC [(Int
v,[Int]
adj)]
else (Int, [Int]) -> SCC (Int, [Int])
forall vertex. vertex -> SCC vertex
AcyclicSCC (Int
v,[Int]
adj)
cvt (Int
_,[Int]
vs) = [(Int, [Int])] -> SCC (Int, [Int])
forall vertex. [vertex] -> SCC vertex
CyclicSCC [ (Int
v, Graph
g Graph -> Int -> [Int]
forall i e. Ix i => Array i e -> i -> e
! Int
v) | Int
v <- [Int]
vs ]
sccGraph :: Graph -> [(SCC Int, Int, [Int])]
sccGraph :: Graph -> [(SCC Int, Int, [Int])]
sccGraph Graph
g = ((Int, [Int]) -> (SCC Int, Int, [Int]))
-> [(Int, [Int])] -> [(SCC Int, Int, [Int])]
forall a b. (a -> b) -> [a] -> [b]
map (Int, [Int]) -> (SCC Int, Int, [Int])
to_node [(Int, [Int])]
cs
where ([(Int, [Int])]
cs,Int -> Int
lkp) = Graph -> ([(Int, [Int])], Int -> Int)
scc Graph
g
to_node :: (Int, [Int]) -> (SCC Int, Int, [Int])
to_node x :: (Int, [Int])
x@(Int
n,[Int]
this) = ( Graph -> (Int -> Int) -> (Int, [Int]) -> SCC Int
to_scc Graph
g Int -> Int
lkp (Int, [Int])
x
, Int
n
, [Int] -> [Int]
forall a. Eq a => [a] -> [a]
nub ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ (Int -> [Int]) -> [Int] -> [Int]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Int
lkp ([Int] -> [Int]) -> (Int -> [Int]) -> Int -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Graph
g Graph -> Int -> [Int]
forall i e. Ix i => Array i e -> i -> e
!)) [Int]
this
)
stronglyConnComp :: Ord key => [(node, key, [key])] -> [SCC node]
stronglyConnComp :: forall key node. Ord key => [(node, key, [key])] -> [SCC node]
stronglyConnComp [(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
$ ((Int, [Int]) -> SCC node) -> [(Int, [Int])] -> [SCC node]
forall a b. (a -> b) -> [a] -> [b]
map (Int, [Int]) -> SCC node
cvt [(Int, [Int])]
cs
where (Graph
g,Int -> (node, key, [key])
back) = [(node, key, [key])] -> (Graph, Int -> (node, key, [key]))
forall key node.
Ord key =>
[(node, key, [key])] -> (Graph, Int -> (node, key, [key]))
graphFromEdges' [(node, key, [key])]
es
([(Int, [Int])]
cs,Int -> Int
lkp) = Graph -> ([(Int, [Int])], Int -> Int)
scc Graph
g
cvt :: (Int, [Int]) -> SCC node
cvt (Int
n,[Int
v]) = let (node
node,key
_,[key]
_) = Int -> (node, key, [key])
back Int
v
in if Int
n Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Int
lkp (Graph
g Graph -> Int -> [Int]
forall i e. Ix i => Array i e -> i -> e
! Int
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 (Int
_,[Int]
vs) = [node] -> SCC node
forall vertex. [vertex] -> SCC vertex
CyclicSCC [ node
node | (node
node,key
_,[key]
_) <- (Int -> (node, key, [key])) -> [Int] -> [(node, key, [key])]
forall a b. (a -> b) -> [a] -> [b]
map Int -> (node, key, [key])
back [Int]
vs ]
stronglyConnCompR :: Ord key => [(node, key, [key])] -> [SCC (node, key, [key])]
stronglyConnCompR :: forall key node.
Ord key =>
[(node, key, [key])] -> [SCC (node, key, [key])]
stronglyConnCompR [(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
$ ((Int, [Int]) -> SCC (node, key, [key]))
-> [(Int, [Int])] -> [SCC (node, key, [key])]
forall a b. (a -> b) -> [a] -> [b]
map (Int, [Int]) -> SCC (node, key, [key])
cvt [(Int, [Int])]
cs
where (Graph
g,Int -> (node, key, [key])
back) = [(node, key, [key])] -> (Graph, Int -> (node, key, [key]))
forall key node.
Ord key =>
[(node, key, [key])] -> (Graph, Int -> (node, key, [key]))
graphFromEdges' [(node, key, [key])]
es
([(Int, [Int])]
cs,Int -> Int
lkp) = Graph -> ([(Int, [Int])], Int -> Int)
scc Graph
g
cvt :: (Int, [Int]) -> SCC (node, key, [key])
cvt (Int
n,[Int
v]) = if Int
n Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Int
lkp (Graph
g Graph -> Int -> [Int]
forall i e. Ix i => Array i e -> i -> e
! Int
v)
then [(node, key, [key])] -> SCC (node, key, [key])
forall vertex. [vertex] -> SCC vertex
CyclicSCC [Int -> (node, key, [key])
back Int
v]
else (node, key, [key]) -> SCC (node, key, [key])
forall vertex. vertex -> SCC vertex
AcyclicSCC (Int -> (node, key, [key])
back Int
v)
cvt (Int
_,[Int]
vs) = [(node, key, [key])] -> SCC (node, key, [key])
forall vertex. [vertex] -> SCC vertex
CyclicSCC ((Int -> (node, key, [key])) -> [Int] -> [(node, key, [key])]
forall a b. (a -> b) -> [a] -> [b]
map Int -> (node, key, [key])
back [Int]
vs)
to_scc :: Graph -> (Vertex -> Int) -> (Int,[Vertex]) -> SCC Vertex
to_scc :: Graph -> (Int -> Int) -> (Int, [Int]) -> SCC Int
to_scc Graph
g Int -> Int
lkp (Int
n,[Int
v]) = if Int
n Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Int
lkp (Graph
g Graph -> Int -> [Int]
forall i e. Ix i => Array i e -> i -> e
! Int
v) then [Int] -> SCC Int
forall vertex. [vertex] -> SCC vertex
CyclicSCC [Int
v]
else Int -> SCC Int
forall vertex. vertex -> SCC vertex
AcyclicSCC Int
v
to_scc Graph
_ Int -> Int
_ (Int
_,[Int]
vs) = [Int] -> SCC Int
forall vertex. [vertex] -> SCC vertex
CyclicSCC [Int]
vs