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

-- | Compute the list of strongly connected components of a graph.
-- The components are topologically sorted:
-- if v1 in C1 points to v2 in C2, then C2 will come before C1 in the list.
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

-- | Compute the list of strongly connected components of a graph.
-- Each component contains the adjecency information from the original graph.
-- The components are topologically sorted:
-- if v1 in C1 points to v2 in C2, then C2 will come before C1 in the list.
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 ]

-- | Quotient a graph with the relation that relates vertices that
-- belong to the same SCC.  The vertices in the new graph are the
-- SCCs of the old graph, and there is an edge between two components,
-- if there is an edge between any of their vertices.
-- The entries in the resulting list are in reversed-topologically sorted:
-- if v1 in C1 points to v2 in C2, then C1 will come before C2 in the list.
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