-- | It calculates the strongly connected components of directed graphs.
--
-- ==== __Example__
-- Create a `SccGraph`:
--
-- >>> import AtCoder.Scc qualified as Scc
-- >>> gr <- Scc.new 4     -- 0    1    2    3
-- >>> Scc.nScc gr
-- 4
--
-- Add edges and get SCC of the graph:
--
-- >>> Scc.addEdge gr 0 1  -- 0 -> 1    2    3
-- >>> Scc.addEdge gr 1 0  -- 0 == 1    2    3
-- >>> Scc.addEdge gr 1 2  -- 0 == 1 -> 2    3
-- >>> Scc.scc gr
-- [[3],[0,1],[2]]
--
-- See also the @scc@ function in @AtCoder.Extra.Graph@ module that computes SCC for a CSR.
--
-- @since 1.0.0.0
module AtCoder.Scc (SccGraph, nScc, new, addEdge, scc) where

import AtCoder.Internal.Assert qualified as ACIA
import AtCoder.Internal.Scc qualified as ACISCC
import Control.Monad.Primitive (PrimMonad, PrimState)
import Data.Vector qualified as V
import Data.Vector.Unboxed qualified as VU
import GHC.Stack (HasCallStack)

-- | Directed graph for calculating strongly connected components.
--
-- @since 1.0.0.0
newtype SccGraph s = SccGraph (ACISCC.SccGraph s)

-- | Returns the number of vertices in the SCC graph.
--
-- @since 1.0.0.0
{-# INLINE nScc #-}
nScc :: SccGraph s -> Int
nScc :: forall s. SccGraph s -> Int
nScc (SccGraph SccGraph s
g) = SccGraph s -> Int
forall s. SccGraph s -> Int
ACISCC.nScc SccGraph s
g

-- | Creates a directed graph with \(n\) vertices and \(0\) edges.
--
-- ==== Constraints
-- - \(0 \leq n\)
--
-- ==== Complexity
-- - \(O(n)\)
--
-- @since 1.0.0.0
{-# INLINE new #-}
new :: (PrimMonad m) => Int -> m (SccGraph (PrimState m))
new :: forall (m :: * -> *).
PrimMonad m =>
Int -> m (SccGraph (PrimState m))
new Int
n = SccGraph (PrimState m) -> SccGraph (PrimState m)
forall s. SccGraph s -> SccGraph s
SccGraph (SccGraph (PrimState m) -> SccGraph (PrimState m))
-> m (SccGraph (PrimState m)) -> m (SccGraph (PrimState m))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m (SccGraph (PrimState m))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (SccGraph (PrimState m))
ACISCC.new Int
n

-- | Adds a directed edge from the vertex @from@ to the vertex @to@.
--
-- ==== Constraints
-- - \(0 \leq \mathrm{from} \lt n\)
-- - \(0 \leq \mathrm{to} \lt n\)
--
-- ==== Complexity
-- - \(O(1)\) amortized
--
-- @since 1.0.0.0
{-# INLINE addEdge #-}
addEdge :: (HasCallStack, PrimMonad m) => SccGraph (PrimState m) -> Int -> Int -> m ()
addEdge :: forall (m :: * -> *).
(HasCallStack, PrimMonad m) =>
SccGraph (PrimState m) -> Int -> Int -> m ()
addEdge (SccGraph SccGraph (PrimState m)
gr) Int
from Int
to = do
  let n :: Int
n = SccGraph (PrimState m) -> Int
forall s. SccGraph s -> Int
ACISCC.nScc SccGraph (PrimState m)
gr
  let !()
_ = HasCallStack => String -> String -> Int -> String -> Int -> ()
String -> String -> Int -> String -> Int -> ()
ACIA.checkCustom String
"AtCoder.Scc.addEdge" String
"`from` vertex" Int
from String
"the number of vertices" Int
n
  let !()
_ = HasCallStack => String -> String -> Int -> String -> Int -> ()
String -> String -> Int -> String -> Int -> ()
ACIA.checkCustom String
"AtCoder.Scc.addEdge" String
"`to` vertex" Int
to String
"the number of vertices" Int
n
  SccGraph (PrimState m) -> Int -> Int -> m ()
forall (m :: * -> *).
PrimMonad m =>
SccGraph (PrimState m) -> Int -> Int -> m ()
ACISCC.addEdge SccGraph (PrimState m)
gr Int
from Int
to

-- | Returns the list of the "list of the vertices" that satisfies the following.
--
-- Each vertex is in exactly one "list of the vertices".
-- Each "list of the vertices" corresponds to the vertex set of a strongly connected component. The order of the vertices in the list is undefined.
-- The list of "list of the vertices" are sorted in topological order, i.e., for two vertices \(u, v\) in different strongly connected components, if there is a directed path from \(u\) to \(v\), the list containing \(u\) appears earlier than the list containing \(v\).
--
-- ==== Complexity
-- - \(O(n + m)\), where \(m\) is the number of added edges.
--
-- @since 1.0.0.0
{-# INLINE scc #-}
scc :: (PrimMonad m) => SccGraph (PrimState m) -> m (V.Vector (VU.Vector Int))
scc :: forall (m :: * -> *).
PrimMonad m =>
SccGraph (PrimState m) -> m (Vector (Vector Int))
scc (SccGraph SccGraph (PrimState m)
g) = SccGraph (PrimState m) -> m (Vector (Vector Int))
forall (m :: * -> *).
PrimMonad m =>
SccGraph (PrimState m) -> m (Vector (Vector Int))
ACISCC.scc SccGraph (PrimState m)
g