{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE TypeFamilies #-}

-- | A dynamic, lazily propagated segment tree that covers a half-open interval \([l_0, r_0)\).
-- Nodes are instantinated as needed, with the required capacity being /approximately/ \(4q \log_2 L\),
-- where \(q\) is the number of mutable operations and \(L\) is the length of the interval.
--
-- ==== __Example__
--
-- >>> import AtCoder.Extra.DynLazySegTree qualified as Seg
-- >>> import AtCoder.Extra.Monoid.Affine1 (Affine1 (..))
-- >>> import AtCoder.Extra.Monoid.Affine1 qualified as Affine1
-- >>> import Data.Semigroup (Sum (..))
-- >>> import Data.Vector.Unboxed qualified as VU
--
-- Create a `DynLazySegTree` over \([0, 4)\) with some initial capacity:
--
-- >>> let len = 4; q = 3
-- >>> seg <- Seg.new @_ @(Affine1 Int) @(Sum Int) (Seg.recommendedCapacity len q) 0 4
--
-- Different from the @LazySegTree@ module, it requires explicit root handle:
--
-- >>> -- [0, 0, 0, 0]
-- >>> root <- Seg.newRoot seg
-- >>> Seg.write seg root 1 $ Sum 10
-- >>> Seg.write seg root 2 $ Sum 20
-- >>> -- [0, 10, 20, 0]
-- >>> Seg.prod seg root 0 3
-- Sum {getSum = 30}
--
-- >>> -- [0, 10, 20, 0] -> [0, 21, 41, 1]
-- >>> Seg.applyIn seg root 1 4 $ Affine1.new 2 1
-- >>> Seg.maxRight seg root (<= (Sum 62))
-- 3
--
-- If multiple tree roots are allocated, `copyInterval` and `copyIntervalWith` can be used.
--
-- @since 1.2.1.0
module AtCoder.Extra.DynLazySegTree
  ( -- * Dynamic, lazily propagated segment tree
    Raw.DynLazySegTree (..),

    -- * Re-exports
    SegAct (..),
    P.Index (..),

    -- * Constructors
    new,
    buildWith,
    recommendedCapacity,
    newRoot,
    newSeq,
    -- TODO: free functions

    -- * Accessing elements
    write,
    modify,
    modifyM,
    -- exchange,
    -- read,

    -- * Products
    prod,
    -- prodMaybe,
    allProd, -- FIXME: rename it to prodAll

    -- * Applications
    applyAt,
    applyIn,
    applyAll,

    -- * Tree operations
    copyInterval,
    copyIntervalWith,
    resetInterval,

    -- * Binary searches
    maxRight,
    maxRightM,
    -- -- * Conversions
    -- freeze,

    -- * Clear
    clear,
  )
where

import AtCoder.Extra.DynLazySegTree.Raw qualified as Raw
import AtCoder.Extra.Pool qualified as P
import AtCoder.LazySegTree (SegAct (..))
import Control.Monad.Primitive (PrimMonad, PrimState, stToPrim)
import Data.Vector.Unboxed qualified as VU
import GHC.Stack (HasCallStack)
import Prelude hiding (read)

-- | \(O(n)\) Creates a `DynLazySegTree` of capacity \(n\) for interval \([l_0, r_0)\) with `mempty`
-- as initial leaf values.
--
-- @since 1.2.1.0
{-# INLINE new #-}
new ::
  (HasCallStack, PrimMonad m, Monoid f, VU.Unbox f, Monoid a, VU.Unbox a) =>
  -- | Capacity \(n\)
  Int ->
  -- | Left index boundary \(l_0\)
  Int ->
  -- | Right index boundary \(r_0\)
  Int ->
  -- | Dynamic, lazily propagated segment tree
  m (Raw.DynLazySegTree (PrimState m) f a)
new :: forall (m :: * -> *) f a.
(HasCallStack, PrimMonad m, Monoid f, Unbox f, Monoid a,
 Unbox a) =>
Int -> Int -> Int -> m (DynLazySegTree (PrimState m) f a)
new Int
nLdst Int
l Int
r = ST (PrimState m) (DynLazySegTree (PrimState m) f a)
-> m (DynLazySegTree (PrimState m) f a)
forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
stToPrim (ST (PrimState m) (DynLazySegTree (PrimState m) f a)
 -> m (DynLazySegTree (PrimState m) f a))
-> ST (PrimState m) (DynLazySegTree (PrimState m) f a)
-> m (DynLazySegTree (PrimState m) f a)
forall a b. (a -> b) -> a -> b
$ Bool
-> Int
-> Int
-> Int
-> (Int -> Int -> a)
-> ST (PrimState m) (DynLazySegTree (PrimState m) f a)
forall f a s.
(HasCallStack, Unbox f, Unbox a) =>
Bool
-> Int
-> Int
-> Int
-> (Int -> Int -> a)
-> ST s (DynLazySegTree s f a)
Raw.newST Bool
False Int
nLdst Int
l Int
r (\Int
_ Int
_ -> a
forall a. Monoid a => a
mempty)

-- | \(O(n)\) Creates a `DynLazySegTree` of capacity \(n\) for interval \([l_0, r_0)\) with initial
-- monoid value assignment \(g(l, r)\).
--
-- @since 1.2.1.0
{-# INLINE buildWith #-}
buildWith ::
  (HasCallStack, PrimMonad m, Monoid f, VU.Unbox f, Monoid a, VU.Unbox a) =>
  -- | Capacity \(n\)
  Int ->
  -- | Left index boundary \(l_0\)
  Int ->
  -- | Right index boundary \(r_0\)
  Int ->
  -- | Initial monoid value assignment \(g: (l, r) \rightarrow a\)
  (Int -> Int -> a) ->
  -- | Dynamic, lazily propagated segment tree
  m (Raw.DynLazySegTree (PrimState m) f a)
buildWith :: forall (m :: * -> *) f a.
(HasCallStack, PrimMonad m, Monoid f, Unbox f, Monoid a,
 Unbox a) =>
Int
-> Int
-> Int
-> (Int -> Int -> a)
-> m (DynLazySegTree (PrimState m) f a)
buildWith Int
nLdst Int
l Int
r Int -> Int -> a
g = ST (PrimState m) (DynLazySegTree (PrimState m) f a)
-> m (DynLazySegTree (PrimState m) f a)
forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
stToPrim (ST (PrimState m) (DynLazySegTree (PrimState m) f a)
 -> m (DynLazySegTree (PrimState m) f a))
-> ST (PrimState m) (DynLazySegTree (PrimState m) f a)
-> m (DynLazySegTree (PrimState m) f a)
forall a b. (a -> b) -> a -> b
$ Bool
-> Int
-> Int
-> Int
-> (Int -> Int -> a)
-> ST (PrimState m) (DynLazySegTree (PrimState m) f a)
forall f a s.
(HasCallStack, Unbox f, Unbox a) =>
Bool
-> Int
-> Int
-> Int
-> (Int -> Int -> a)
-> ST s (DynLazySegTree s f a)
Raw.newST Bool
False Int
nLdst Int
l Int
r Int -> Int -> a
g

-- | \(O(1)\) Returns recommended capacity for \(L\) and \(q\): about \(4q \log_2 L\).
--
-- @since 1.2.1.0
{-# INLINE recommendedCapacity #-}
recommendedCapacity :: Int -> Int -> Int
recommendedCapacity :: Int -> Int -> Int
recommendedCapacity Int
n Int
q = Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
q Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
2 (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Double -> Double -> Double
forall a. Floating a => a -> a -> a
logBase Double
2 (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) :: Double))

-- | \(O(1)\) Creates a new root in \([l_0, r_0)\).
--
-- @since 1.2.1.0
{-# INLINE newRoot #-}
newRoot :: (HasCallStack, PrimMonad m, Monoid f, VU.Unbox f, Monoid a, VU.Unbox a) => Raw.DynLazySegTree (PrimState m) f a -> m P.Index
newRoot :: forall (m :: * -> *) f a.
(HasCallStack, PrimMonad m, Monoid f, Unbox f, Monoid a,
 Unbox a) =>
DynLazySegTree (PrimState m) f a -> m Index
newRoot DynLazySegTree (PrimState m) f a
dst = ST (PrimState m) Index -> m Index
forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
stToPrim (ST (PrimState m) Index -> m Index)
-> ST (PrimState m) Index -> m Index
forall a b. (a -> b) -> a -> b
$ DynLazySegTree (PrimState m) f a -> ST (PrimState m) Index
forall f a s.
(HasCallStack, Monoid f, Unbox f, Monoid a, Unbox a) =>
DynLazySegTree s f a -> ST s Index
Raw.newRootST DynLazySegTree (PrimState m) f a
dst

-- | \(O(L)\) Creates a new root node with contiguous leaf values. User would want to use a strict
-- segment tree instead.
--
-- ==== Constraints
-- - \([l_0, r_0) = [0, L)\): The index boundary of the segment tree must match the sequence.
--
-- @since 1.2.1.0
{-# INLINE newSeq #-}
newSeq :: (HasCallStack, PrimMonad m, Monoid f, VU.Unbox f, Monoid a, VU.Unbox a) => Raw.DynLazySegTree (PrimState m) f a -> VU.Vector a -> m P.Index
newSeq :: forall (m :: * -> *) f a.
(HasCallStack, PrimMonad m, Monoid f, Unbox f, Monoid a,
 Unbox a) =>
DynLazySegTree (PrimState m) f a -> Vector a -> m Index
newSeq DynLazySegTree (PrimState m) f a
dst Vector a
xs = ST (PrimState m) Index -> m Index
forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
stToPrim (ST (PrimState m) Index -> m Index)
-> ST (PrimState m) Index -> m Index
forall a b. (a -> b) -> a -> b
$ DynLazySegTree (PrimState m) f a
-> Vector a -> ST (PrimState m) Index
forall f a s.
(HasCallStack, Monoid f, Unbox f, Monoid a, Unbox a) =>
DynLazySegTree s f a -> Vector a -> ST s Index
Raw.newSeqST DynLazySegTree (PrimState m) f a
dst Vector a
xs

-- | \(O(\log L)\) Writes to the monoid value of the node at \(i\).
--
-- ==== Constraints
-- - \(l_0 \le i \lt r_0\)
--
-- @since 1.2.1.0
{-# INLINE write #-}
write :: (HasCallStack, PrimMonad m, SegAct f a, Eq f, Monoid f, VU.Unbox f, Monoid a, VU.Unbox a) => Raw.DynLazySegTree (PrimState m) f a -> P.Index -> Int -> a -> m ()
write :: forall (m :: * -> *) f a.
(HasCallStack, PrimMonad m, SegAct f a, Eq f, Monoid f, Unbox f,
 Monoid a, Unbox a) =>
DynLazySegTree (PrimState m) f a -> Index -> Int -> a -> m ()
write DynLazySegTree (PrimState m) f a
dst Index
root Int
i a
x = ST (PrimState m) () -> m ()
forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
stToPrim (ST (PrimState m) () -> m ()) -> ST (PrimState m) () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  Index
_ <- DynLazySegTree (PrimState (ST (PrimState m))) f a
-> Index
-> (a -> ST (PrimState m) a)
-> Int
-> ST (PrimState m) Index
forall (m :: * -> *) f a.
(HasCallStack, PrimMonad m, SegAct f a, Eq f, Monoid f, Unbox f,
 Monoid a, Unbox a) =>
DynLazySegTree (PrimState m) f a
-> Index -> (a -> m a) -> Int -> m Index
Raw.modifyMST DynLazySegTree (PrimState m) f a
DynLazySegTree (PrimState (ST (PrimState m))) f a
dst Index
root (a -> ST (PrimState m) a
forall a. a -> ST (PrimState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> ST (PrimState m) a) -> (a -> a) -> a -> ST (PrimState m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a -> a
forall a b. a -> b -> a
const a
x) Int
i
  () -> ST (PrimState m) ()
forall a. a -> ST (PrimState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | \(O(\log L)\) Modifies the monoid value of the node at \(i\).
--
-- ==== Constraints
-- - \(l_0 \le i \lt r_0\)
--
-- @since 1.2.1.0
{-# INLINE modify #-}
modify :: (HasCallStack, PrimMonad m, SegAct f a, Eq f, Monoid f, VU.Unbox f, Monoid a, VU.Unbox a) => Raw.DynLazySegTree (PrimState m) f a -> P.Index -> (a -> a) -> Int -> m ()
modify :: forall (m :: * -> *) f a.
(HasCallStack, PrimMonad m, SegAct f a, Eq f, Monoid f, Unbox f,
 Monoid a, Unbox a) =>
DynLazySegTree (PrimState m) f a
-> Index -> (a -> a) -> Int -> m ()
modify DynLazySegTree (PrimState m) f a
dst Index
root a -> a
f Int
i = ST (PrimState m) () -> m ()
forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
stToPrim (ST (PrimState m) () -> m ()) -> ST (PrimState m) () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  Index
_ <- DynLazySegTree (PrimState (ST (PrimState m))) f a
-> Index
-> (a -> ST (PrimState m) a)
-> Int
-> ST (PrimState m) Index
forall (m :: * -> *) f a.
(HasCallStack, PrimMonad m, SegAct f a, Eq f, Monoid f, Unbox f,
 Monoid a, Unbox a) =>
DynLazySegTree (PrimState m) f a
-> Index -> (a -> m a) -> Int -> m Index
Raw.modifyMST DynLazySegTree (PrimState m) f a
DynLazySegTree (PrimState (ST (PrimState m))) f a
dst Index
root (a -> ST (PrimState m) a
forall a. a -> ST (PrimState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> ST (PrimState m) a) -> (a -> a) -> a -> ST (PrimState m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
f) Int
i
  () -> ST (PrimState m) ()
forall a. a -> ST (PrimState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | \(O(\log L)\) Modifies the monoid value of the node at \(i\).
--
-- ==== Constraints
-- - \(l_0 \le i \lt r_0\)
--
-- @since 1.2.1.0
{-# INLINE modifyM #-}
modifyM :: (HasCallStack, PrimMonad m, SegAct f a, Eq f, Monoid f, VU.Unbox f, Monoid a, VU.Unbox a) => Raw.DynLazySegTree (PrimState m) f a -> P.Index -> (a -> m a) -> Int -> m ()
modifyM :: forall (m :: * -> *) f a.
(HasCallStack, PrimMonad m, SegAct f a, Eq f, Monoid f, Unbox f,
 Monoid a, Unbox a) =>
DynLazySegTree (PrimState m) f a
-> Index -> (a -> m a) -> Int -> m ()
modifyM DynLazySegTree (PrimState m) f a
dst Index
root a -> m a
f Int
i = do
  Index
_ <- DynLazySegTree (PrimState m) f a
-> Index -> (a -> m a) -> Int -> m Index
forall (m :: * -> *) f a.
(HasCallStack, PrimMonad m, SegAct f a, Eq f, Monoid f, Unbox f,
 Monoid a, Unbox a) =>
DynLazySegTree (PrimState m) f a
-> Index -> (a -> m a) -> Int -> m Index
Raw.modifyMST DynLazySegTree (PrimState m) f a
dst Index
root a -> m a
f Int
i
  () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | \(O(\log L)\) Returns the monoid product in \([l, r)\).
--
-- ==== Constraints
-- - \(l_0 \le l \le r \le r_0\)
--
-- @since 1.2.1.0
{-# INLINE prod #-}
prod :: (HasCallStack, PrimMonad m, SegAct f a, Monoid f, VU.Unbox f, Monoid a, VU.Unbox a) => Raw.DynLazySegTree (PrimState m) f a -> P.Index -> Int -> Int -> m a
prod :: forall (m :: * -> *) f a.
(HasCallStack, PrimMonad m, SegAct f a, Monoid f, Unbox f,
 Monoid a, Unbox a) =>
DynLazySegTree (PrimState m) f a -> Index -> Int -> Int -> m a
prod DynLazySegTree (PrimState m) f a
dst Index
root Int
l Int
r = ST (PrimState m) a -> m a
forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
stToPrim (ST (PrimState m) a -> m a) -> ST (PrimState m) a -> m a
forall a b. (a -> b) -> a -> b
$ do
  DynLazySegTree (PrimState m) f a
-> Index -> Int -> Int -> ST (PrimState m) a
forall f a s.
(HasCallStack, SegAct f a, Monoid f, Unbox f, Monoid a, Unbox a) =>
DynLazySegTree s f a -> Index -> Int -> Int -> ST s a
Raw.prodST DynLazySegTree (PrimState m) f a
dst Index
root Int
l Int
r

-- | \(O(\log L)\) Returns the monoid product in \([l_0, r_0)\).
--
-- @since 1.2.1.0
{-# INLINE allProd #-}
allProd :: (HasCallStack, PrimMonad m, SegAct f a, Monoid f, VU.Unbox f, Monoid a, VU.Unbox a) => Raw.DynLazySegTree (PrimState m) f a -> P.Index -> m a
allProd :: forall (m :: * -> *) f a.
(HasCallStack, PrimMonad m, SegAct f a, Monoid f, Unbox f,
 Monoid a, Unbox a) =>
DynLazySegTree (PrimState m) f a -> Index -> m a
allProd dst :: DynLazySegTree (PrimState m) f a
dst@Raw.DynLazySegTree {Int
l0Ldst :: Int
l0Ldst :: forall s f a. DynLazySegTree s f a -> Int
l0Ldst, Int
r0Ldst :: Int
r0Ldst :: forall s f a. DynLazySegTree s f a -> Int
r0Ldst} Index
root = ST (PrimState m) a -> m a
forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
stToPrim (ST (PrimState m) a -> m a) -> ST (PrimState m) a -> m a
forall a b. (a -> b) -> a -> b
$ do
  DynLazySegTree (PrimState m) f a
-> Index -> Int -> Int -> ST (PrimState m) a
forall f a s.
(HasCallStack, SegAct f a, Monoid f, Unbox f, Monoid a, Unbox a) =>
DynLazySegTree s f a -> Index -> Int -> Int -> ST s a
Raw.prodST DynLazySegTree (PrimState m) f a
dst Index
root Int
l0Ldst Int
r0Ldst

-- | \(O(\log L)\) Applies a monoid action \(f\) to the node at index \(i\).
--
-- ==== Constraints
-- - \(l_0 \le i \lt r_0\)
-- - The root is not null
--
-- @since 1.2.1.0
{-# INLINE applyAt #-}
applyAt :: (HasCallStack, PrimMonad m, SegAct f a, Eq f, Monoid f, VU.Unbox f, Monoid a, VU.Unbox a) => Raw.DynLazySegTree (PrimState m) f a -> P.Index -> Int -> f -> m ()
applyAt :: forall (m :: * -> *) f a.
(HasCallStack, PrimMonad m, SegAct f a, Eq f, Monoid f, Unbox f,
 Monoid a, Unbox a) =>
DynLazySegTree (PrimState m) f a -> Index -> Int -> f -> m ()
applyAt DynLazySegTree (PrimState m) f a
dst Index
root Int
i f
act = ST (PrimState m) () -> m ()
forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
stToPrim (ST (PrimState m) () -> m ()) -> ST (PrimState m) () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  Index
_ <- DynLazySegTree (PrimState m) f a
-> Index -> Int -> Int -> f -> ST (PrimState m) Index
forall f a s.
(HasCallStack, SegAct f a, Eq f, Monoid f, Unbox f, Monoid a,
 Unbox a) =>
DynLazySegTree s f a -> Index -> Int -> Int -> f -> ST s Index
Raw.applyInST DynLazySegTree (PrimState m) f a
dst Index
root Int
i (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) f
act
  () -> ST (PrimState m) ()
forall a. a -> ST (PrimState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | \(O(\log L)\) Applies a monoid action \(f\) to an interval \([l, r)\).
--
-- ==== Constraints
-- - \(l_0 \le l \le r \le r_0\)
-- - The root is not null
--
-- @since 1.2.1.0
{-# INLINE applyIn #-}
applyIn :: (HasCallStack, PrimMonad m, SegAct f a, Eq f, Monoid f, VU.Unbox f, Monoid a, VU.Unbox a) => Raw.DynLazySegTree (PrimState m) f a -> P.Index -> Int -> Int -> f -> m ()
applyIn :: forall (m :: * -> *) f a.
(HasCallStack, PrimMonad m, SegAct f a, Eq f, Monoid f, Unbox f,
 Monoid a, Unbox a) =>
DynLazySegTree (PrimState m) f a
-> Index -> Int -> Int -> f -> m ()
applyIn DynLazySegTree (PrimState m) f a
dst Index
root Int
l Int
r f
act = ST (PrimState m) () -> m ()
forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
stToPrim (ST (PrimState m) () -> m ()) -> ST (PrimState m) () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  Index
_ <- DynLazySegTree (PrimState m) f a
-> Index -> Int -> Int -> f -> ST (PrimState m) Index
forall f a s.
(HasCallStack, SegAct f a, Eq f, Monoid f, Unbox f, Monoid a,
 Unbox a) =>
DynLazySegTree s f a -> Index -> Int -> Int -> f -> ST s Index
Raw.applyInST DynLazySegTree (PrimState m) f a
dst Index
root Int
l Int
r f
act
  () -> ST (PrimState m) ()
forall a. a -> ST (PrimState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | \(O(\log L)\) Applies a monoid action \(f\) to the interval \([l_0, r_0)\).
--
-- @since 1.2.1.0
{-# INLINE applyAll #-}
applyAll :: (HasCallStack, PrimMonad m, SegAct f a, Eq f, Monoid f, VU.Unbox f, Monoid a, VU.Unbox a) => Raw.DynLazySegTree (PrimState m) f a -> P.Index -> f -> m ()
applyAll :: forall (m :: * -> *) f a.
(HasCallStack, PrimMonad m, SegAct f a, Eq f, Monoid f, Unbox f,
 Monoid a, Unbox a) =>
DynLazySegTree (PrimState m) f a -> Index -> f -> m ()
applyAll dst :: DynLazySegTree (PrimState m) f a
dst@Raw.DynLazySegTree {Int
l0Ldst :: forall s f a. DynLazySegTree s f a -> Int
l0Ldst :: Int
l0Ldst, Int
r0Ldst :: forall s f a. DynLazySegTree s f a -> Int
r0Ldst :: Int
r0Ldst} Index
root f
act = ST (PrimState m) () -> m ()
forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
stToPrim (ST (PrimState m) () -> m ()) -> ST (PrimState m) () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  Index
_ <- DynLazySegTree (PrimState m) f a
-> Index -> Int -> Int -> f -> ST (PrimState m) Index
forall f a s.
(HasCallStack, SegAct f a, Eq f, Monoid f, Unbox f, Monoid a,
 Unbox a) =>
DynLazySegTree s f a -> Index -> Int -> Int -> f -> ST s Index
Raw.applyInST DynLazySegTree (PrimState m) f a
dst Index
root Int
l0Ldst Int
r0Ldst f
act
  () -> ST (PrimState m) ()
forall a. a -> ST (PrimState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | \(O(\log L)\) Given two trees \(a\) and \(b\), copies \(b[l, r)\) to \(a[l, r)\).
--
-- ==== Constraints
-- - \(l_0 \le l \le r \le r_0\)
-- - The root is not null
--
-- @since 1.2.1.0
{-# INLINE copyInterval #-}
copyInterval ::
  (HasCallStack, PrimMonad m, SegAct f a, Eq f, Monoid f, VU.Unbox f, Monoid a, VU.Unbox a) =>
  Raw.DynLazySegTree (PrimState m) f a ->
  P.Index ->
  P.Index ->
  Int ->
  Int ->
  m ()
copyInterval :: forall (m :: * -> *) f a.
(HasCallStack, PrimMonad m, SegAct f a, Eq f, Monoid f, Unbox f,
 Monoid a, Unbox a) =>
DynLazySegTree (PrimState m) f a
-> Index -> Index -> Int -> Int -> m ()
copyInterval DynLazySegTree (PrimState m) f a
dst Index
root Index
other Int
l Int
r = ST (PrimState m) () -> m ()
forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
stToPrim (ST (PrimState m) () -> m ()) -> ST (PrimState m) () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  Index
_ <- DynLazySegTree (PrimState m) f a
-> Index -> Index -> Int -> Int -> f -> ST (PrimState m) Index
forall f a s.
(HasCallStack, SegAct f a, Eq f, Monoid f, Unbox f, Monoid a,
 Unbox a) =>
DynLazySegTree s f a
-> Index -> Index -> Int -> Int -> f -> ST s Index
Raw.copyIntervalWithST DynLazySegTree (PrimState m) f a
dst Index
root Index
other Int
l Int
r f
forall a. Monoid a => a
mempty
  () -> ST (PrimState m) ()
forall a. a -> ST (PrimState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | \(O(\log L)\) Given two trees \(a\) and \(b\), copies \(b[l, r)\) to \(a[l, r)\), applying a
-- monoid action \(f\).
--
-- ==== Constraints
-- - \(l_0 \le l \le r \le r_0\)
-- - The root is not null
--
-- @since 1.2.1.0
{-# INLINE copyIntervalWith #-}
copyIntervalWith :: (HasCallStack, PrimMonad m, SegAct f a, Eq f, Monoid f, VU.Unbox f, Monoid a, VU.Unbox a) => Raw.DynLazySegTree (PrimState m) f a -> P.Index -> P.Index -> Int -> Int -> f -> m ()
copyIntervalWith :: forall (m :: * -> *) f a.
(HasCallStack, PrimMonad m, SegAct f a, Eq f, Monoid f, Unbox f,
 Monoid a, Unbox a) =>
DynLazySegTree (PrimState m) f a
-> Index -> Index -> Int -> Int -> f -> m ()
copyIntervalWith DynLazySegTree (PrimState m) f a
dst Index
root Index
other Int
l Int
r f
act = ST (PrimState m) () -> m ()
forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
stToPrim (ST (PrimState m) () -> m ()) -> ST (PrimState m) () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  Index
_ <- DynLazySegTree (PrimState m) f a
-> Index -> Index -> Int -> Int -> f -> ST (PrimState m) Index
forall f a s.
(HasCallStack, SegAct f a, Eq f, Monoid f, Unbox f, Monoid a,
 Unbox a) =>
DynLazySegTree s f a
-> Index -> Index -> Int -> Int -> f -> ST s Index
Raw.copyIntervalWithST DynLazySegTree (PrimState m) f a
dst Index
root Index
other Int
l Int
r f
act
  () -> ST (PrimState m) ()
forall a. a -> ST (PrimState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | \(O(\log L)\) Resets an interval \([l, r)\) to initial monoid values.
--
-- ==== Constraints
-- - \(l_0 \le l \le r \le r_0\)
--
-- @since 1.2.1.0
{-# INLINE resetInterval #-}
resetInterval ::
  (HasCallStack, PrimMonad m, SegAct f a, Eq f, Monoid f, VU.Unbox f, Monoid a, VU.Unbox a) =>
  Raw.DynLazySegTree (PrimState m) f a ->
  P.Index ->
  Int ->
  Int ->
  m ()
resetInterval :: forall (m :: * -> *) f a.
(HasCallStack, PrimMonad m, SegAct f a, Eq f, Monoid f, Unbox f,
 Monoid a, Unbox a) =>
DynLazySegTree (PrimState m) f a -> Index -> Int -> Int -> m ()
resetInterval DynLazySegTree (PrimState m) f a
dst Index
root Int
l Int
r = ST (PrimState m) () -> m ()
forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
stToPrim (ST (PrimState m) () -> m ()) -> ST (PrimState m) () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  Index
_ <- DynLazySegTree (PrimState m) f a
-> Index -> Int -> Int -> ST (PrimState m) Index
forall f a s.
(HasCallStack, SegAct f a, Eq f, Monoid f, Unbox f, Monoid a,
 Unbox a) =>
DynLazySegTree s f a -> Index -> Int -> Int -> ST s Index
Raw.resetIntervalST DynLazySegTree (PrimState m) f a
dst Index
root Int
l Int
r
  () -> ST (PrimState m) ()
forall a. a -> ST (PrimState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | \(O(\log L)\) Returns the maximum \(r \in [l_0, r_0)\) where \(f(a_{l_0} a_{l_0 + 1} \dots a_{r - 1})\) holds.
--
-- @since 1.2.1.0
{-# INLINE maxRight #-}
maxRight :: (HasCallStack, PrimMonad m, SegAct f a, Eq f, Monoid f, VU.Unbox f, Monoid a, VU.Unbox a) => Raw.DynLazySegTree (PrimState m) f a -> P.Index -> (a -> Bool) -> m Int
maxRight :: forall (m :: * -> *) f a.
(HasCallStack, PrimMonad m, SegAct f a, Eq f, Monoid f, Unbox f,
 Monoid a, Unbox a) =>
DynLazySegTree (PrimState m) f a -> Index -> (a -> Bool) -> m Int
maxRight DynLazySegTree (PrimState m) f a
dst Index
root a -> Bool
f = do
  DynLazySegTree (PrimState m) f a -> Index -> (a -> m Bool) -> m Int
forall (m :: * -> *) f a.
(HasCallStack, PrimMonad m, SegAct f a, Eq f, Monoid f, Unbox f,
 Monoid a, Unbox a) =>
DynLazySegTree (PrimState m) f a -> Index -> (a -> m Bool) -> m Int
Raw.maxRightM DynLazySegTree (PrimState m) f a
dst Index
root (Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> m Bool) -> (a -> Bool) -> a -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
f)

-- | \(O(\log L)\) Returns the maximum \(r \in [l_0, r_0)\) where \(f(a_{l_0} a_{l_0 + 1} \dots a_{r - 1})\) holds.
--
-- @since 1.2.1.0
{-# INLINE maxRightM #-}
maxRightM :: (HasCallStack, PrimMonad m, SegAct f a, Eq f, Monoid f, VU.Unbox f, Monoid a, VU.Unbox a) => Raw.DynLazySegTree (PrimState m) f a -> P.Index -> (a -> m Bool) -> m Int
maxRightM :: forall (m :: * -> *) f a.
(HasCallStack, PrimMonad m, SegAct f a, Eq f, Monoid f, Unbox f,
 Monoid a, Unbox a) =>
DynLazySegTree (PrimState m) f a -> Index -> (a -> m Bool) -> m Int
maxRightM DynLazySegTree (PrimState m) f a
dst Index
root a -> m Bool
f = do
  DynLazySegTree (PrimState m) f a -> Index -> (a -> m Bool) -> m Int
forall (m :: * -> *) f a.
(HasCallStack, PrimMonad m, SegAct f a, Eq f, Monoid f, Unbox f,
 Monoid a, Unbox a) =>
DynLazySegTree (PrimState m) f a -> Index -> (a -> m Bool) -> m Int
Raw.maxRightM DynLazySegTree (PrimState m) f a
dst Index
root a -> m Bool
f

-- | \(O(\log L)\) Claers all the nodes from the storage.
--
-- @since 1.2.2.0
{-# INLINE clear #-}
clear :: (PrimMonad m) => Raw.DynLazySegTree (PrimState m) f a -> m ()
clear :: forall (m :: * -> *) f a.
PrimMonad m =>
DynLazySegTree (PrimState m) f a -> m ()
clear DynLazySegTree (PrimState m) f a
dst = do
  Pool (PrimState m) () -> m ()
forall (m :: * -> *) a. PrimMonad m => Pool (PrimState m) a -> m ()
P.clear (DynLazySegTree (PrimState m) f a -> Pool (PrimState m) ()
forall s f a. DynLazySegTree s f a -> Pool s ()
Raw.poolLdst DynLazySegTree (PrimState m) f a
dst)