ac-library-hs 1.2.0.0 → 1.2.1.0

raw patch · 35 files changed

+5093/−215 lines, 35 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +8/−0
• ac-library-hs.cabal +18/−1
• src/AtCoder/Extra/DynLazySegTree.hs +309/−0
• src/AtCoder/Extra/DynLazySegTree/Persistent.hs +291/−0
• src/AtCoder/Extra/DynLazySegTree/Raw.hs +537/−0
• src/AtCoder/Extra/DynSegTree.hs +219/−0
• src/AtCoder/Extra/DynSegTree/Persistent.hs +212/−0
• src/AtCoder/Extra/DynSegTree/Raw.hs +339/−0
• src/AtCoder/Extra/DynSparseSegTree.hs +185/−0
• src/AtCoder/Extra/DynSparseSegTree/Persistent.hs +168/−0
• src/AtCoder/Extra/DynSparseSegTree/Raw.hs +329/−0
• src/AtCoder/Extra/HashMap.hs +2/−4
• src/AtCoder/Extra/IntervalMap.hs +14/−7
• src/AtCoder/Extra/Monoid/RangeAdd.hs +2/−2
• src/AtCoder/Extra/Monoid/RangeSet.hs +2/−1
• src/AtCoder/Extra/Pool.hs +49/−11
• src/AtCoder/Extra/Semigroup/Matrix.hs +18/−18
• src/AtCoder/Extra/Seq.hs +50/−70
• src/AtCoder/Extra/Seq/Map.hs +742/−0
• src/AtCoder/Extra/Seq/Raw.hs +203/−96
• src/AtCoder/Extra/WaveletMatrix2d.hs +1/−1
• src/AtCoder/Internal/Assert.hs +55/−0
• src/AtCoder/Internal/Buffer.hs +22/−1
• src/AtCoder/Internal/GrowVec.hs +22/−0
• src/AtCoder/LazySegTree.hs +3/−2
• test/Main.hs +14/−0
• test/Tests/Extra/DynLazySegTree.hs +184/−0
• test/Tests/Extra/DynLazySegTree/Persistent.hs +189/−0
• test/Tests/Extra/DynSegTree.hs +154/−0
• test/Tests/Extra/DynSegTree/Persistent.hs +159/−0
• test/Tests/Extra/DynSparseSegTree.hs +141/−0
• test/Tests/Extra/DynSparseSegTree/Persistent.hs +145/−0
• test/Tests/Extra/Seq.hs +23/−1
• test/Tests/Extra/Seq/Map.hs +283/−0
• test/Tests/LazySegTree.hs +1/−0

@@ -1,5 +1,12 @@ # Revision history for acl-hs +## 1.2.1.0 -- Feb 2025++- Added dynamic segment family+- Added `Extra.Seq.Map`+- Fixed `Extra.Pool.size`+- `Handle` is moved from `Extra.Seq` to `Extra.Pool`+ ## 1.2.0.0 -- Feb 2025  - Added `AtCoder.Extra.Seq`@@ -8,6 +15,7 @@   - `Matrix.diag` now does not take length parameter   - `Extra.Math.primitiveRoot` is renamed to `primitiveRoot32`   - `Internal.Convolution` functions now use `ST` instead of `PrimMonad`+  - `SegAct` implementation for `Extra.Monoid.RangeAdd` over `Max` and `Min` were fixed  ## 1.1.1.0 -- Jan 2025 

@@ -4,7 +4,7 @@ -- PVP summary:  +-+------- breaking API changes --               | | +----- non-breaking API additions --               | | | +--- code changes with no API change-version:         1.2.0.0+version:         1.2.1.0 synopsis:        Data structures and algorithms description:   Haskell port of [ac-library](https://github.com/atcoder/ac-library), a library for competitive@@ -63,6 +63,15 @@     AtCoder.Convolution     AtCoder.Dsu     AtCoder.Extra.Bisect+    AtCoder.Extra.DynLazySegTree+    AtCoder.Extra.DynLazySegTree.Persistent+    AtCoder.Extra.DynLazySegTree.Raw+    AtCoder.Extra.DynSegTree+    AtCoder.Extra.DynSegTree.Raw+    AtCoder.Extra.DynSegTree.Persistent+    AtCoder.Extra.DynSparseSegTree+    AtCoder.Extra.DynSparseSegTree.Raw+    AtCoder.Extra.DynSparseSegTree.Persistent     AtCoder.Extra.Graph     AtCoder.Extra.HashMap     AtCoder.Extra.IntervalMap@@ -82,6 +91,7 @@     AtCoder.Extra.Semigroup.Matrix     AtCoder.Extra.Semigroup.Permutation     AtCoder.Extra.Seq+    AtCoder.Extra.Seq.Map     AtCoder.Extra.Seq.Raw     AtCoder.Extra.Tree     AtCoder.Extra.Tree.Hld@@ -133,6 +143,12 @@     Tests.Convolution     Tests.Dsu     Tests.Extra.Bisect+    Tests.Extra.DynLazySegTree+    Tests.Extra.DynLazySegTree.Persistent+    Tests.Extra.DynSegTree+    Tests.Extra.DynSegTree.Persistent+    Tests.Extra.DynSparseSegTree+    Tests.Extra.DynSparseSegTree.Persistent     Tests.Extra.Graph     Tests.Extra.HashMap     Tests.Extra.IntervalMap@@ -144,6 +160,7 @@     Tests.Extra.Semigroup.Matrix     Tests.Extra.Semigroup.Permutation     Tests.Extra.Seq+    Tests.Extra.Seq.Map     Tests.Extra.WaveletMatrix     Tests.Extra.WaveletMatrix.BitVector     Tests.Extra.WaveletMatrix.Raw

@@ -0,0 +1,309 @@+{-# 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,+  )+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 nLdst l r = stToPrim $ Raw.newST False nLdst l r (\_ _ -> 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 nLdst l r g = stToPrim $ Raw.newST False nLdst l r 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 n q = 4 * q * max 2 (ceiling (logBase 2 (fromIntegral 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 dst = stToPrim $ Raw.newRootST 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 dst xs = stToPrim $ Raw.newSeqST dst 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 dst root i x = stToPrim $ do+  _ <- Raw.modifyMST dst root (pure . const x) i+  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 dst root f i = stToPrim $ do+  _ <- Raw.modifyMST dst root (pure . f) i+  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 dst root f i = do+  _ <- Raw.modifyMST dst root f i+  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 dst root l r = stToPrim $ do+  Raw.prodST dst root l 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 dst@Raw.DynLazySegTree {l0Ldst, r0Ldst} root = stToPrim $ do+  Raw.prodST dst root l0Ldst 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 dst root i act = stToPrim $ do+  _ <- Raw.applyInST dst root i (i + 1) act+  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 dst root l r act = stToPrim $ do+  _ <- Raw.applyInST dst root l r act+  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 dst@Raw.DynLazySegTree {l0Ldst, r0Ldst} root act = stToPrim $ do+  _ <- Raw.applyInST dst root l0Ldst r0Ldst act+  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 dst root other l r = stToPrim $ do+  _ <- Raw.copyIntervalWithST dst root other l r mempty+  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 dst root other l r act = stToPrim $ do+  _ <- Raw.copyIntervalWithST dst root other l r act+  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 dst root l r = stToPrim $ do+  _ <- Raw.resetIntervalST dst root l r+  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 dst root f = do+  Raw.maxRightM dst root (pure . 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 dst root f = do+  Raw.maxRightM dst root f

@@ -0,0 +1,291 @@+{-# LANGUAGE TypeFamilies #-}++-- | A dynamic, persistent, 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/ \(8q \log_2 L\), where \(q\) is the number of mutable operations and \(L\) is the+-- length of the interval.+--+-- ==== __Example__+--+-- >>> import AtCoder.Extra.DynLazySegTree.Persistent 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+--+-- Each modification returns a new handle:+--+-- >>> root1 <- Seg.write seg root 1 $ Sum 10+-- >>> root2 <- Seg.write seg root1 2 $ Sum 20+-- >>> -- [0, 10, 20, 0]+-- >>> Seg.prod seg root2 0 3+-- Sum {getSum = 30}+--+-- >>> -- [0, 10, 20, 0] -> [0, 21, 41, 1]+-- >>> root3 <- Seg.applyIn seg root2 1 4 $ Affine1.new 2 1+-- >>> Seg.maxRight seg root3 (<= (Sum 62))+-- 3+--+-- If multiple tree roots are allocated, `copyInterval` and `copyIntervalWith` can be used.+--+-- @since 1.2.1.0+module AtCoder.Extra.DynLazySegTree.Persistent+  ( -- * Dynamic, lazily propagated segment tree+    Raw.DynLazySegTree (..),++    -- * Re-exports+    SegAct (..),+    P.Index (..),++    -- * Constructors+    new,+    buildWith,+    recommendedCapacity,+    newRoot,+    newSeq,++    -- * 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,+  )+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, persistent, lazily propagated segment tree+  m (Raw.DynLazySegTree (PrimState m) f a)+new capacityLdst l r = stToPrim $ Raw.newST True capacityLdst l r (\_ _ -> mempty)++-- | \(O(n)\) Creates a `DynLazySegTree` of capacity \(n\) for interval \([l_0, r_0)\) with initial+-- 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, persistent, lazily propagated segment tree+  m (Raw.DynLazySegTree (PrimState m) f a)+buildWith capacityLdst l r g = stToPrim $ Raw.newST True capacityLdst l r g++-- | \(O(1)\) Returns recommended capacity for \(L\) and \(q\): about \(8q \log_2 L\).+--+-- @since 1.2.1.0+{-# INLINE recommendedCapacity #-}+recommendedCapacity :: Int -> Int -> Int+recommendedCapacity n q = 8 * q * max 2 (ceiling (logBase 2 (fromIntegral n) :: Double))++-- | \(O(1)\) Creates a new root in \([l_0, r_0)\).+--+-- @since 1.2.1.0+newRoot :: (HasCallStack, PrimMonad m, Monoid f, VU.Unbox f, Monoid a, VU.Unbox a) => Raw.DynLazySegTree (PrimState m) f a -> m P.Index+newRoot dst = stToPrim $ Raw.newRootST dst++-- | \(O(n)\) Creates a new root node with contiguous leaf values.+--+-- ==== Constraints+-- - \([l_0, r_0) = [0, L)\): The index boundary of the segment tree must match the sequence.+--+-- @since 1.2.1.0+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 dst xs = stToPrim $ Raw.newSeqST dst 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 P.Index+write dst root i x = stToPrim $ do+  Raw.modifyMST dst root (pure . const x) i++-- | \(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 P.Index+modify dst root f i = stToPrim $ do+  Raw.modifyMST dst root (pure . f) i++-- | \(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 P.Index+modifyM dst root f i = do+  Raw.modifyMST dst root f i++-- | \(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 dst root l r = stToPrim $ do+  Raw.prodST dst root l 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 dst@Raw.DynLazySegTree {l0Ldst, r0Ldst} root = stToPrim $ do+  Raw.prodST dst root l0Ldst 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 P.Index+applyAt dst root i act = stToPrim $ do+  Raw.applyInST dst root i (i + 1) act++-- | \(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 P.Index+applyIn dst root l r act = stToPrim $ do+  Raw.applyInST dst root l r act++-- | \(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 P.Index+applyAll dst@Raw.DynLazySegTree {l0Ldst, r0Ldst} root act = stToPrim $ do+  Raw.applyInST dst root l0Ldst r0Ldst act++-- | \(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\)+--+-- @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 P.Index+copyInterval dst root other l r = stToPrim $ do+  Raw.copyIntervalWithST dst root other l r mempty++-- | \(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\)+--+-- @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 P.Index+copyIntervalWith dst root other l r act = stToPrim $ do+  Raw.copyIntervalWithST dst root other l r act++-- | \(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 P.Index+resetInterval dst root l r = stToPrim $ do+  Raw.resetIntervalST dst root l r++-- | \(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 dst root f = do+  Raw.maxRightM dst root (pure . 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 dst root f = do+  Raw.maxRightM dst root f

@@ -0,0 +1,537 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeFamilies #-}++-- | Base module of a dynamic, lazily propagated segment tree.+--+-- @since 1.2.1.0+module AtCoder.Extra.DynLazySegTree.Raw+  ( -- * Dynamic, lazily propagated segment tree+    DynLazySegTree (..),++    -- * Re-exports+    SegAct (..),+    P.Index (..),++    -- * Constructors+    newST,+    newRootST,+    newNodeST,+    newSeqST,++    -- * Accessing elements+    modifyMST,++    -- * Products+    prodST,+    -- prodMaybe,++    -- * Applications+    applyInST,++    -- * Tree operations+    copyIntervalWithST,+    resetIntervalST,++    -- * Binary searches+    maxRightM,+    -- -- * Conversions+    -- freezeST,+  )+where++import AtCoder.Extra.Pool qualified as P+import AtCoder.Internal.Assert qualified as ACIA+import AtCoder.LazySegTree (SegAct (..))+import Control.Monad (when)+import Control.Monad.Primitive (PrimMonad, PrimState, stToPrim)+import Control.Monad.ST (ST)+import Data.Coerce (coerce)+import Data.Maybe (fromMaybe)+import Data.Vector.Generic qualified as VG+import Data.Vector.Generic.Mutable qualified as VGM+import Data.Vector.Unboxed qualified as VU+import Data.Vector.Unboxed.Mutable qualified as VUM+import GHC.Stack (HasCallStack)+import Prelude hiding (read)++-- | A dynamic, lazily propagated segment tree that covers a half-open interval \([l_0, r_0)\).+-- The nodes are instantinated as needed.+--+-- @since 1.2.1.0+data DynLazySegTree s f a = DynLazySegTree+  { -- | The maximum number of nodes allocated+    --+    -- @since 1.2.1.0+    capacityLdst :: {-# UNPACK #-} !Int,+    -- | Whether the data is persistent or not+    --+    -- @since 1.2.1.0+    isPersistentLdst :: {-# UNPACK #-} !Bool,+    -- | Left index boundary (inclusive)+    --+    -- @since 1.2.1.0+    l0Ldst :: {-# UNPACK #-} !Int,+    -- | Right index boundary (exclusive)+    --+    -- @since 1.2.1.0+    r0Ldst :: {-# UNPACK #-} !Int,+    -- | Initial monoid value assignment \(g: (l, r) \rightarrow a\)+    --+    -- @since 1.2.1.0+    initialProdLdst :: !(Int -> Int -> a),+    -- | `Pool` for free slot management.+    --+    -- @since 1.2.1.0+    poolLdst :: !(P.Pool s ()),+    -- | Decomposed node storage: left children+    --+    -- @since 1.2.1.0+    lLdst :: !(VUM.MVector s P.Index),+    -- | Decomposed node storage: right children+    --+    -- @since 1.2.1.0+    rLdst :: !(VUM.MVector s P.Index),+    -- | Decomposed node storage: monoid value+    --+    -- @since 1.2.1.0+    xLdst :: !(VUM.MVector s a),+    -- | Decomposed node storage: lazily propagated monoid action+    --+    -- @since 1.2.1.0+    lazyLdst :: !(VUM.MVector s f)+  }++-- | \(O(n)\)+--+-- @since 1.2.1.0+{-# INLINEABLE newST #-}+newST :: (HasCallStack, VU.Unbox f, VU.Unbox a) => Bool -> Int -> Int -> Int -> (Int -> Int -> a) -> ST s (DynLazySegTree s f a)+newST isPersistentLdst capacityLdst l0Ldst r0Ldst initialProdLdst = do+  let !_ = ACIA.runtimeAssert (l0Ldst <= r0Ldst) $ "AtCoder.Extra.DynLazySegTree.Raw.newST: given invalid interval " ++ show (l0Ldst, r0Ldst)+  poolLdst <- P.new capacityLdst+  lLdst <- VUM.unsafeNew capacityLdst+  rLdst <- VUM.unsafeNew capacityLdst+  xLdst <- VUM.unsafeNew capacityLdst+  lazyLdst <- VUM.unsafeNew capacityLdst+  pure DynLazySegTree {..}++-- | \(O(1)\)+--+-- @since 1.2.1.0+{-# INLINE newRootST #-}+newRootST :: (HasCallStack, Monoid f, VU.Unbox f, Monoid a, VU.Unbox a) => DynLazySegTree s f a -> ST s P.Index+newRootST dst@DynLazySegTree {..} = do+  newNodeInST dst l0Ldst r0Ldst++-- | \(O(1)\)+--+-- @since 1.2.1.0+{-# INLINE newNodeST #-}+newNodeST :: (HasCallStack, Monoid f, VU.Unbox f, Monoid a, VU.Unbox a) => DynLazySegTree s f a -> a -> ST s P.Index+newNodeST DynLazySegTree {..} !x = do+  i <- P.alloc poolLdst ()+  VGM.write lLdst (coerce i) P.undefIndex+  VGM.write rLdst (coerce i) P.undefIndex+  VGM.write xLdst (coerce i) x+  VGM.write lazyLdst (coerce i) mempty+  pure i++-- | \(O(L)\)+--+-- @since 1.2.1.0+{-# INLINEABLE newSeqST #-}+newSeqST :: (HasCallStack, Monoid f, VU.Unbox f, Monoid a, VU.Unbox a) => DynLazySegTree s f a -> VU.Vector a -> ST s P.Index+newSeqST dst@DynLazySegTree {..} !xs = do+  let !_ = ACIA.runtimeAssert (l0Ldst == 0 && r0Ldst == VU.length xs) "AtCoder.Extra.DynLazySegTree.Raw: mismatch between the bounds and the input vector: the bounds must be [0, n)"+  -- run DFS and allocate nodes from left to right+  let dfs l r+        | l == r = pure P.undefIndex+        | r - l == 1 = newNodeST dst $ xs VG.! l+        | otherwise = do+            let m = (l + r) `div` 2+            lRoot <- dfs l m+            rRoot <- dfs m r+            xlRoot <- VGM.read xLdst (coerce lRoot)+            xrRoot <- VGM.read xLdst (coerce rRoot)+            let !x = xlRoot <> xrRoot+            root <- newNodeST dst x+            VGM.write lLdst (coerce root) lRoot+            VGM.write rLdst (coerce root) rRoot+            pure root+  dfs 0 (VU.length xs)++-- | \(O(1)\)+--+-- ==== Constraints+-- - The interval must be non-empty+--+-- @since 1.2.1.0+{-# INLINE newNodeInST #-}+newNodeInST :: (HasCallStack, Monoid f, VU.Unbox f, Monoid a, VU.Unbox a) => DynLazySegTree s f a -> Int -> Int -> ST s P.Index+newNodeInST dst@DynLazySegTree {initialProdLdst} l r = do+  let !_ = ACIA.runtimeAssert (r > l) $ "AtCoder.Extra.DynLazySegTree.Raw.nodeNodeInST: not empty or negative interval: " ++ show (l, r)+  newNodeST dst $! initialProdLdst l r++-- | \(O(\log L)\)+--+-- @since 1.2.1.0+{-# INLINEABLE modifyMST #-}+modifyMST :: forall m f a. (HasCallStack, PrimMonad m, SegAct f a, Eq f, Monoid f, VU.Unbox f, Monoid a, VU.Unbox a) => DynLazySegTree (PrimState m) f a -> P.Index -> (a -> m a) -> Int -> m P.Index+modifyMST dst@DynLazySegTree {..} root f i = inner root l0Ldst r0Ldst+  where+    !_ = ACIA.checkIndexBounded "AtCoder.Extra.DynLazySegTree.Raw.modifyMST" i l0Ldst r0Ldst+    inner :: P.Index -> Int -> Int -> m P.Index+    inner c l r+      | r - l == 1 = do+          -- let !_ = ACIA.runtimeAssert (i == l) ""+          c' <- stToPrim $ cloneOnWriteST dst c+          VGM.modifyM xLdst f (coerce c')+          stToPrim $ VGM.write lazyLdst (coerce c') mempty+          pure c'+      | otherwise = do+          stToPrim $ propST dst c l r+          let m = (l + r) `div` 2++          -- lazily allocate left and right children:+          cl <- stToPrim $ do+            j <- VGM.read lLdst (coerce c)+            if P.nullIndex j+              then do+                j' <- newNodeInST dst l m+                VGM.write lLdst (coerce c) j'+                pure j'+              else pure j++          cr <- stToPrim $ do+            j <- VGM.read rLdst (coerce c)+            if P.nullIndex j+              then do+                j' <- newNodeInST dst m r+                VGM.write rLdst (coerce c) j'+                pure j'+              else pure j++          c' <- stToPrim $ cloneOnWriteST dst c+          if i < m+            then stToPrim . VGM.write lLdst (coerce c') =<< inner cl l m+            else stToPrim . VGM.write rLdst (coerce c') =<< inner cr m r++          stToPrim $ do+            -- Note that either left or right child of `c'` is updated in the above `if`+            clx <- VGM.read xLdst . coerce =<< VGM.read lLdst (coerce c')+            crx <- VGM.read xLdst . coerce =<< VGM.read rLdst (coerce c')+            VGM.write xLdst (coerce c') $! clx <> crx+          pure c'++-- | \(O(\log L)\)+--+-- @since 1.2.1.0+{-# INLINEABLE applyInST #-}+applyInST :: forall f a s. (HasCallStack, SegAct f a, Eq f, Monoid f, VU.Unbox f, Monoid a, VU.Unbox a) => DynLazySegTree s f a -> P.Index -> Int -> Int -> f -> ST s P.Index+applyInST dst@DynLazySegTree {..} root0 ql0 qr0 !f+  | ql0 == qr0 = pure root0+  | otherwise = inner root0 l0Ldst r0Ldst ql0 qr0+  where+    !_ = ACIA.checkIntervalBounded "AtCoder.Extra.DynLazySegTree.Raw.applyInST" ql0 qr0 l0Ldst r0Ldst+    !_ = ACIA.runtimeAssert (not (P.nullIndex root0)) "AtCoder.Extra.DynLazySegTree.Raw.applyInST"+    -- left to right+    -- - l, r: node interval+    -- - ql, qr: queried interval+    inner :: P.Index -> Int -> Int -> Int -> Int -> ST s P.Index+    inner c_ l r ql_ qr_ = do+      c <- if P.nullIndex c_ then newNodeInST dst l r else pure c_+      if len <= 0+        then do+          -- A node of length zero would be created if the interval length is odd. It's OK:+          pure c+        else+          if l == ql && r == qr+            then do+              c' <- cloneOnWriteST dst c+              VGM.modify xLdst (segActWithLength len f) (coerce c')+              VGM.modify lazyLdst (f <>) (coerce c')+              pure c'+            else do+              propST dst c l r+              let m = (l + r) `div` 2+              c' <- cloneOnWriteST dst c+              VGM.modifyM lLdst (\i -> inner i l m ql qr) (coerce c')+              VGM.modifyM rLdst (\i -> inner i m r ql qr) (coerce c')+              clx <- VGM.read xLdst . coerce =<< VGM.read lLdst (coerce c')+              crx <- VGM.read xLdst . coerce =<< VGM.read rLdst (coerce c')+              VGM.write xLdst (coerce c') $! clx <> crx+              pure c'+      where+        -- shrink target interval to node interval+        ql = max ql_ l+        qr = min qr_ r+        len = qr - ql++-- | \(O(\log L)\)+--+-- @since 1.2.1.0+{-# INLINEABLE prodST #-}+prodST :: forall f a s. (HasCallStack, SegAct f a, Monoid f, VU.Unbox f, Monoid a, VU.Unbox a) => DynLazySegTree s f a -> P.Index -> Int -> Int -> ST s a+prodST DynLazySegTree {..} root0 ql0 qr0+  | ql0 >= qr0 || P.nullIndex root0 = pure mempty+  | otherwise = inner root0 l0Ldst r0Ldst ql0 qr0 mempty mempty+  where+    !_ = ACIA.checkIntervalBounded "AtCoder.Extra.DynLazySegTree.Raw.prodST" ql0 qr0 l0Ldst r0Ldst+    -- left to right+    -- - l, r: node interval+    -- - ql, qr: queried interval+    inner :: P.Index -> Int -> Int -> Int -> Int -> a -> f -> ST s a+    inner c l r ql_ qr_ !x !f+      | len <= 0 = pure x+      | P.nullIndex c = do+          pure $! x <> segActWithLength len f (initialProdLdst ql qr)+      | l == ql && r == qr = do+          cx <- VGM.read xLdst (coerce c)+          pure $! x <> segActWithLength len f cx+      | otherwise = do+          let m = (l + r) `div` 2+          !f' <- (f <>) <$> VGM.read lazyLdst (coerce c)+          cl <- VGM.read lLdst (coerce c)+          x' <- inner cl l m ql qr x f'+          cr <- VGM.read rLdst (coerce c)+          x'' <- inner cr m r ql qr x' f'+          pure x''+      where+        -- shrink target interval to node interval+        ql = max ql_ l+        qr = min qr_ r+        len = qr - ql++-- | \(O(\log L)\)+--+-- @since 1.2.1.0+{-# INLINEABLE copyIntervalWithST #-}+copyIntervalWithST ::+  forall f a s.+  (HasCallStack, SegAct f a, Eq f, Monoid f, VU.Unbox f, Monoid a, VU.Unbox a) =>+  -- | Dynamic segment tree+  DynLazySegTree s f a ->+  -- | Root to be modified+  P.Index ->+  -- | Another segment tree+  P.Index ->+  -- | \(l\)+  Int ->+  -- | \(r\)+  Int ->+  -- | Action \(f\)+  f ->+  -- | New root+  ST s P.Index+copyIntervalWithST dst@DynLazySegTree {..} rootA rootB ql0 qr0 !f0+  | rootA == rootB = pure rootA+  | otherwise = do+      if ql0 >= qr0+        then pure rootA+        else do+          rootA' <- cloneOnWriteST dst rootA+          inner rootA' rootB l0Ldst r0Ldst ql0 qr0 f0+          pure rootA'+  where+    !_ = ACIA.checkIntervalBounded "AtCoder.Extra.DynLazySegTree.Raw.copyIntervalWithST" ql0 qr0 l0Ldst r0Ldst+    !_ = ACIA.runtimeAssert (not (P.nullIndex rootA)) "AtCoder.Extra.DynLazySegTree.Raw.copyIntervalWithST: given null"++    -- left to right+    -- - l, r: node interval+    -- - ql, qr: queried interval+    inner :: P.Index -> P.Index -> Int -> Int -> Int -> Int -> f -> ST s ()+    inner c d l r ql_ qr_ !f+      | len <= 0 = pure () -- `c` is already cloned+      | l == ql && r == qr = do+          if not (P.nullIndex d)+            then do+              VGM.write xLdst (coerce c) . segActWithLength len f =<< VGM.read xLdst (coerce d)+              VGM.write lazyLdst (coerce c) . (f <>) =<< VGM.read lazyLdst (coerce d)+              VGM.write lLdst (coerce c) =<< VGM.read lLdst (coerce d)+              VGM.write rLdst (coerce c) =<< VGM.read rLdst (coerce d)+            else do+              VGM.write xLdst (coerce c) . segActWithLength len f $! initialProdLdst l r+              VGM.write lazyLdst (coerce c) f+              VGM.write lLdst (coerce c) P.undefIndex+              VGM.write rLdst (coerce c) P.undefIndex+      | otherwise = do+          let m = (l + r) `div` 2+          VGM.modifyM lLdst (\i -> if P.nullIndex i then newNodeST dst (initialProdLdst l m) else cloneOnWriteST dst i) (coerce c)+          cl <- VGM.read lLdst (coerce c)+          VGM.modifyM rLdst (\i -> if P.nullIndex i then newNodeST dst (initialProdLdst m r) else cloneOnWriteST dst i) (coerce c)+          cr <- VGM.read rLdst (coerce c)+          cLazy <- VGM.exchange lazyLdst (coerce c) mempty+          VGM.modify xLdst (segActWithLength (m - l) cLazy) (coerce cl)+          VGM.modify xLdst (segActWithLength (r - m) cLazy) (coerce cr)+          VGM.modify lazyLdst (cLazy <>) (coerce cl)+          VGM.modify lazyLdst (cLazy <>) (coerce cr)+          !f' <- if P.nullIndex d then pure f else (f <>) <$> VGM.read lazyLdst (coerce d)+          dl' <- fromMaybe P.undefIndex <$> VGM.readMaybe lLdst (coerce d)+          dr' <- fromMaybe P.undefIndex <$> VGM.readMaybe rLdst (coerce d)+          inner cl dl' l m ql qr f'+          inner cr dr' m r ql qr f'+          clx <- VGM.read xLdst (coerce cl)+          crx <- VGM.read xLdst (coerce cr)+          VGM.write xLdst (coerce c) $! clx <> crx+      where+        !_ = ACIA.runtimeAssert (not (P.nullIndex c)) "AtCoder.Extra.DynLazySegTree.Raw.copyIntervalWithST: implementation error"+        -- shrink target interval to node interval+        ql = max ql_ l+        qr = min qr_ r+        len = qr - ql++-- | \(O(\log L)\) Resets an interval \([l, r)\) to initial monoid values.+--+-- @since 1.2.1.0+{-# INLINEABLE resetIntervalST #-}+resetIntervalST ::+  forall f a s.+  (HasCallStack, SegAct f a, Eq f, Monoid f, VU.Unbox f, Monoid a, VU.Unbox a) =>+  DynLazySegTree s f a ->+  P.Index ->+  Int ->+  Int ->+  ST s P.Index+resetIntervalST dst@DynLazySegTree {..} root ql0 qr0+  | ql0 == qr0 = pure root+  | P.nullIndex root = pure P.undefIndex+  | ql0 == l0Ldst && qr0 == r0Ldst = do+      -- for the case of non-persistent segment tere, we should update the root in-place:+      root' <- cloneOnWriteST dst root+      VGM.write xLdst (coerce root') $! initialProdLdst l0Ldst r0Ldst+      VGM.write lLdst (coerce root') P.undefIndex+      VGM.write rLdst (coerce root') P.undefIndex+      VGM.write lazyLdst (coerce root') mempty+      pure root'+  | otherwise = inner root l0Ldst r0Ldst ql0 qr0+  where+    !_ = ACIA.checkIntervalBounded "AtCoder.Extra.DynLazySegTree.Raw.resetIntervalST" ql0 qr0 l0Ldst r0Ldst++    -- replace interval with null+    inner :: P.Index -> Int -> Int -> Int -> Int -> ST s P.Index+    inner c l r ql_ qr_+      -- TODO: shall we allocate new node?+      | len <= 0 = pure c+      | P.nullIndex c = pure P.undefIndex+      -- NOTE: we're returning `undefIndex`, but we can instead free the subtree if it's not persistent+      | ql <= l && r <= qr = pure P.undefIndex+      | r - l == 1 = pure c+      | otherwise = do+          propST dst c l r+          let m = (l + r) `div` 2+          c' <- cloneOnWriteST dst c+          VGM.modifyM lLdst (\i -> inner i l m ql qr) (coerce c')+          cl <- VGM.read lLdst (coerce c')+          VGM.modifyM rLdst (\i -> inner i m r ql qr) (coerce c')+          cr <- VGM.read rLdst (coerce c')+          clx <- if P.nullIndex cl then pure $! initialProdLdst l m else VGM.read xLdst (coerce cl)+          crx <- if P.nullIndex cr then pure $! initialProdLdst m r else VGM.read xLdst (coerce cr)+          VGM.write xLdst (coerce c') $! clx <> crx+          pure c'+      where+        -- shrink target interval to node interval+        ql = max ql_ l+        qr = min qr_ r+        len = qr - ql++-- It returns only allocated leaf values+-- {-# INLINEABLE freezeST #-}+-- freezeST :: forall f a s. (HasCallStack, SegAct f a, Monoid f, VU.Unbox f, Monoid a, VU.Unbox a) => DynLazySegTree s f a -> P.Index -> ST s (VU.Vector a)+-- freezeST DynLazySegTree {..} root = do+--   buf <- B.new (r0Ldst - l0Ldst)+--+--   let inner c l r !f+--         | P.nullIndex c = pure ()+--         | r - l == 1 = do+--             x <- VGM.read xLdst (coerce c)+--             B.pushBack buf $! segAct f x+--         | otherwise = do+--             let m = (l + r) `div` 2+--             !f' <- (f <>) <$> VGM.read lazyLdst (coerce c)+--             cl <- VGM.read lLdst (coerce c)+--             cr <- VGM.read rLdst (coerce c)+--             inner cl l m f'+--             inner cr m r f'+--+--   inner root l0Ldst r0Ldst mempty+--   B.unsafeFreeze buf++-- | \(O(\log L)\)+--+-- @since 1.2.1.0+{-# INLINEABLE maxRightM #-}+maxRightM :: (HasCallStack, PrimMonad m, SegAct f a, Eq f, Monoid f, VU.Unbox f, Monoid a, VU.Unbox a) => DynLazySegTree (PrimState m) f a -> P.Index -> (a -> m Bool) -> m Int+maxRightM dst@DynLazySegTree {..} root !f = do+  (!r, !_) <- inner root l0Ldst r0Ldst mempty+  pure r+  where+    -- FIXME: it should not allocate new nodes+    inner c_ l r !x = do+      c <- if P.nullIndex c_ then stToPrim $ newNodeInST dst l r else pure c_+      xWhole <- stToPrim $ (x <>) <$> VGM.read xLdst (coerce c)+      b <- f xWhole+      if b+        then do+          pure (r, xWhole)+        else do+          if r - l == 1+            then pure (l, x)+            else do+              stToPrim $ propST dst c l r+              let m = (l + r) `div` 2+              cl <- stToPrim $ VGM.read lLdst (coerce c)+              (!k, !xl) <- inner cl l m x+              if k < m+                then pure (k, xl)+                else do+                  cr <- stToPrim $ VGM.read rLdst (coerce c)+                  inner cr m r xl++-- -------------------------------------------------------------------------------------------------+-- Internals+-- -------------------------------------------------------------------------------------------------++-- | \(O(1)\) Optionally clones a node depending on the persistency setting.+{-# INLINEABLE cloneOnWriteST #-}+cloneOnWriteST :: (HasCallStack, SegAct f a, Monoid f, VU.Unbox f, Monoid a, VU.Unbox a) => DynLazySegTree s f a -> P.Index -> ST s P.Index+cloneOnWriteST DynLazySegTree {..} c+  | not isPersistentLdst || P.nullIndex c = pure c+  | otherwise = do+      i <- P.alloc poolLdst ()+      VGM.write lLdst (coerce i) =<< VGM.read lLdst (coerce c)+      VGM.write rLdst (coerce i) =<< VGM.read rLdst (coerce c)+      VGM.write xLdst (coerce i) =<< VGM.read xLdst (coerce c)+      VGM.write lazyLdst (coerce i) =<< VGM.read lazyLdst (coerce c)+      pure i++-- | \(O(1)\)+{-# INLINEABLE propST #-}+propST :: (HasCallStack, SegAct f a, Eq f, Monoid f, VU.Unbox f, Monoid a, VU.Unbox a) => DynLazySegTree s f a -> P.Index -> Int -> Int -> ST s ()+propST dst@DynLazySegTree {..} c l r = do+  let !_ = ACIA.runtimeAssert (r - l >= 2) "AtCoder.Extra.DynLazySegTree.Raw.propST: the interval must have length more than or equal to `2`"+  cLazy <- VGM.read lazyLdst (coerce c)+  when (cLazy /= mempty) $ do+    let m = (l + r) `div` 2++    -- create or clone left child+    cl <- do+      i <- VGM.read lLdst (coerce c)+      if P.nullIndex i+        then newNodeInST dst l m+        else cloneOnWriteST dst i+    VGM.write lLdst (coerce c) cl+    VGM.modify xLdst (segActWithLength (m - l) cLazy) (coerce cl)+    VGM.modify lazyLdst (cLazy <>) (coerce cl)++    -- create or clone right child+    cr <- do+      i <- VGM.read rLdst (coerce c)+      if P.nullIndex i+        then newNodeInST dst m r+        else cloneOnWriteST dst i+    VGM.write rLdst (coerce c) cr+    VGM.modify xLdst (segActWithLength (r - m) cLazy) (coerce cr)+    VGM.modify lazyLdst (cLazy <>) (coerce cr)++    -- clear the lazy action+    VGM.write lazyLdst (coerce c) mempty

@@ -0,0 +1,219 @@+{-# LANGUAGE TypeFamilies #-}++-- | A dynamic segment tree that covers a half-open interval \([l_0, r_0)\). Nodes are+-- instantinated as needed, with the required capacity being /approximately/ \(2q \log_2 L\), where+-- \(q\) is the number of mutable operations and \(L\) is the length of the interval.+--+-- ==== __Example__+--+-- >>> import AtCoder.Extra.DynSegTree qualified as Seg+-- >>> import Data.Semigroup (Sum (..))+-- >>> import Data.Vector.Unboxed qualified as VU+--+-- Create a `DynSegTree` over \([0, 4)\) with some initial capacity:+--+-- >>> let capacityFor len q = q * max 2 (2 + ceiling (logBase 2 (fromIntegral len) :: Double))+-- >>> let len = 4; q = 2+-- >>> seg <- Seg.new @_ @(Sum Int) (capacityFor len q) 0 4+--+-- Different from the @SegTree@ 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}+--+-- >>> Seg.maxRight seg root (< (Sum 30))+-- 2+--+-- @since 1.2.1.0+module AtCoder.Extra.DynSegTree+  ( -- * Dynamic segment tree+    Raw.DynSegTree (..),++    -- * Re-exports+    P.Index (..),++    -- * Constructors+    new,+    buildWith,+    recommendedCapacity,+    newRoot,+    newSeq,++    -- * Accessing elements+    write,+    modify,+    modifyM,+    -- exchange,+    -- read,++    -- * Products+    prod,+    -- prodMaybe,+    allProd, -- FIXME: rename it to prodAll++    -- * Tree operations+    resetInterval,++    -- * Binary searches+    maxRight,+    maxRightM,+    -- -- * Conversions+    -- freeze,+  )+where++import AtCoder.Extra.DynSegTree.Raw qualified as Raw+import AtCoder.Extra.Pool qualified as P+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 `DynSegTree` 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 a, VU.Unbox a) =>+  -- | Capacity \(n\)+  Int ->+  -- | Left index boundary \(l_0\)+  Int ->+  -- | Right index boundary \(r_0\)+  Int ->+  -- | Dynamic propagated segment tree+  m (Raw.DynSegTree (PrimState m) a)+new nDst l r = stToPrim $ Raw.newST False nDst l r (\_ _ -> mempty)++-- | \(O(n)\) Creates a `DynSegTree` 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 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 segment tree+  m (Raw.DynSegTree (PrimState m) a)+buildWith nDst l r g = stToPrim $ Raw.newST False nDst l r g++-- | \(O(1)\) Returns recommended capacity for \(L\) and \(q\): about \(q \log_2 L\).+--+-- @since 1.2.1.0+{-# INLINE recommendedCapacity #-}+recommendedCapacity :: Int -> Int -> Int+recommendedCapacity n q = q * max 2 (2 + ceiling (logBase 2 (fromIntegral 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 a, VU.Unbox a) => Raw.DynSegTree (PrimState m) a -> m P.Index+newRoot dst = stToPrim $ Raw.newRootST 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 a, VU.Unbox a) => Raw.DynSegTree (PrimState m) a -> VU.Vector a -> m P.Index+newSeq dst xs = stToPrim $ Raw.newSeqST dst 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, Monoid a, VU.Unbox a) => Raw.DynSegTree (PrimState m) a -> P.Index -> Int -> a -> m ()+write dst root i x = stToPrim $ do+  _ <- Raw.modifyMST dst root (pure . const x) i+  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, Monoid a, VU.Unbox a) => Raw.DynSegTree (PrimState m) a -> P.Index -> (a -> a) -> Int -> m ()+modify dst root f i = stToPrim $ do+  _ <- Raw.modifyMST dst root (pure . f) i+  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, Monoid a, VU.Unbox a) => Raw.DynSegTree (PrimState m) a -> P.Index -> (a -> m a) -> Int -> m ()+modifyM dst root f i = do+  _ <- Raw.modifyMST dst root f i+  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, Monoid a, VU.Unbox a) => Raw.DynSegTree (PrimState m) a -> P.Index -> Int -> Int -> m a+prod dst root l r = stToPrim $ do+  Raw.prodST dst root l r++-- | \(O(\log L)\) Returns the monoid product in \([l_0, r_0)\).+--+-- @since 1.2.1.0+{-# INLINE allProd #-}+allProd :: (HasCallStack, PrimMonad m, Monoid a, VU.Unbox a) => Raw.DynSegTree (PrimState m) a -> P.Index -> m a+allProd dst@Raw.DynSegTree {l0Dst, r0Dst} root = stToPrim $ do+  Raw.prodST dst root l0Dst r0Dst++-- | \(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, Monoid a, VU.Unbox a) => Raw.DynSegTree (PrimState m) a -> P.Index -> Int -> Int -> m ()+resetInterval dst root l r = stToPrim $ do+  _ <- Raw.resetIntervalST dst root l r+  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, Monoid a, VU.Unbox a) => Raw.DynSegTree (PrimState m) a -> P.Index -> (a -> Bool) -> m Int+maxRight dst root f = do+  Raw.maxRightM dst root (pure . 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, Monoid a, VU.Unbox a) => Raw.DynSegTree (PrimState m) a -> P.Index -> (a -> m Bool) -> m Int+maxRightM dst root f = do+  Raw.maxRightM dst root f

@@ -0,0 +1,212 @@+{-# LANGUAGE TypeFamilies #-}++-- | A dynamic, persistent 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.DynSegTree.Persistent qualified as Seg+-- >>> import Data.Semigroup (Sum (..))+-- >>> import Data.Vector.Unboxed qualified as VU+--+-- Create a `DynSegTree` over \([0, 4)\) with some initial capacity:+--+-- >>> let len = 4; q = 2+-- >>> seg <- Seg.new @_ @(Sum Int) (Seg.recommendedCapacity len q) 0 4+--+-- Different from the @SegTree@ module, it requires explicit root handle:+--+-- >>> -- [0, 0, 0, 0]+-- >>> root <- Seg.newRoot seg+-- >>> root1 <- Seg.write seg root 1 $ Sum 10+-- >>> root2 <- Seg.write seg root1 2 $ Sum 20+-- >>> -- [0, 10, 20, 0]+-- >>> Seg.prod seg root2 0 3+-- Sum {getSum = 30}+--+-- >>> Seg.maxRight seg root2 (< (Sum 30))+-- 2+--+-- @since 1.2.1.0+module AtCoder.Extra.DynSegTree.Persistent+  ( -- * Dynamic segment tree+    Raw.DynSegTree (..),++    -- * Re-exports+    P.Index (..),++    -- * Constructors+    new,+    buildWith,+    recommendedCapacity,+    newRoot,+    newSeq,++    -- * Accessing elements+    write,+    modify,+    modifyM,+    -- exchange,+    -- read,++    -- * Products+    prod,+    -- prodMaybe,+    allProd, -- FIXME: rename it to prodAll++    -- * Tree operations+    resetInterval,++    -- * Binary searches+    maxRight,+    maxRightM,+    -- -- * Conversions+    -- freeze,+  )+where++import AtCoder.Extra.DynSegTree.Raw qualified as Raw+import AtCoder.Extra.Pool qualified as P+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 `DynSegTree` 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 a, VU.Unbox a) =>+  -- | Capacity \(n\)+  Int ->+  -- | Left index boundary \(l_0\)+  Int ->+  -- | Right index boundary \(r_0\)+  Int ->+  -- | Dynamic, persistent segment tree+  m (Raw.DynSegTree (PrimState m) a)+new nDst l r = stToPrim $ Raw.newST True nDst l r (\_ _ -> mempty)++-- | \(O(n)\) Creates a `DynSegTree` of capacity \(n\) for interval \([l_0, r_0)\) with initial+-- value assignment \(g(l, r)\).+--+-- @since 1.2.1.0+{-# INLINE buildWith #-}+buildWith ::+  (HasCallStack, PrimMonad m, 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, persistent segment tree+  m (Raw.DynSegTree (PrimState m) a)+buildWith nDst l r g = stToPrim $ Raw.newST True nDst l r g++-- | \(O(1)\) Returns recommended capacity for \(L\) and \(q\): \(2q \log_2 L\).+--+-- @since 1.2.1.0+{-# INLINE recommendedCapacity #-}+recommendedCapacity :: Int -> Int -> Int+recommendedCapacity n q = 2 * q * (2 + ceiling (logBase 2 (fromIntegral n) :: Double))++-- | \(O(1)\) Creates a new root in \([l_0, r_0)\).+--+-- @since 1.2.1.0+newRoot :: (HasCallStack, PrimMonad m, Monoid a, VU.Unbox a) => Raw.DynSegTree (PrimState m) a -> m P.Index+newRoot dst = stToPrim $ Raw.newRootST 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+newSeq :: (HasCallStack, PrimMonad m, Monoid a, VU.Unbox a) => Raw.DynSegTree (PrimState m) a -> VU.Vector a -> m P.Index+newSeq dst xs = stToPrim $ Raw.newSeqST dst 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, Monoid a, VU.Unbox a) => Raw.DynSegTree (PrimState m) a -> P.Index -> Int -> a -> m P.Index+write dst root i x = stToPrim $ do+  Raw.modifyMST dst root (pure . const x) i++-- | \(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, Monoid a, VU.Unbox a) => Raw.DynSegTree (PrimState m) a -> P.Index -> (a -> a) -> Int -> m P.Index+modify dst root f i = stToPrim $ do+  Raw.modifyMST dst root (pure . f) i++-- | \(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, Monoid a, VU.Unbox a) => Raw.DynSegTree (PrimState m) a -> P.Index -> (a -> m a) -> Int -> m P.Index+modifyM dst root f i = do+  Raw.modifyMST dst root f i++-- | \(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, Monoid a, VU.Unbox a) => Raw.DynSegTree (PrimState m) a -> P.Index -> Int -> Int -> m a+prod dst root l r = stToPrim $ do+  Raw.prodST dst root l r++-- | \(O(\log L)\) Returns the monoid product in \([l_0, r_0)\).+--+-- @since 1.2.1.0+{-# INLINE allProd #-}+allProd :: (HasCallStack, PrimMonad m, Monoid a, VU.Unbox a) => Raw.DynSegTree (PrimState m) a -> P.Index -> m a+allProd dst@Raw.DynSegTree {l0Dst, r0Dst} root = stToPrim $ do+  Raw.prodST dst root l0Dst r0Dst++-- | \(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, Monoid a, VU.Unbox a) => Raw.DynSegTree (PrimState m) a -> P.Index -> Int -> Int -> m P.Index+resetInterval dst root l r = stToPrim $ do+  Raw.resetIntervalST dst root l r++-- | \(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, Monoid a, VU.Unbox a) => Raw.DynSegTree (PrimState m) a -> P.Index -> (a -> Bool) -> m Int+maxRight dst root f = do+  Raw.maxRightM dst root (pure . 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, Monoid a, VU.Unbox a) => Raw.DynSegTree (PrimState m) a -> P.Index -> (a -> m Bool) -> m Int+maxRightM dst root f = do+  Raw.maxRightM dst root f

@@ -0,0 +1,339 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeFamilies #-}++-- | Base module of a dynamic segment tree.+--+-- @since 1.2.1.0+module AtCoder.Extra.DynSegTree.Raw+  ( -- * Dynamic segment tree+    DynSegTree (..),++    -- * Re-exports+    P.Index (..),++    -- * Constructors+    newST,+    newRootST,+    newNodeST,+    newSeqST,++    -- * Accessing elements+    modifyMST,++    -- * Products+    prodST,+    -- prodMaybe,++    -- * Tree operations+    resetIntervalST,++    -- * Binary searches+    maxRightM,+    -- -- * Conversions+    -- freezeST,+  )+where++import AtCoder.Extra.Pool qualified as P+import AtCoder.Internal.Assert qualified as ACIA+import Control.Monad.Primitive (PrimMonad, PrimState, stToPrim)+import Control.Monad.ST (ST)+import Data.Coerce (coerce)+import Data.Vector.Generic qualified as VG+import Data.Vector.Generic.Mutable qualified as VGM+import Data.Vector.Unboxed qualified as VU+import Data.Vector.Unboxed.Mutable qualified as VUM+import GHC.Stack (HasCallStack)+import Prelude hiding (read)++-- | A dynamic segment tree that covers a half-open interval \([l_0, r_0)\). Is is dynamic in that+-- the nodes are instantinated as needed.+--+-- @since 1.2.1.0+data DynSegTree s a = DynSegTree+  { -- | The maximum number of nodes allocated+    --+    -- @since 1.2.1.0+    capacityDst :: {-# UNPACK #-} !Int,+    -- | Whether the data is persistent or not+    --+    -- @since 1.2.1.0+    isPersistentDst :: {-# UNPACK #-} !Bool,+    -- | Left index boundary (inclusive)+    --+    -- @since 1.2.1.0+    l0Dst :: {-# UNPACK #-} !Int,+    -- | Right index boundary (exclusive)+    --+    -- @since 1.2.1.0+    r0Dst :: {-# UNPACK #-} !Int,+    -- | Initial monoid value assignment \(g: (l, r) \rightarrow a\)+    --+    -- @since 1.2.1.0+    initialProdDst :: !(Int -> Int -> a),+    -- | `Pool` for free slot management.+    --+    -- @since 1.2.1.0+    poolDst :: !(P.Pool s ()),+    -- | Decomposed node storage: left children+    --+    -- @since 1.2.1.0+    lDst :: !(VUM.MVector s P.Index),+    -- | Decomposed node storage: right children+    --+    -- @since 1.2.1.0+    rDst :: !(VUM.MVector s P.Index),+    -- | Decomposed node storage: monoid value+    --+    -- @since 1.2.1.0+    xDst :: !(VUM.MVector s a)+  }++-- | \(O(n)\)+--+-- @since 1.2.1.0+{-# INLINEABLE newST #-}+newST :: (HasCallStack, VU.Unbox a) => Bool -> Int -> Int -> Int -> (Int -> Int -> a) -> ST s (DynSegTree s a)+newST isPersistentDst capacityDst l0Dst r0Dst initialProdDst = do+  let !_ = ACIA.runtimeAssert (l0Dst <= r0Dst) $ "AtCoder.Extra.DynSegTree.Raw.newST: given invalid interval " ++ show (l0Dst, r0Dst)+  poolDst <- P.new capacityDst+  lDst <- VUM.unsafeNew capacityDst+  rDst <- VUM.unsafeNew capacityDst+  xDst <- VUM.unsafeNew capacityDst+  pure DynSegTree {..}++-- | \(O(1)\)+--+-- @since 1.2.1.0+{-# INLINE newRootST #-}+newRootST :: (HasCallStack, Monoid a, VU.Unbox a) => DynSegTree s a -> ST s P.Index+newRootST dst@DynSegTree {..} = do+  newNodeInST dst l0Dst r0Dst++-- | \(O(1)\)+--+-- @since 1.2.1.0+{-# INLINE newNodeST #-}+newNodeST :: (HasCallStack, Monoid a, VU.Unbox a) => DynSegTree s a -> a -> ST s P.Index+newNodeST DynSegTree {..} !x = do+  i <- P.alloc poolDst ()+  VGM.write lDst (coerce i) P.undefIndex+  VGM.write rDst (coerce i) P.undefIndex+  VGM.write xDst (coerce i) x+  pure i++-- | \(O(L)\)+--+-- @since 1.2.1.0+{-# INLINEABLE newSeqST #-}+newSeqST :: (HasCallStack, Monoid a, VU.Unbox a) => DynSegTree s a -> VU.Vector a -> ST s P.Index+newSeqST dst@DynSegTree {..} !xs = do+  let !_ = ACIA.runtimeAssert (l0Dst == 0 && r0Dst == VU.length xs) "AtCoder.Extra.DynSegTree.Raw: mismatch between the bounds and the input vector: the bounds must be [0, n)"+  -- run DFS and allocate nodes from left to right+  let dfs l r+        | l == r = pure P.undefIndex+        | r - l == 1 = newNodeST dst $ xs VG.! l+        | otherwise = do+            let m = (l + r) `div` 2+            lRoot <- dfs l m+            rRoot <- dfs m r+            xlRoot <- VGM.read xDst (coerce lRoot)+            xrRoot <- VGM.read xDst (coerce rRoot)+            let !x = xlRoot <> xrRoot+            root <- newNodeST dst x+            VGM.write lDst (coerce root) lRoot+            VGM.write rDst (coerce root) rRoot+            pure root+  dfs 0 (VU.length xs)++-- | \(O(1)\)+--+-- ==== Constraints+-- - The interval must be non-empty+--+-- @since 1.2.1.0+{-# INLINE newNodeInST #-}+newNodeInST :: (HasCallStack, Monoid a, VU.Unbox a) => DynSegTree s a -> Int -> Int -> ST s P.Index+newNodeInST dst@DynSegTree {initialProdDst} l r = do+  let !_ = ACIA.runtimeAssert (r > l) $ "AtCoder.Extra.DynSegTree.Raw.nodeNodeInST: not empty or negative interval: " ++ show (l, r)+  newNodeST dst $! initialProdDst l r++-- | \(O(\log L)\)+--+-- @since 1.2.1.0+{-# INLINEABLE modifyMST #-}+modifyMST :: forall m a. (HasCallStack, PrimMonad m, Monoid a, VU.Unbox a) => DynSegTree (PrimState m) a -> P.Index -> (a -> m a) -> Int -> m P.Index+modifyMST dst@DynSegTree {..} root f i = do+  root' <- stToPrim $ if P.nullIndex root then newRootST dst else cloneOnWriteST dst root+  inner root' l0Dst r0Dst+  where+    !_ = ACIA.checkIndexBounded "AtCoder.Extra.DynSegTree.Raw.modifyMST" i l0Dst r0Dst+    -- `c` is already cloned or newly allocated+    inner :: P.Index -> Int -> Int -> m P.Index+    inner c l r+      | r - l == 1 = do+          -- let !_ = ACIA.runtimeAssert (i == l) ""+          VGM.modifyM xDst f (coerce c)+          pure c+      | otherwise = do+          let m = (l + r) `div` 2++          -- one of left or right child is updated, not both+          if l <= i && i < m+            then do+              cl <- stToPrim $ do+                j <- VGM.read lDst (coerce c)+                if P.nullIndex j+                  then newNodeInST dst l m+                  else cloneOnWriteST dst j+              stToPrim $ VGM.write lDst (coerce c) cl+              _ <- inner cl l m+              pure ()+            else do+              cr <- stToPrim $ do+                j <- VGM.read rDst (coerce c)+                if P.nullIndex j+                  then newNodeInST dst m r+                  else cloneOnWriteST dst j+              stToPrim $ VGM.write rDst (coerce c) cr+              _ <- inner cr m r+              pure ()++          stToPrim $ do+            cl <- VGM.read lDst (coerce c)+            clx <- if P.nullIndex cl then pure $! initialProdDst l m else VGM.read xDst (coerce cl)+            cr <- VGM.read rDst (coerce c)+            crx <- if P.nullIndex cr then pure $! initialProdDst m r else VGM.read xDst (coerce cr)+            VGM.write xDst (coerce c) $! clx <> crx+          pure c++-- | \(O(\log L)\)+--+-- @since 1.2.1.0+{-# INLINEABLE prodST #-}+prodST :: forall a s. (HasCallStack, Monoid a, VU.Unbox a) => DynSegTree s a -> P.Index -> Int -> Int -> ST s a+prodST DynSegTree {..} root0 ql0 qr0+  | ql0 >= qr0 || P.nullIndex root0 = pure mempty+  | otherwise = inner root0 l0Dst r0Dst ql0 qr0 mempty+  where+    !_ = ACIA.checkIntervalBounded "AtCoder.Extra.DynSegTree.Raw.prodST" ql0 qr0 l0Dst r0Dst+    -- left to right+    -- - l, r: node interval+    -- - ql, qr: queried interval+    inner :: P.Index -> Int -> Int -> Int -> Int -> a -> ST s a+    inner c l r ql_ qr_ !x+      | len <= 0 = pure x+      | P.nullIndex c = do+          pure $! x <> initialProdDst ql qr+      | l == ql && r == qr = do+          cx <- VGM.read xDst (coerce c)+          pure $! x <> cx+      | otherwise = do+          let m = (l + r) `div` 2+          cl <- VGM.read lDst (coerce c)+          x' <- inner cl l m ql qr x+          cr <- VGM.read rDst (coerce c)+          inner cr m r ql qr x'+      where+        -- shrink target interval to node interval+        ql = max ql_ l+        qr = min qr_ r+        len = qr - ql++-- | \(O(\log L)\) Resets an interval \([l, r)\) to initial monoid values.+--+-- @since 1.2.1.0+{-# INLINEABLE resetIntervalST #-}+resetIntervalST ::+  forall a s.+  (HasCallStack, Monoid a, VU.Unbox a) =>+  DynSegTree s a ->+  P.Index ->+  Int ->+  Int ->+  ST s P.Index+resetIntervalST dst@DynSegTree {..} root ql0 qr0+  | ql0 == qr0 = pure root+  | P.nullIndex root = pure P.undefIndex+  | ql0 == l0Dst && qr0 == r0Dst = do+      -- for the case of non-persistent segment tere, we should update the root in-place:+      root' <- cloneOnWriteST dst root+      VGM.write xDst (coerce root') $! initialProdDst l0Dst r0Dst+      VGM.write lDst (coerce root') P.undefIndex+      VGM.write rDst (coerce root') P.undefIndex+      pure root'+  | otherwise = inner root l0Dst r0Dst ql0 qr0+  where+    !_ = ACIA.checkIntervalBounded "AtCoder.Extra.DynSegTree.Raw.resetIntervalST" ql0 qr0 l0Dst r0Dst++    -- replace interval with null+    inner :: P.Index -> Int -> Int -> Int -> Int -> ST s P.Index+    inner c l r ql_ qr_+      -- TODO: shall we allocate new node?+      | len <= 0 = pure c+      | P.nullIndex c = pure P.undefIndex+      -- NOTE: we're returning `undefIndex`, but we can instead free the subtree if it's not persistent+      | ql <= l && r <= qr = pure P.undefIndex+      | r - l == 1 = pure c+      | otherwise = do+          let m = (l + r) `div` 2+          c' <- cloneOnWriteST dst c+          VGM.modifyM lDst (\i -> inner i l m ql qr) (coerce c')+          cl <- VGM.read lDst (coerce c')+          VGM.modifyM rDst (\i -> inner i m r ql qr) (coerce c')+          cr <- VGM.read rDst (coerce c')+          clx <- if P.nullIndex cl then pure $! initialProdDst l m else VGM.read xDst (coerce cl)+          crx <- if P.nullIndex cr then pure $! initialProdDst m r else VGM.read xDst (coerce cr)+          VGM.write xDst (coerce c') $! clx <> crx+          pure c'+      where+        -- shrink target interval to node interval+        ql = max ql_ l+        qr = min qr_ r+        len = qr - ql++-- | \(O(\log L)\)+--+-- @since 1.2.1.0+{-# INLINEABLE maxRightM #-}+maxRightM :: (HasCallStack, PrimMonad m, Monoid a, VU.Unbox a) => DynSegTree (PrimState m) a -> P.Index -> (a -> m Bool) -> m Int+maxRightM dst@DynSegTree {..} root f = do+  (!r, !_) <- inner root l0Dst r0Dst mempty+  pure r+  where+    -- FIXME: it should not allocate new nodes+    inner c_ l r !x = do+      c <- if P.nullIndex c_ then stToPrim $ newNodeInST dst l r else pure c_+      xWhole <- stToPrim $ (x <>) <$> VGM.read xDst (coerce c)+      b <- f xWhole+      if b+        then do+          pure (r, xWhole)+        else do+          if r - l == 1+            then pure (l, x)+            else do+              let m = (l + r) `div` 2+              cl <- stToPrim $ VGM.read lDst (coerce c)+              (!k, !xl) <- inner cl l m x+              if k < m+                then pure (k, xl)+                else do+                  cr <- stToPrim $ VGM.read rDst (coerce c)+                  inner cr m r xl++-- -------------------------------------------------------------------------------------------------+-- Internals+-- -------------------------------------------------------------------------------------------------++-- | \(O(1)\) Optionally clones a node depending on the persistency setting.+{-# INLINEABLE cloneOnWriteST #-}+cloneOnWriteST :: (HasCallStack, Monoid a, VU.Unbox a) => DynSegTree s a -> P.Index -> ST s P.Index+cloneOnWriteST DynSegTree {..} c+  | not isPersistentDst || P.nullIndex c = pure c+  | otherwise = do+      i <- P.alloc poolDst ()+      VGM.write lDst (coerce i) =<< VGM.read lDst (coerce c)+      VGM.write rDst (coerce i) =<< VGM.read rDst (coerce c)+      VGM.write xDst (coerce i) =<< VGM.read xDst (coerce c)+      pure i

@@ -0,0 +1,185 @@+{-# LANGUAGE TypeFamilies #-}++-- | A dynamic, sparse segment tree that covers a half-open interval \([l_0, r_0)\). Nodes are+-- instantinated as needed, with the required capacity being \(q\), where \(q\) is the number of+-- mutable operations. The traid-off compared to the non-sparse variant is that initial monoid+-- values are fixed at `mempty`.+--+-- ==== __Example__+--+-- >>> import AtCoder.Extra.DynSparseSegTree qualified as Seg+-- >>> import Data.Semigroup (Sum (..))+-- >>> import Data.Vector.Unboxed qualified as VU+--+-- Create a `DynSegTree` over \([0, 4)\) with some initial capacity:+--+-- >>> let capacityFor len q = q * max 2 (2 + ceiling (logBase 2 (fromIntegral len) :: Double))+-- >>> let len = 4; q = 2+-- >>> seg <- Seg.new @_ @(Sum Int) (capacityFor len q) 0 4+--+-- Different from the @SegTree@ 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}+--+-- >>> Seg.maxRight seg root (< (Sum 30))+-- 2+--+-- @since 1.2.1.0+module AtCoder.Extra.DynSparseSegTree+  ( -- * Dynamic, sparse segment tree+    Raw.DynSparseSegTree (..),++    -- * Re-exports+    P.Handle (..),++    -- * Constructors+    new,+    recommendedCapacity,+    newRoot,++    -- * Accessing elements+    write,+    modify,+    modifyM,+    -- exchange,+    -- read,++    -- * Products+    prod,+    -- prodMaybe,+    allProd, -- FIXME: rename it to prodAll++    -- * Binary searches+    maxRight,+    maxRightM,+    -- -- * Conversions+    -- freeze,+  )+where++import AtCoder.Extra.DynSparseSegTree.Raw qualified as Raw+import AtCoder.Extra.Pool qualified as P+import Control.Monad.Primitive (PrimMonad, PrimState, stToPrim)+import Data.Vector.Generic.Mutable qualified as VGM+import Data.Vector.Unboxed qualified as VU+import GHC.Stack (HasCallStack)+import Prelude hiding (read)++-- This module is based on `Handle` because the root is defined as `P.undefIndex`++-- | \(O(n)\) Creates a `DynSparseSegTree` 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 a, VU.Unbox a) =>+  -- | Capacity \(n\)+  Int ->+  -- | Left index boundary \(l_0\)+  Int ->+  -- | Right index boundary \(r_0\)+  Int ->+  -- | Dynamic, sparse segment tree+  m (Raw.DynSparseSegTree (PrimState m) a)+new nDsst l r = stToPrim $ Raw.newST False nDsst l r++-- | \(O(1)\) Returns recommended capacity for \(L\) and \(q\): \(q\).+--+-- @since 1.2.1.0+{-# INLINE recommendedCapacity #-}+recommendedCapacity :: Int -> Int -> Int+recommendedCapacity _ q = q++-- | \(O(1)\) Creates a new root in \([l_0, r_0)\).+--+-- @since 1.2.1.0+newRoot :: (HasCallStack, PrimMonad m, Monoid a, VU.Unbox a) => Raw.DynSparseSegTree (PrimState m) a -> m (P.Handle (PrimState m))+newRoot dst = stToPrim $ P.newHandle =<< Raw.newRootST dst++-- | \(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, Monoid a, VU.Unbox a) => Raw.DynSparseSegTree (PrimState m) a -> P.Handle (PrimState m) -> Int -> a -> m ()+write dst (P.Handle handle) i x = stToPrim $ do+  VGM.modifyM+    handle+    (\root -> Raw.modifyMST dst root (pure . const x) i)+    0++-- | \(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, Monoid a, VU.Unbox a) => Raw.DynSparseSegTree (PrimState m) a -> P.Handle (PrimState m) -> (a -> a) -> Int -> m ()+modify dst (P.Handle handle) f i = stToPrim $ do+  VGM.modifyM+    handle+    (\root -> Raw.modifyMST dst root (pure . f) i)+    0++-- | \(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, Monoid a, VU.Unbox a) => Raw.DynSparseSegTree (PrimState m) a -> P.Handle (PrimState m) -> (a -> m a) -> Int -> m ()+modifyM dst (P.Handle handle) f i = do+  VGM.modifyM+    handle+    (\root -> Raw.modifyMST dst root f i)+    0++-- | \(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, Monoid a, VU.Unbox a) => Raw.DynSparseSegTree (PrimState m) a -> P.Handle (PrimState m) -> Int -> Int -> m a+prod dst (P.Handle handle) l r = stToPrim $ do+  root <- VGM.read handle 0+  Raw.prodST dst root l r++-- | \(O(\log L)\) Returns the monoid product in \([l_0, r_0)\).+--+-- @since 1.2.1.0+{-# INLINE allProd #-}+allProd :: (HasCallStack, PrimMonad m, Monoid a, VU.Unbox a) => Raw.DynSparseSegTree (PrimState m) a -> P.Handle (PrimState m) -> m a+allProd dst@Raw.DynSparseSegTree {l0Dsst, r0Dsst} (P.Handle handle) = stToPrim $ do+  root <- VGM.read handle 0+  Raw.prodST dst root l0Dsst r0Dsst++-- | \(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, Monoid a, VU.Unbox a) => Raw.DynSparseSegTree (PrimState m) a -> P.Handle (PrimState m) -> (a -> Bool) -> m Int+maxRight dst (P.Handle handle) f = do+  root <- VGM.read handle 0+  Raw.maxRightM dst root (pure . 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, Monoid a, VU.Unbox a) => Raw.DynSparseSegTree (PrimState m) a -> P.Handle (PrimState m) -> (a -> m Bool) -> m Int+maxRightM dst (P.Handle handle) f = do+  root <- VGM.read handle 0+  Raw.maxRightM dst root f

@@ -0,0 +1,168 @@+{-# LANGUAGE TypeFamilies #-}++-- | A dynamic, sparse, persitent segment tree that covers a half-open interval \([l_0, r_0)\). Nodes are+-- instantinated as needed, with the required capacity being \(2q \log_2 L\), where \(q\) is the number of+-- mutable operations. The traid-off compared to the non-sparse variant is that initial monoid+-- values are fixed at `mempty`.+--+-- ==== __Example__+--+-- >>> import AtCoder.Extra.DynSparseSegTree.Persistent qualified as Seg+-- >>> import Data.Semigroup (Sum (..))+-- >>> import Data.Vector.Unboxed qualified as VU+--+-- Create a `DynSegTree` over \([0, 4)\) with some initial capacity:+--+-- >>> let len = 4; q = 2+-- >>> seg <- Seg.new @_ @(Sum Int) (Seg.recommendedCapacity len q) 0 4+--+-- Different from the @SegTree@ module, it requires explicit root handle:+--+-- >>> -- [0, 0, 0, 0]+-- >>> root <- Seg.newRoot seg+-- >>> root1 <- Seg.write seg root 1 $ Sum 10+-- >>> root2 <- Seg.write seg root1 2 $ Sum 20+-- >>> -- [0, 10, 20, 0]+-- >>> Seg.prod seg root2 0 3+-- Sum {getSum = 30}+--+-- >>> Seg.maxRight seg root2 (< (Sum 30))+-- 2+--+-- @since 1.2.1.0+module AtCoder.Extra.DynSparseSegTree.Persistent+  ( -- * Dynamic, sparse segment tree+    Raw.DynSparseSegTree (..),++    -- * Re-exports+    P.Index (..),++    -- * Constructors+    new,+    recommendedCapacity,+    newRoot,++    -- * Accessing elements+    write,+    modify,+    modifyM,+    -- exchange,+    -- read,++    -- * Products+    prod,+    -- prodMaybe,+    allProd, -- FIXME: rename it to prodAll++    -- * Binary searches+    maxRight,+    maxRightM,+    -- -- * Conversions+    -- freeze,+  )+where++import AtCoder.Extra.DynSparseSegTree.Raw qualified as Raw+import AtCoder.Extra.Pool qualified as P+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 `DynSparseSegTree` 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 a, VU.Unbox a) =>+  -- | Capacity \(n\)+  Int ->+  -- | Left index boundary \(l_0\)+  Int ->+  -- | Right index boundary \(r_0\)+  Int ->+  -- | Dynamic, sparse, persistent segment tree+  m (Raw.DynSparseSegTree (PrimState m) a)+new nDsst l r = stToPrim $ Raw.newST True nDsst l r++-- | \(O(1)\) Returns recommended capacity for \(L\) and \(q\): \(2q \log_2 L\).+--+-- @since 1.2.1.0+{-# INLINE recommendedCapacity #-}+recommendedCapacity :: Int -> Int -> Int+recommendedCapacity n q = q * (2 + ceiling (logBase 2 (fromIntegral n) :: Double))++-- | \(O(1)\) Creates a new root in \([l_0, r_0)\).+--+-- @since 1.2.1.0+newRoot :: (HasCallStack, PrimMonad m, Monoid a, VU.Unbox a) => Raw.DynSparseSegTree (PrimState m) a -> m P.Index+newRoot dst = stToPrim $ Raw.newRootST dst++-- | \(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, Monoid a, VU.Unbox a) => Raw.DynSparseSegTree (PrimState m) a -> P.Index -> Int -> a -> m P.Index+write dst root i x = stToPrim $ do+     Raw.modifyMST dst root (pure . const x) i++-- | \(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, Monoid a, VU.Unbox a) => Raw.DynSparseSegTree (PrimState m) a -> P.Index -> (a -> a) -> Int -> m P.Index+modify dst root f i = stToPrim $ do+     Raw.modifyMST dst root (pure . f) i++-- | \(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, Monoid a, VU.Unbox a) => Raw.DynSparseSegTree (PrimState m) a -> P.Index -> (a -> m a) -> Int -> m P.Index+modifyM dst root f i = do+    Raw.modifyMST dst root f i++-- | \(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, Monoid a, VU.Unbox a) => Raw.DynSparseSegTree (PrimState m) a -> P.Index -> Int -> Int -> m a+prod dst root l r = stToPrim $ do+  Raw.prodST dst root l r++-- | \(O(\log L)\) Returns the monoid product in \([l_0, r_0)\).+--+-- @since 1.2.1.0+{-# INLINE allProd #-}+allProd :: (HasCallStack, PrimMonad m, Monoid a, VU.Unbox a) => Raw.DynSparseSegTree (PrimState m) a -> P.Index -> m a+allProd dst@Raw.DynSparseSegTree {l0Dsst, r0Dsst} root = stToPrim $ do+  Raw.prodST dst root l0Dsst r0Dsst++-- | \(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, Monoid a, VU.Unbox a) => Raw.DynSparseSegTree (PrimState m) a -> P.Index -> (a -> Bool) -> m Int+maxRight dst root f = do+  Raw.maxRightM dst root (pure . 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, Monoid a, VU.Unbox a) => Raw.DynSparseSegTree (PrimState m) a -> P.Index -> (a -> m Bool) -> m Int+maxRightM dst root f = do+  Raw.maxRightM dst root f

@@ -0,0 +1,329 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeFamilies #-}++-- | Base module of a dynamic, sparse segment tree.+--+-- @since 1.2.1.0+module AtCoder.Extra.DynSparseSegTree.Raw+  ( -- * Dynamic, sparse segment tree+    DynSparseSegTree (..),++    -- * Re-exports+    P.Index (..),++    -- * Constructors+    newST,+    newRootST,+    newNodeST,+    freeSubtreeST,++    -- * Accessing elements+    modifyMST,++    -- * Products+    prodST,+    -- prodMaybe,++    -- * Binary searches+    maxRightM,+    -- -- * Conversions+    -- freezeST,+  )+where++import AtCoder.Extra.Pool qualified as P+import AtCoder.Internal.Assert qualified as ACIA+import Control.Monad (unless)+import Control.Monad.Primitive (PrimMonad, PrimState, stToPrim)+import Control.Monad.ST (ST)+import Data.Coerce (coerce)+import Data.Vector.Generic.Mutable qualified as VGM+import Data.Vector.Unboxed qualified as VU+import Data.Vector.Unboxed.Mutable qualified as VUM+import GHC.Stack (HasCallStack)+import Prelude hiding (read)++-- | A dynamic, sparse segment tree that covers a half-open interval \([l_0, r_0)\). Is is dynamic+-- in that the nodes are instantinated as needed.+--+-- @since 1.2.1.0+data DynSparseSegTree s a = DynSparseSegTree+  { -- | The maximum number of nodes allocated+    --+    -- @since 1.2.1.0+    capacityDsst :: {-# UNPACK #-} !Int,+    -- | Whether the data is persistent or not+    --+    -- @since 1.2.1.0+    isPersistentDsst :: {-# UNPACK #-} !Bool,+    -- | Left index boundary (inclusive)+    --+    -- @since 1.2.1.0+    l0Dsst :: {-# UNPACK #-} !Int,+    -- | Right index boundary (exclusive)+    --+    -- @since 1.2.1.0+    r0Dsst :: {-# UNPACK #-} !Int,+    -- | `Pool` for free slot management.+    --+    -- @since 1.2.1.0+    poolDsst :: !(P.Pool s ()),+    -- | Decomposed node storage: left children+    --+    -- @since 1.2.1.0+    lDsst :: !(VUM.MVector s P.Index),+    -- | Decomposed node storage: right children+    --+    -- @since 1.2.1.0+    rDsst :: !(VUM.MVector s P.Index),+    -- | Decomposed node storage: position+    --+    -- @since 1.2.1.0+    xDsst :: !(VUM.MVector s a),+    -- | Decomposed node storage: position+    --+    -- @since 1.2.1.0+    iDsst :: !(VUM.MVector s Int),+    -- | Decomposed node storage: monoid product+    --+    -- @since 1.2.1.0+    prodDsst :: !(VUM.MVector s a)+  }++-- | \(O(n)\)+--+-- @since 1.2.1.0+{-# INLINEABLE newST #-}+newST :: (HasCallStack, VU.Unbox a) => Bool -> Int -> Int -> Int -> ST s (DynSparseSegTree s a)+newST isPersistentDsst capacityDsst l0Dsst r0Dsst = do+  let !_ = ACIA.runtimeAssert (l0Dsst <= r0Dsst) $ "AtCoder.Extra.DynSparseSegTree.Raw.newST: given invalid interval " ++ show (l0Dsst, r0Dsst)+  poolDsst <- P.new capacityDsst+  lDsst <- VUM.unsafeNew capacityDsst+  rDsst <- VUM.unsafeNew capacityDsst+  xDsst <- VUM.unsafeNew capacityDsst+  iDsst <- VUM.unsafeNew capacityDsst+  prodDsst <- VUM.unsafeNew capacityDsst+  pure DynSparseSegTree {..}++-- | \(O(1)\)+--+-- @since 1.2.1.0+{-# INLINE newRootST #-}+newRootST :: (HasCallStack, Monoid a, VU.Unbox a) => DynSparseSegTree s a -> ST s P.Index+newRootST _ = do+  pure P.undefIndex++-- | \(O(1)\)+--+-- @since 1.2.1.0+{-# INLINE newNodeST #-}+newNodeST :: (HasCallStack, Monoid a, VU.Unbox a) => DynSparseSegTree s a -> Int -> a -> ST s P.Index+newNodeST DynSparseSegTree {..} idx !x = do+  i <- P.alloc poolDsst ()+  VGM.write lDsst (coerce i) P.undefIndex+  VGM.write rDsst (coerce i) P.undefIndex+  VGM.write xDsst (coerce i) x+  VGM.write iDsst (coerce i) idx+  VGM.write prodDsst (coerce i) x+  pure i++-- | \(O(n)\)+--+-- @since 1.2.1.0+{-# INLINE freeSubtreeST #-}+freeSubtreeST :: (HasCallStack, Monoid a, VU.Unbox a) => DynSparseSegTree s a -> P.Index -> ST s ()+freeSubtreeST DynSparseSegTree {..} i = do+  let inner c = do+        cl <- VGM.read lDsst (coerce c)+        cr <- VGM.read rDsst (coerce c)+        unless (P.nullIndex cl) $ P.free poolDsst cl+        unless (P.nullIndex cr) $ P.free poolDsst cr+  inner i++-- | \(O(\log L)\)+--+-- @since 1.2.1.0+{-# INLINEABLE modifyMST #-}+modifyMST :: forall m a. (HasCallStack, PrimMonad m, Monoid a, VU.Unbox a) => DynSparseSegTree (PrimState m) a -> P.Index -> (a -> m a) -> Int -> m P.Index+modifyMST dst@DynSparseSegTree {..} root f i0+  | P.nullIndex root = stToPrim . newNodeST dst i0 =<< f mempty+  | otherwise = inner root l0Dsst r0Dsst i0+  where+    !_ = ACIA.checkIndexBounded "AtCoder.Extra.DynSparseSegTree.Raw.modifyMST" i0 l0Dsst r0Dsst+    inner :: P.Index -> Int -> Int -> Int -> m P.Index+    inner c_ l r i+      | P.nullIndex c_ = stToPrim . newNodeST dst i =<< f mempty+      | otherwise = do+          c <- stToPrim $ cloneOnWriteST dst c_+          ci <- stToPrim $ VGM.read iDsst (coerce c)+          if ci == i+            then do+              VGM.modifyM xDsst f (coerce c)+              stToPrim $ updateNodeST dst c+              pure c+            else do+              -- update left or right child+              let m = (l + r) `div` 2+              if i < m+                then do+                  cl <- stToPrim $ VGM.read lDsst (coerce c)+                  if ci < i+                    then do+                      -- TODO: is this statement correct?+                      -- now we know `i` does not exist in the segment tree.+                      stToPrim $ VGM.write iDsst (coerce c) i+                      cx <- stToPrim . VGM.exchange xDsst (coerce c) =<< f mempty+                      -- re-allocate `c` as a child:+                      stToPrim . VGM.write lDsst (coerce c) =<< inner2 cl l m ci cx+                    else do+                      stToPrim . VGM.write lDsst (coerce c) =<< inner cl l m i+                else do+                  cr <- stToPrim $ VGM.read rDsst (coerce c)+                  if i < ci+                    then do+                      -- now we know `i` does not exist in the segment tree.+                      stToPrim $ VGM.write iDsst (coerce c) i+                      cx <- stToPrim . VGM.exchange xDsst (coerce c) =<< f mempty+                      -- re-allocate `c` as a child:+                      stToPrim . VGM.write rDsst (coerce c) =<< inner2 cr m r ci cx+                    else do+                      stToPrim . VGM.write rDsst (coerce c) =<< inner cr m r i++              stToPrim $ updateNodeST dst c+              pure c++    -- insert new node+    inner2 :: P.Index -> Int -> Int -> Int -> a -> m P.Index+    inner2 c_ l r i x+      | P.nullIndex c_ = stToPrim $ newNodeST dst i x+      | otherwise = do+          c <- stToPrim $ cloneOnWriteST dst c_+          ci <- stToPrim $ VGM.read iDsst (coerce c)+          let !_ = ACIA.runtimeAssert (ci /= i) "AtCoder.Extra.DynSparseSegTree.Raw.modifyMST: wrong implementation"+          -- update left or right child+          let m = (l + r) `div` 2+          if i < m+            then do+              cl <- stToPrim $ VGM.read lDsst (coerce c)+              if ci < i+                then do+                  stToPrim $ VGM.write iDsst (coerce c) i+                  cx <- stToPrim $ VGM.exchange xDsst (coerce c) x+                  stToPrim . VGM.write lDsst (coerce c) =<< inner2 cl l m ci cx+                else do+                  stToPrim . VGM.write lDsst (coerce c) =<< inner2 cl l m i x+            else do+              cr <- stToPrim $ VGM.read rDsst (coerce c)+              if i < ci+                then do+                  stToPrim $ VGM.write iDsst (coerce c) i+                  cx <- stToPrim $ VGM.exchange xDsst (coerce c) x+                  stToPrim . VGM.write rDsst (coerce c) =<< inner2 cr m r ci cx+                else do+                  stToPrim . VGM.write rDsst (coerce c) =<< inner2 cr m r i x++          stToPrim $ updateNodeST dst c+          pure c++-- | \(O(\log L)\)+--+-- @since 1.2.1.0+{-# INLINEABLE prodST #-}+prodST :: forall a s. (HasCallStack, Monoid a, VU.Unbox a) => DynSparseSegTree s a -> P.Index -> Int -> Int -> ST s a+prodST DynSparseSegTree {..} root0 ql0 qr0+  | ql0 >= qr0 || P.nullIndex root0 = pure mempty+  | otherwise = inner root0 l0Dsst r0Dsst ql0 qr0 mempty+  where+    !_ = ACIA.checkIntervalBounded "AtCoder.Extra.DynSparseSegTree.Raw.prodST" ql0 qr0 l0Dsst r0Dsst+    -- left to right+    -- - l, r: node interval+    -- - ql, qr: queried interval+    inner :: P.Index -> Int -> Int -> Int -> Int -> a -> ST s a+    inner c l r ql_ qr_ !x+      | len <= 0 = pure x+      | P.nullIndex c = pure x+      | l == ql && r == qr = do+          cProd <- VGM.read prodDsst (coerce c)+          pure $! x <> cProd+      | otherwise = do+          let m = (l + r) `div` 2+          cl <- VGM.read lDsst (coerce c)+          x' <- inner cl l m ql qr x+          ci <- VGM.read iDsst (coerce c)+          x'' <- if ql <= ci && ci < qr then (x' <>) <$> VGM.read xDsst (coerce c) else pure x'+          cr <- VGM.read rDsst (coerce c)+          inner cr m r ql qr x''+      where+        -- shrink target interval to node interval+        ql = max ql_ l+        qr = min qr_ r+        len = qr - ql++-- | \(O(\log L)\)+--+-- ==== Constraints+-- - The segment tree is not empty+-- - User predicate \(f\) returns `True` for `mempty`+--+-- @since 1.2.1.0+{-# INLINEABLE maxRightM #-}+maxRightM :: (HasCallStack, PrimMonad m, Monoid a, VU.Unbox a) => DynSparseSegTree (PrimState m) a -> P.Index -> (a -> m Bool) -> m Int+maxRightM DynSparseSegTree {..} root f = do+  (!r, !_) <- inner root l0Dsst r0Dsst mempty+  pure r+  where+    -- returning `r0Dsst` means "go right"+    inner c l r !xParent+      | P.nullIndex c = pure (r0Dsst, xParent)+      | otherwise = do+          xWhole <- stToPrim $ (xParent <>) <$> VGM.read prodDsst (coerce c)+          b <- f xWhole+          if b+            then do+              pure (r0Dsst, xWhole)+            else do+              let m = (l + r) `div` 2+              cl <- stToPrim $ VGM.read lDsst (coerce c)+              (!k, !xl) <- inner cl l m xParent+              if k /= r0Dsst+                then pure (k, xl)+                else do+                  xm <- stToPrim $ (xl <>) <$> VGM.read xDsst (coerce c)+                  b' <- f xm+                  if not b'+                    then stToPrim $ (,xm) <$> VGM.read iDsst (coerce c)+                    else do+                      cr <- stToPrim $ VGM.read rDsst (coerce c)+                      inner cr m r xm++-- -------------------------------------------------------------------------------------------------+-- Internals+-- -------------------------------------------------------------------------------------------------++-- | \(O(1)\) Optionally clones a node depending on the persistency setting.+{-# INLINEABLE cloneOnWriteST #-}+cloneOnWriteST :: (HasCallStack, Monoid a, VU.Unbox a) => DynSparseSegTree s a -> P.Index -> ST s P.Index+cloneOnWriteST DynSparseSegTree {..} c+  | not isPersistentDsst || P.nullIndex c = pure c+  | otherwise = do+      i <- P.alloc poolDsst ()+      VGM.write lDsst (coerce i) =<< VGM.read lDsst (coerce c)+      VGM.write rDsst (coerce i) =<< VGM.read rDsst (coerce c)+      VGM.write xDsst (coerce i) =<< VGM.read xDsst (coerce c)+      VGM.write prodDsst (coerce i) =<< VGM.read prodDsst (coerce c)+      VGM.write iDsst (coerce i) =<< VGM.read iDsst (coerce c)+      pure i++-- | \(O(1)\)+{-# INLINEABLE updateNodeST #-}+updateNodeST :: (HasCallStack, Monoid a, VU.Unbox a) => DynSparseSegTree s a -> P.Index -> ST s ()+updateNodeST DynSparseSegTree {..} c = do+  VGM.write prodDsst (coerce c) =<< VGM.read xDsst (coerce c)+  cl <- VGM.read lDsst (coerce c)+  unless (P.nullIndex cl) $ do+    prodL <- VGM.read prodDsst (coerce cl)+    VGM.modify prodDsst (prodL <>) (coerce c)+  cr <- VGM.read rDsst (coerce c)+  unless (P.nullIndex cr) $ do+    prodR <- VGM.read prodDsst (coerce cr)+    VGM.modify prodDsst (<> prodR) (coerce c)

@@ -8,8 +8,7 @@ -- -- ==== Capacity limitation -- Access to each key creates a new entry. Note that entries cannot be invalidated due to the--- internal implementation (called /open addressing/). If the hash map is full,--- __access to a new key causes an infinite loop__ .+-- internal implementation (called /open addressing/). -- -- ==== __Example__ -- Create a `HashMap` with `capacity` \(10\):@@ -124,6 +123,7 @@ new n = do   let !k0 = 1   let !k = until (>= 2 * n) (* 2) k0+  -- we need extra space   let !maxCapHM = k `div` 2   restCapHM <- VUM.replicate 1 maxCapHM   let !maskHM = k - 1@@ -176,8 +176,6 @@ -- -- ==== Constraint -- - The rest capacity must be non-zero. Otherwise it loops forever.------ @since 1.1.0.0 {-# INLINE indexST #-} indexST :: (HasCallStack) => HashMap s a -> Int -> ST s Int indexST hm@HashMap {..} k = do

@@ -61,6 +61,7 @@      -- * Metadata     capacity,+    size,      -- * Lookups     contains,@@ -91,7 +92,6 @@ import AtCoder.Extra.IntMap qualified as IM import Control.Monad (foldM_) import Control.Monad.Primitive (PrimMonad, PrimState, stToPrim)-import Data.Vector.Generic qualified as G import Data.Vector.Unboxed qualified as VU import GHC.Stack (HasCallStack) import Prelude hiding (lookup, read)@@ -106,7 +106,7 @@     unITM :: IM.IntMap s (Int, a)   } --- | \(O(n)\) Creates an empty `IntervalMap`.+-- | \(O(n)\) Creates an empty `IntervalMap` with capacity \(n\). -- -- @since 1.1.0.0 {-# INLINE new #-}@@ -142,14 +142,14 @@   -- | The map   m (IntervalMap (PrimState m) a) buildM xs onAdd = do-  dim <- IM.new (G.length xs)-  foldM_ (step dim) (0 :: Int) $ G.group xs+  dim <- IM.new (VU.length xs)+  foldM_ (step dim) (0 :: Int) $ VU.group xs   pure $ IntervalMap dim   where     step dim !l !xs' = do-      let !l' = l + G.length xs'-      IM.insert dim l (l', G.head xs')-      onAdd l l' (G.head xs')+      let !l' = l + VU.length xs'+      IM.insert dim l (l', VU.head xs')+      onAdd l l' (VU.head xs')       pure l'  -- | \(O(1)\) Returns the capacity \(n\), where the interval \([0, n)\) is managed by the map.@@ -158,6 +158,13 @@ {-# INLINE capacity #-} capacity :: IntervalMap s a -> Int capacity = IM.capacity . unITM++-- | \(O(1)\) Returns the number of intervals in the map.+--+-- @since 1.2.1.0+{-# INLINE size #-}+size :: (PrimMonad m) => IntervalMap (PrimState m) a -> m Int+size = IM.size . unITM  -- | \(O(\log n)\) Returns whether a point \(x\) is contained within any of the intervals. --

@@ -75,8 +75,8 @@ act :: (Semigroup a) => RangeAdd a -> a -> a act (RangeAdd dx) x = dx <> x --- | \(O(1)\) Acts on @a@ with length in terms of `SegAct`. It doesn't work well with idempotent--- monoids such as `Max` or `Min`.+-- | \(O(1)\) Acts on @a@ with length in terms of `SegAct`. Be warned that it doesn't work well with+-- idempotent monoids such as `Max` or `Min`. -- -- @since 1.0.0.0 {-# INLINE actWithLength #-}

@@ -77,7 +77,8 @@ act (RangeSet (Bit True, !f)) _ = f act (RangeSet (Bit False, !_)) x = x --- | Acts on @a@ with length in terms of `SegAct`.+-- | \(O(1)\) Acts on @a@ with length in terms of `SegAct`. Be warned that it doesn't work well with+-- idempotent monoids such as `Max` or `Min`. -- -- @since 1.0.0.0 {-# INLINE actWithLength #-}

@@ -29,6 +29,12 @@     write,     modify,     exchange,++    -- * Handle+    Handle (..),+    newHandle,+    nullHandle,+    invalidateHandle,   ) where @@ -40,6 +46,7 @@ import Data.Vector.Primitive qualified as VP import Data.Vector.Unboxed qualified as VU import Data.Vector.Unboxed.Mutable qualified as VUM+import GHC.Stack (HasCallStack) import Prelude hiding (read)  -- | Fixed-sized array for \(O(1)\) allocation and \(O(1)\) clearing after \(O(n)\) construction.@@ -52,8 +59,7 @@     nextPool :: !(VUM.MVector s Index)   } --- | Strongly typed index of pool items. User has to explicitly @corece@ on raw index use, but it's--- ok as far as the end user don't see it.+-- | Strongly typed index of pool items. User has to explicitly @corece@ on raw index use. newtype Index = Index {unIndex :: Int}   deriving (Eq, VP.Prim)   deriving newtype (Ord, Show)@@ -81,9 +87,9 @@ -- | \(O(n)\) Creates a pool with the specified @capacity@. {-# INLINE new #-} new :: (VU.Unbox a, PrimMonad m) => Int -> m (Pool (PrimState m) a)-new capacity = do-  dataPool <- VUM.unsafeNew capacity-  freePool <- B.new capacity+new cap = do+  dataPool <- VUM.unsafeNew cap+  freePool <- B.new cap   nextPool <- VUM.replicate 1 (Index 0)   pure Pool {..} @@ -105,23 +111,26 @@ size Pool {..} = do   !nFree <- B.length freePool   Index !next <- VGM.unsafeRead nextPool 0-  let !cap = VGM.length dataPool-  pure $ cap - (next - nFree)+  pure $ next - nFree  -- | \(O(1)\) Allocates a new element. -- -- ==== Constraints -- - The number of elements must not exceed the `capacity`. {-# INLINE alloc #-}-alloc :: (PrimMonad m, VU.Unbox a) => Pool (PrimState m) a -> a -> m Index+alloc :: (HasCallStack, PrimMonad m, VU.Unbox a) => Pool (PrimState m) a -> a -> m Index alloc Pool {..} !x = do   B.popBack freePool >>= \case     Just i -> pure i     Nothing -> do       Index i <- VGM.unsafeRead nextPool 0-      VGM.unsafeWrite nextPool 0 $ coerce (i + 1)-      VGM.write dataPool i x-      pure $ coerce i+      if i < VGM.length dataPool+        then do+          VGM.unsafeWrite nextPool 0 $ coerce (i + 1)+          VGM.write dataPool i x+          pure $ coerce i+        else do+          error "AtCoder.Extra.Pool.alloc: capacity out of bounds"  -- | \(O(1)\) Frees an element. Be sure to not free a deleted element. --@@ -167,3 +176,32 @@ exchange :: (PrimMonad m, VU.Unbox a) => Pool (PrimState m) a -> Index -> a -> m a exchange Pool {dataPool} !i !x = do   VGM.exchange dataPool (coerce i) x++-- | Mutable `Handle` of an `Index`.+--+-- @since 1.2.0.0+newtype Handle s = Handle+  { -- | @since 1.2.0.0+    unHandle :: VUM.MVector s Index+  }++-- | \(O(1)\) Creates a new sequence `Handle` from a root node index.+--+-- @since 1.2.0.0+{-# INLINE newHandle #-}+newHandle :: (PrimMonad m) => Index -> m (Handle (PrimState m))+newHandle x = Handle <$> VUM.replicate 1 x++-- | \(O(1)\) Returns whether the sequence is empty.+--+-- @since 1.2.0.0+{-# INLINE nullHandle #-}+nullHandle :: (PrimMonad m) => Handle (PrimState m) -> m Bool+nullHandle (Handle h) = nullIndex <$> VGM.unsafeRead h 0++-- | \(O(1)\) Invalidates a sequence handle. Note that it does not change or `free` the sequence.+--+-- @since 1.2.0.0+{-# INLINE invalidateHandle #-}+invalidateHandle :: (PrimMonad m) => Handle (PrimState m) -> m ()+invalidateHandle (Handle h) = VGM.unsafeWrite h 0 undefIndex

@@ -319,11 +319,11 @@                 VGM.iforM_ (VGM.unsafeDrop j rowRk) $ \k_ x -> do                   VGM.unsafeWrite rowRk (k_ + j) $! c * x                 for_ [rk + 1 .. h - 1] $ \i -> do-                  c <- read2d view i j+                  c_ <- read2d view i j                   rowI <- VGM.read view i                   -- for_ [j .. w - 1] $ \k -> do                   VGM.iforM_ (VGM.unsafeDrop j rowRk) $ \k_ ark -> do-                    VGM.unsafeModify rowI (subtract (ark * c)) (k_ + j)+                    VGM.unsafeModify rowI (subtract (ark * c_)) (k_ + j)                 inner (rk + 1) (j + 1)   inner 0 0 @@ -366,8 +366,8 @@             viewB' <- V.mapM VU.unsafeFreeze =<< V.unsafeFreeze viewB             pure $ Just (det, viewB')         | otherwise = do-            let swapLoop k !det-                  | k >= n = pure det+            let swapLoop k !det_+                  | k >= n = pure det_                   | otherwise = do                       aki <- read2d viewA k i                       if aki /= 0@@ -376,10 +376,10 @@                             then do                               VGM.unsafeSwap viewA i k                               VGM.unsafeSwap viewB i k-                              pure (-det)-                            else pure det+                              pure (-det_)+                            else pure det_                         else do-                          swapLoop (k + 1) det+                          swapLoop (k + 1) det_             det' <- swapLoop i det             aii <- read2d viewA i i             if aii == 0@@ -395,13 +395,13 @@                   VGM.unsafeWrite rowBI j $! x * c                 for_ [0 .. n - 1] $ \k -> do                   when (i /= k) $ do-                    c <- read2d viewA k i+                    c_ <- read2d viewA k i                     rowAK <- VGM.unsafeRead viewA k                     rowBK <- VGM.unsafeRead viewB k                     VGM.iforM_ (VGM.unsafeDrop i rowAI) $ \j_ aij -> do-                      VGM.unsafeModify rowAK (subtract (aij * c)) (j_ + i)+                      VGM.unsafeModify rowAK (subtract (aij * c_)) (j_ + i)                     VGM.iforM_ rowBI $ \j bij -> do-                      VGM.unsafeModify rowBK (subtract (bij * c)) j+                      VGM.unsafeModify rowBK (subtract (bij * c_)) j                 inner (i + 1) det''    inner 0 (1 :: a)@@ -421,25 +421,25 @@   let inner i (!det :: Int)         | i >= n = pure det         | otherwise = do-            let swapLoop j !det-                  | j >= n = pure det+            let swapLoop j !det_+                  | j >= n = pure det_                   | otherwise = do                       aji <- read2d view j i                       if aji == 0-                        then swapLoop (j + 1) det+                        then swapLoop (j + 1) det_                         else do                           if i /= j                             then do                               VGM.unsafeSwap view i j-                              pure $! m - det-                            else pure det+                              pure $! m - det_+                            else pure det_             det' <- swapLoop i det             det'' <- VU.foldM'               ( \ !acc j -> do-                  let visitDiag !det = do+                  let visitDiag !det_ = do                         aii <- read2d view i i                         if aii == 0-                          then pure det+                          then pure det_                           else do                             aji <- read2d view j i                             let !c = m - aji `div` aii@@ -453,7 +453,7 @@                               ()                               (VGM.unsafeDrop i rowI)                             VGM.unsafeSwap view i j-                            visitDiag (m - det)+                            visitDiag (m - det_)                   acc' <- visitDiag acc                   VGM.unsafeSwap view i j                   pure $! m - acc'

@@ -3,13 +3,16 @@  -- | Dynamic sequence of monoid values with monoid actions on them through the `SegAct` instance. --+-- ==== Performance+-- This module is __slow__ as an ordinary dynamic sequence. Consider using another module if you+-- don't need monoid products.+-- -- ==== __Example__ -- -- Create a `Seq` storage of length \(10\): -- -- >>> import AtCoder.Extra.Monoid.RangeAdd qualified as RangeAdd -- >>> import AtCoder.Extra.Seq qualified as Seq--- >>> import AtCoder.LazySegTree (SegAct (..)) -- >>> import Data.Semigroup (Sum (..)) -- >>> import Data.Vector.Unboxed qualified as VU -- >>> seq <- Seq.new @_ @(RangeAdd.RangeAdd (Sum Int)) @(Sum Int) 10@@ -96,11 +99,17 @@ module AtCoder.Extra.Seq   ( -- * Seq     Seq.Seq (..),++    -- * Handle (re-exports)     Handle (..),+    -- TODO: hide     newHandle,     nullHandle,     invalidateHandle, +    -- * Re-exports+    SegAct (..),+     -- * Constructors     new,     reset,@@ -108,6 +117,10 @@     newNode,     newSeq, +    -- * Metadata+    capacity,+    length,+     -- * Merge/split     merge,     merge3,@@ -161,24 +174,15 @@ where  import AtCoder.Extra.Pool qualified as P+import AtCoder.Extra.Pool (Handle (..), newHandle, nullHandle, invalidateHandle) import AtCoder.Extra.Seq.Raw (Seq (..)) import AtCoder.Extra.Seq.Raw qualified as Seq import AtCoder.LazySegTree (SegAct (..)) import Control.Monad.Primitive (PrimMonad, PrimState, stToPrim) import Data.Vector.Generic.Mutable qualified as VGM import Data.Vector.Unboxed qualified as VU-import Data.Vector.Unboxed.Mutable qualified as VUM import GHC.Stack (HasCallStack)-import Prelude hiding (read, reverse, seq)---- | `Handle` for a sequence in `Seq`. It internally stores the root node and updates it--- following splaying operations, as `Seq` utilizes a splay tree structure.------ @since 1.2.0.0-newtype Handle s = Handle-  { -- | @since 1.2.0.0-    unHandle :: VUM.MVector s P.Index-  }+import Prelude hiding (length, read, reverse, seq)  -- | \(O(n)\) Creates a new `Seq` of length \(n\). --@@ -187,29 +191,6 @@ new :: (PrimMonad m, Monoid f, VU.Unbox f, Monoid a, VU.Unbox a) => Int -> m (Seq (PrimState m) f a) new n = stToPrim $ Seq.newST n --- | \(O(1)\) Creates a new sequence `Handle` from a root node index.------ @since 1.2.0.0-{-# INLINE newHandle #-}-newHandle :: (PrimMonad m) => P.Index -> m (Handle (PrimState m))-newHandle x = stToPrim $ Handle <$> VUM.replicate 1 x---- | \(O(1)\) Returns whether the sequence is empty.------ @since 1.2.0.0-{-# INLINE nullHandle #-}-nullHandle :: (PrimMonad m) => Handle (PrimState m) -> m Bool-nullHandle (Handle h) = stToPrim $ do-  P.nullIndex <$> VGM.unsafeRead h 0---- | \(O(1)\) Invalidates a sequence handle. Note that it does not change or `free` the sequence.------ @since 1.2.0.0-{-# INLINE invalidateHandle #-}-invalidateHandle :: (PrimMonad m) => Handle (PrimState m) -> m ()-invalidateHandle (Handle h) = stToPrim $ do-  VGM.unsafeWrite h 0 P.undefIndex- -- | \(O(1)\) Clears the sequence storage. All the handles must not be used again. -- -- @since 1.2.0.0@@ -221,14 +202,14 @@ -- -- @since 1.2.0.0 {-# INLINE newNode #-}-newNode :: (PrimMonad m, Monoid f, VU.Unbox f, VU.Unbox a) => Seq (PrimState m) f a -> a -> m (Handle (PrimState m))+newNode :: (HasCallStack, PrimMonad m, Monoid f, VU.Unbox f, VU.Unbox a) => Seq (PrimState m) f a -> a -> m (Handle (PrimState m)) newNode seq x = stToPrim $ newHandle =<< Seq.newNodeST seq x  -- | \(O(n)\) Allocates a new sequence. -- -- @since 1.2.0.0 {-# INLINE newSeq #-}-newSeq :: (PrimMonad m, Monoid f, VU.Unbox f, Monoid a, VU.Unbox a) => Seq (PrimState m) f a -> VU.Vector a -> m (Handle (PrimState m))+newSeq :: (HasCallStack, PrimMonad m, Monoid f, VU.Unbox f, Monoid a, VU.Unbox a) => Seq (PrimState m) f a -> VU.Vector a -> m (Handle (PrimState m)) newSeq seq !xs = stToPrim $ newHandle =<< Seq.newSeqST seq xs  -- | \(O(n)\) Frees a sequence and invalidates the handle.@@ -242,6 +223,26 @@   VGM.write handle 0 P.undefIndex  -- -------------------------------------------------------------------------------------------------+-- Meta+-- -------------------------------------------------------------------------------------------------++-- | \(O(1)\) Returns the capacity of the sequence storage.+--+-- @since 1.2.1.0+{-# INLINE capacity #-}+capacity :: Seq s f a -> Int+capacity = Seq.capacity++-- | \(O(1)\) Returns the length of the sequence.+--+-- @since 1.2.1.0+{-# INLINE length #-}+length :: (PrimMonad m) => Seq (PrimState m) f a -> Handle (PrimState m) -> m Int+length seq (Handle handle) = stToPrim $ do+  i <- VGM.unsafeRead handle 0+  Seq.lengthST seq i++-- ------------------------------------------------------------------------------------------------- -- Merge/split -- ------------------------------------------------------------------------------------------------- @@ -437,7 +438,7 @@ -- -- @since 1.2.0.0 {-# INLINE prod #-}-prod :: (HasCallStack, Show a, PrimMonad m, SegAct f a, Eq f, Monoid f, VU.Unbox f, Monoid a, VU.Unbox a) => Seq (PrimState m) f a -> Handle (PrimState m) -> Int -> Int -> m a+prod :: (HasCallStack, PrimMonad m, SegAct f a, Eq f, Monoid f, VU.Unbox f, Monoid a, VU.Unbox a) => Seq (PrimState m) f a -> Handle (PrimState m) -> Int -> Int -> m a prod seq (Handle hRoot) l r = stToPrim $ do   root <- VGM.unsafeRead hRoot 0   (!v, !root') <- Seq.prodST seq root l r@@ -445,19 +446,22 @@   pure v  -- | Amortized \(O(\log n)\). Returns the monoid product in an interval \([l, r)\). Returns--- `Nothing` if an invalid interval is given.+-- `Nothing` if the interval is invalid. -- -- @since 1.2.0.0-{-# INLINE prodMaybe #-}+{-# INLINEABLE prodMaybe #-} prodMaybe :: (HasCallStack, PrimMonad m, SegAct f a, Eq f, Monoid f, VU.Unbox f, Monoid a, VU.Unbox a) => Seq (PrimState m) f a -> Handle (PrimState m) -> Int -> Int -> m (Maybe a) prodMaybe seq (Handle handle) l r = stToPrim $ do   root <- VGM.unsafeRead handle 0-  res <- Seq.prodMaybeST seq root l r-  case res of-    Just (!v, !root') -> do-      VGM.unsafeWrite handle 0 root'-      pure $ Just v-    Nothing -> pure Nothing+  if P.nullIndex root+    then pure $ Just mempty+    else do+      res <- Seq.prodMaybeST seq root l r+      case res of+        Just (!v, !root') -> do+          VGM.unsafeWrite handle 0 root'+          pure $ Just v+        Nothing -> pure Nothing  -- | Amortized \(O(\log n)\). Returns the monoid product of the whole sequence. --@@ -577,9 +581,6 @@  -- | Amortized \(O(\log n)\). ----- ==== Constraints--- - The sequence must be non-empty.--- -- @since 1.2.0.0 {-# INLINE ilowerBound #-} ilowerBound ::@@ -600,9 +601,6 @@  -- | Amortized \(O(\log n)\). ----- ==== Constraints--- - The sequence must be non-empty.--- -- @since 1.2.0.0 {-# INLINE ilowerBoundM #-} ilowerBoundM ::@@ -623,9 +621,6 @@  -- | Amortized \(O(\log n)\). ----- ==== Constraints--- - The sequence must be non-empty.--- -- @since 1.2.0.0 {-# INLINE ilowerBoundProd #-} ilowerBoundProd ::@@ -646,9 +641,6 @@  -- | Amortized \(O(\log n)\). ----- ==== Constraints--- - The sequence must be non-empty.--- -- @since 1.2.0.0 {-# INLINE ilowerBoundProdM #-} ilowerBoundProdM ::@@ -670,9 +662,6 @@ -- | Amortized \(O(\log n)\). Splits a sequence into two with the user predicate and returns the -- right sequence handle. ----- ==== Constraints--- - The sequence must be non-empty.--- -- @since 1.2.0.0 {-# INLINE isplitMaxRight #-} isplitMaxRight ::@@ -695,9 +684,6 @@ -- | Amortized \(O(\log n)\). Splits a sequence into two with the user predicate and returns the -- right sequence handle. ----- ==== Constraints--- - The sequence must be non-empty.--- -- @since 1.2.0.0 {-# INLINEABLE isplitMaxRightM #-} isplitMaxRightM ::@@ -720,9 +706,6 @@ -- | Amortized \(O(\log n)\). Splits a sequence into two with the user predicate and returns the -- right sequence handle. ----- ==== Constraints--- - The sequence must be non-empty.--- -- @since 1.2.0.0 {-# INLINE isplitMaxRightProd #-} isplitMaxRightProd ::@@ -744,9 +727,6 @@  -- | Amortized \(O(\log n)\). Splits a sequence into two with the user predicate and returns the -- right sequence handle.------ ==== Constraints--- - The sequence must be non-empty. -- -- @since 1.2.0.0 {-# INLINEABLE isplitMaxRightProdM #-}

@@ -0,0 +1,742 @@+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeFamilies #-}++-- | Key-value pairs with monoid products and monoid actions on them through the `SegAct` instance.+--+-- ==== Performance+-- This module is __extremely slow__ as an ordinary map. Do not use it unless you need monoid+-- products.+--+-- ==== __Example__+--+-- >>> import AtCoder.Extra.Monoid.RangeAdd qualified as RangeAdd+-- >>> import AtCoder.Extra.Seq.Map qualified as M+-- >>> import Data.Semigroup (Sum (..))+-- >>> import Data.Vector.Unboxed qualified as VU+-- >>> m <- M.new @_ @(RangeAdd.RangeAdd (Sum Int)) @Int @(Sum Int) 10+-- >>> M.insert m 1 10+-- >>> M.insert m 3 30+-- >>> M.prod m 1 2+-- Sum {getSum = 10}+--+-- @since 1.2.1.0+module AtCoder.Extra.Seq.Map+  ( -- * Map+    Map (..),++    -- * Re-exports+    SegAct (..),++    -- * Constructors+    new,+    build,+    reset,++    -- * Metadata+    capacity,+    size,++    -- * Key-based operations++    -- ** Read/write+    member,+    lookup,+    adjust,++    -- ** Insert/delete+    insert,+    insertWith,+    delete,+    delete_,++    -- ** Products+    -- sliceST,+    prod,+    prodMaybe,+    allProd, -- FIXME: rename to `prodAll`++    -- ** Applications+    applyIn,+    applyAll,++    -- ** Bisection methods+    lookupLE,+    lookupLT,+    lookupGE,+    lookupGT,++    -- * Index-based operations++    -- ** Read/write+    readAt,+    readMaybeAt,+    writeAt,+    modifyAt,+    exchangeAt,++    -- ** Products+    prodInInterval,++    -- ** Applications+    applyInInterval,++    -- ** Bisection methods+    ilowerBound,+    ilowerBoundM,+    ilowerBoundProd,+    ilowerBoundProdM,++    -- * Conversion+    freeze,+  )+where++import AtCoder.Extra.Pool qualified as P+import AtCoder.Extra.Seq qualified as Seq+import AtCoder.Extra.Seq.Raw qualified as Raw+import AtCoder.Internal.Assert qualified as ACIA+import AtCoder.LazySegTree (SegAct (..))+import Control.Monad (unless, when)+import Control.Monad.Primitive (PrimMonad, PrimState, stToPrim)+import Control.Monad.ST (ST)+import Data.Coerce (coerce)+import Data.Ord (comparing)+import Data.Vector.Algorithms.Intro qualified as VAI+import Data.Vector.Generic.Mutable qualified as VGM+import Data.Vector.Unboxed qualified as VU+import Data.Vector.Unboxed.Mutable qualified as VUM+import GHC.Stack (HasCallStack)+import Prelude hiding (lookup, read, reverse, seq)++-- | Key-value pairs with monoid products and monoid actions on them through the `SegAct` instance.+--+-- @since 1.2.1.0+data Map s f k v = Map+  { -- | The sequence storage+    --+    -- @since 1.2.1.0+    seqMap :: !(Seq.Seq s f v),+    -- | Keys+    --+    -- @since 1.2.1.0+    kMap :: !(VUM.MVector s k),+    -- | Handle of the root node.+    --+    -- @since 1.2.1.0+    rootMap :: !(Seq.Handle s)+  }++{-# INLINE assertRootST #-}+assertRootST :: (HasCallStack) => Raw.Seq s f v -> P.Index -> ST s ()+assertRootST Seq.Seq {pSeq} i = do+  p <- VGM.read pSeq (coerce i)+  let !_ = ACIA.runtimeAssert (P.nullIndex p) $ "AtCoder.Extra.Seq.Map.assertRootST: not a root (node `" ++ show i ++ "`, parent `" ++ show p ++ "`)"+  pure ()++-- | \(O(n)\) Creates a new `Map` of capacity \(n\). Always prefer `build` to `new` for performance.+--+-- @since 1.2.1.0+{-# INLINEABLE new #-}+new :: (PrimMonad m, Monoid f, VU.Unbox f, VU.Unbox k, VU.Unbox v, Monoid v) => Int -> m (Map (PrimState m) f k v)+new n = stToPrim $ do+  seqMap <- Seq.new n+  kMap <- VUM.unsafeNew n+  rootMap <- Seq.newHandle P.undefIndex+  pure Map {..}++-- | \(O(n \log n)\) Creates a new `Map` of capacity \(n\) with initial values. Always prefer `build` to+-- `new` for performance.+--+-- @since 1.2.1.0+{-# INLINEABLE build #-}+build :: (HasCallStack, PrimMonad m, Monoid f, VU.Unbox f, Ord k, VU.Unbox k, VU.Unbox v, Monoid v) => Int -> VU.Vector (k, v) -> m (Map (PrimState m) f k v)+build n kvs = stToPrim $ do+  -- let !_ = ACIA.runtimeAssert (VU.length kvs <= n) "AtCoder.Extra.Seq.Map"+  seqMap <- Seq.new n+  kMap <- VUM.unsafeNew n+  -- note that `unzip` is O(1) for tuples:+  let (!ks, !vs) = VU.unzip $ VU.modify (VAI.sortBy (comparing fst)) kvs+  VU.iforM_ ks $ VGM.write kMap+  rootMap <- Seq.newSeq seqMap vs+  pure Map {..}++-- | \(O(1)\) Clears the map. All the handles must not be used again.+--+-- @since 1.2.1.0+{-# INLINEABLE reset #-}+reset :: (PrimMonad m, Monoid f, VU.Unbox f, VU.Unbox k, VU.Unbox v, Monoid v) => Map (PrimState m) f k v -> m ()+reset Map {..} = stToPrim $ do+  Raw.resetST seqMap+  VGM.write (Seq.unHandle rootMap) 0 P.undefIndex++-- -------------------------------------------------------------------------------------------+-- Metadta+-- -------------------------------------------------------------------------------------------++-- | \(O(1)\) Returns the maximum number of elements the map can store.+--+-- @since 1.2.1.0+{-# INLINEABLE capacity #-}+capacity :: Map s f k v -> Int+capacity Map {seqMap} = Raw.capacity seqMap++-- | \(O(1)\) Returns the number of elements in the map.+--+-- @since 1.2.1.0+{-# INLINEABLE size #-}+size :: (PrimMonad m) => Map (PrimState m) f k v -> m Int+size Map {..} = stToPrim $ do+  root <- VGM.read (Seq.unHandle rootMap) 0+  Raw.lengthST seqMap root++-- -------------------------------------------------------------------------------------------+-- Key-based operations+-- -------------------------------------------------------------------------------------------++-- | Amortized \(O(\log n)\). Finds a node with key \(k\).+{-# INLINEABLE lookupNodeST #-}+lookupNodeST :: (HasCallStack, Eq f, Monoid f, VU.Unbox f, Ord k, VU.Unbox k, Monoid v, VU.Unbox v, SegAct f v) => Map s f k v -> k -> ST s (Bool, P.Index, P.Index)+lookupNodeST Map {..} k = do+  root <- VGM.read (Seq.unHandle rootMap) 0+  if P.nullIndex root+    then pure (False, P.undefIndex, P.undefIndex)+    else do+      (!l, !root') <- Raw.maxRightWithST seqMap root $ \i -> do+        ki <- VGM.read kMap (coerce i)+        pure $ ki <= k+      VGM.write (Seq.unHandle rootMap) 0 root'+      if P.nullIndex l+        then do+          pure (False, root', root')+        else do+          kl <- VGM.read kMap (coerce l)+          pure (kl == k, l, root')++-- | Amoritzed \(O(\log n)\). Returns whether a node with key \(k\) is in the map.+--+-- @since 1.2.1.0+{-# INLINE member #-}+member :: (HasCallStack, PrimMonad m, Eq f, Monoid f, VU.Unbox f, Ord k, VU.Unbox k, Monoid v, VU.Unbox v, SegAct f v) => Map (PrimState m) f k v -> k -> m Bool+member m k = stToPrim $ do+  (!b, !_, !_) <- lookupNodeST m k+  pure b++-- | Amortized \(O(\log n)\). Looks up for the monoid value of a node with key \(k\).+--+-- @since 1.2.1.0+{-# INLINE lookup #-}+lookup :: (HasCallStack, PrimMonad m, Eq f, Monoid f, VU.Unbox f, Ord k, VU.Unbox k, Monoid v, VU.Unbox v, SegAct f v) => Map (PrimState m) f k v -> k -> m (Maybe v)+lookup m@Map {..} k = stToPrim $ do+  (!b, !l, !_) <- lookupNodeST m k+  if b+    then do+      Raw.splayST seqMap l True+      Just <$> VGM.read (Seq.vSeq seqMap) 0+    else do+      pure Nothing++-- | Amoritzed \(O(\log n)\). Adjusts the monoid value of a node with key \(k\).+--+-- @since 1.2.1.0+{-# INLINE adjust #-}+adjust :: (HasCallStack, PrimMonad m, Eq f, Monoid f, VU.Unbox f, Ord k, VU.Unbox k, Monoid v, VU.Unbox v, SegAct f v) => Map (PrimState m) f k v -> (v -> v) -> k -> m ()+adjust m@Map {..} f k = stToPrim $ do+  (!b, !l, !_) <- lookupNodeST m k+  when b $ do+    Raw.splayST seqMap l True+    VGM.write (Seq.unHandle rootMap) 0 l+    Raw.modifyNodeST seqMap f l++-- | Amortized \(O(\log n)\). Inserts a \((k, v)\) pair. If the key is already present in the map,+-- the associated value is replaced with the supplied value.+--+-- @since 1.2.1.0+{-# INLINE insert #-}+insert :: (HasCallStack, PrimMonad m, Eq f, Monoid f, VU.Unbox f, Ord k, VU.Unbox k, Monoid v, VU.Unbox v, SegAct f v) => Map (PrimState m) f k v -> k -> v -> m ()+insert m k v = stToPrim $ do+  insertWithST m const k v++-- | Amortized \(O(\log n)\). Inserts a \((k, v)\) pairs, combining new value and old value.+--+-- @since 1.2.1.0+{-# INLINE insertWith #-}+insertWith ::+  (HasCallStack, PrimMonad m, Eq f, Monoid f, VU.Unbox f, Ord k, VU.Unbox k, Monoid v, VU.Unbox v, SegAct f v) =>+  -- | Map+  Map (PrimState m) f k v ->+  -- | new -> old -> combined+  (v -> v -> v) ->+  -- | Key+  k ->+  -- | Value+  v ->+  m ()+insertWith m f k v = stToPrim $ do+  insertWithST m f k v++-- | Amortized \(O(\log n)\).+{-# INLINEABLE insertWithST #-}+insertWithST ::+  (HasCallStack, Eq f, Monoid f, VU.Unbox f, Ord k, VU.Unbox k, Monoid v, VU.Unbox v, SegAct f v) =>+  -- | Map+  Map s f k v ->+  -- | new -> old -> combined+  (v -> v -> v) ->+  -- | Key+  k ->+  -- | Value+  v ->+  ST s ()+insertWithST Map {..} f k v = stToPrim $ do+  -- split and merge+  VGM.unsafeModifyM+    (Seq.unHandle rootMap)+    ( \root -> do+        (!l, !r) <- Raw.splitMaxRightWithST seqMap root $ \i -> do+          ki <- VGM.read kMap (coerce i)+          pure $ ki <= k+        if P.nullIndex l+          then do+            -- insert+            node <- Raw.newNodeST seqMap v+            VGM.write kMap (coerce node) k+            Raw.mergeST seqMap node r+          else do+            kl <- VGM.read kMap (coerce l)+            if kl == k+              then do+                -- overwrite the node+                Raw.splayST seqMap l True+                Raw.modifyNodeST seqMap (f v) l+                VGM.write kMap (coerce l) k+                Raw.mergeST seqMap l r+              else do+                -- insert+                node <- Raw.newNodeST seqMap v+                VGM.write kMap (coerce node) k+                Raw.merge3ST seqMap l node r+    )+    0++-- | Amortized \(O(\log n)\). Deletes an element with key \(k\).+--+-- @since 1.2.1.0+{-# INLINEABLE delete #-}+delete :: (HasCallStack, PrimMonad m, Eq f, Monoid f, VU.Unbox f, Ord k, VU.Unbox k, Monoid v, VU.Unbox v, SegAct f v) => Map (PrimState m) f k v -> k -> m (Maybe v)+delete m@Map {..} k = stToPrim $ do+  (!b, !l, !_) <- lookupNodeST m k+  if b+    then do+      let Raw.Seq {..} = seqMap+      Raw.splayST seqMap l True+      xl <- VGM.read lSeq $ coerce l+      xr <- VGM.read rSeq $ coerce l+      unless (P.nullIndex xl) $ VGM.write pSeq (coerce xl) P.undefIndex+      unless (P.nullIndex xr) $ VGM.write pSeq (coerce xr) P.undefIndex+      v <- VGM.read vSeq $ coerce l+      Raw.freeNodeST seqMap l+      root'' <- Raw.mergeST seqMap xl xr+      VGM.write (Seq.unHandle rootMap) 0 root''+      pure $ Just v+    else do+      pure Nothing++-- | Amortized \(O(\log n)\). Deletes an element with key \(k\).+--+-- @since 1.2.1.0+{-# INLINE delete_ #-}+delete_ :: (HasCallStack, PrimMonad m, Eq f, Monoid f, VU.Unbox f, Ord k, VU.Unbox k, Monoid v, VU.Unbox v, SegAct f v) => Map (PrimState m) f k v -> k -> m ()+delete_ m k = stToPrim $ do+  _ <- delete m k+  pure ()++-- | Amortized \(O(\log n)\). Captures a node that corresponds to \([k1, k2)\).+{-# INLINEABLE sliceST #-}+sliceST :: (HasCallStack, Eq f, Monoid f, VU.Unbox f, Ord k, VU.Unbox k, Monoid v, VU.Unbox v, SegAct f v) => Map s f k v -> k -> k -> ST s P.Index+sliceST Map {..} k1 k2 = do+  let handle = Seq.unHandle rootMap+  root <- VGM.read handle 0+  if P.nullIndex root+    then pure P.undefIndex+    else do+      (!lm, !r) <- Raw.splitMaxRightWithST seqMap root $ \i -> do+        k' <- VGM.read kMap (coerce i)+        pure $! k' < k2++      case (P.nullIndex lm, P.nullIndex r) of+        (True, True) -> error "unreachable"+        (True, False) -> do+          VGM.write handle 0 r+          pure P.undefIndex+        (False, True) -> do+          (!l, !root') <- Raw.maxRightWithST seqMap lm $ \i -> do+            k' <- VGM.read kMap (coerce i)+            pure $! k' < k1+          if P.nullIndex l+            then do+              VGM.write handle 0 root'+              pure root'+            else do+              Raw.splayST seqMap l True+              VGM.write handle 0 l+              VGM.read rSeq (coerce l)+        (False, False) -> do+          r' <- Raw.splayKthST seqMap r 0+          VGM.write handle 0 r'+          (!l, !root') <- Raw.maxRightWithST seqMap lm $ \i -> do+            k' <- VGM.read kMap (coerce i)+            pure $! k' < k1+          if P.nullIndex l+            then do+              -- root' is [l, r)+              VGM.write pSeq (coerce root') r'+              VGM.write lSeq (coerce r') root'+              Raw.updateNodeST seqMap root'+              pure root'+            else do+              -- o--l--o--r--o+              --          r+              --     /---/+              --    l+              --     \+              --      m+              Raw.splayST seqMap l True+              VGM.write pSeq (coerce l) r'+              VGM.write lSeq (coerce r') l+              Raw.updateNodeST seqMap r'+              VGM.read rSeq (coerce l)+  where+    Raw.Seq {..} = seqMap++-- | Amortized \(O(\log n)\). Returns the monoid product in an interval \([k_1, k_2)\). Throws an+-- error for \(k_1 \gt k_2\).+--+-- ==== Constraints+-- - \(k_1 \le k_2\)+--+-- @since 1.2.1.0+{-# INLINE prod #-}+prod :: (HasCallStack, PrimMonad m, Eq f, Monoid f, VU.Unbox f, Ord k, VU.Unbox k, Monoid v, VU.Unbox v, SegAct f v) => Map (PrimState m) f k v -> k -> k -> m v+prod m@Map {..} l r = stToPrim $ do+  let !_ = ACIA.runtimeAssert (l <= r) "AtCoder.Extra.Seq.Map.prod: k1 > k2"+  root <- VGM.read (Seq.unHandle rootMap) 0+  if P.nullIndex root || l == r+    then pure mempty+    else unsafeProdST m l r++-- | Amortized \(O(\log n)\). Returns the monoid product in an interval \([k_1, k_2)\). Returns+-- `Nothing` if an invalid interval is given or for an empty sequence.+--+-- @since 1.2.1.0+{-# INLINE prodMaybe #-}+prodMaybe :: (HasCallStack, PrimMonad m, Eq f, Monoid f, VU.Unbox f, Ord k, VU.Unbox k, Monoid v, VU.Unbox v, SegAct f v) => Map (PrimState m) f k v -> k -> k -> m (Maybe v)+prodMaybe m l r+  | l > r = pure Nothing+  | otherwise = Just <$> prod m l r++-- | Amortized \(O(\log n)\). Returns the monoid product in an interval \([k_1, k_2)\). Returns+-- `Nothing` if an invalid interval is given or for an empty sequence.+--+-- @since 1.2.1.0+{-# INLINE allProd #-}+allProd :: (HasCallStack, PrimMonad m, Eq f, Monoid f, VU.Unbox f, Ord k, VU.Unbox k, Monoid v, VU.Unbox v, SegAct f v) => Map (PrimState m) f k v -> m v+allProd Map {..} = do+  root <- VGM.read (Seq.unHandle rootMap) 0+  if P.nullIndex root+    then pure mempty+    else VGM.read (Raw.prodSeq seqMap) (coerce root)++-- | Amortized \(O(\log n)\).+--+-- ==== Constraint+-- - \(0 \le \lt r \le n\). Note that the interval must have positive length.+{-# INLINEABLE unsafeProdST #-}+unsafeProdST :: (HasCallStack, Eq f, Monoid f, VU.Unbox f, Ord k, VU.Unbox k, Monoid v, VU.Unbox v, SegAct f v) => Map s f k v -> k -> k -> ST s v+unsafeProdST m@Map {..} l r = do+  let Seq.Seq {..} = seqMap+  root <- VGM.read (Seq.unHandle rootMap) 0+  assertRootST seqMap root -- TODO: remove+  target <- sliceST m l r+  if P.nullIndex target+    then pure mempty+    else do+      res <- VGM.read prodSeq $ coerce target+      Raw.splayST seqMap target True+      VGM.write (Seq.unHandle rootMap) 0 target+      pure res++-- | Amortized \(O(\log n)\). Given an interval \([l, r)\), applies a monoid action \(f\).+--+-- ==== Constraints+-- - \(0 \le l \le r \le n\)+-- - The root must point to a non-empty sequence.+--+-- @since 1.2.1.0+{-# INLINEABLE applyIn #-}+applyIn :: (HasCallStack, PrimMonad m, Eq f, Monoid f, VU.Unbox f, Ord k, VU.Unbox k, Monoid v, VU.Unbox v, SegAct f v) => Map (PrimState m) f k v -> k -> k -> f -> m ()+applyIn m@Map {..} l r act = stToPrim $ do+  let !_ = ACIA.runtimeAssert (l <= r) "AtCoder.Extra.Seq.Map.applyIn: k1 > k2"+  unless (l == r) $ do+    target <- sliceST m l r+    unless (P.nullIndex target) $ do+      Raw.applyNodeST seqMap target act+      Raw.splayST seqMap target True+      VGM.write (Seq.unHandle rootMap) 0 target++-- | Amortized \(O(\log n)\).+--+-- @since 1.2.1.0+{-# INLINE applyAll #-}+applyAll :: (HasCallStack, PrimMonad m, Eq f, Monoid f, VU.Unbox f, Ord k, VU.Unbox k, Monoid v, VU.Unbox v, SegAct f v) => Map (PrimState m) f k v -> f -> m ()+applyAll Map {..} act = stToPrim $ do+  root <- VGM.read (Seq.unHandle rootMap) 0+  Raw.applyToRootST seqMap root act++-- -------------------------------------------------------------------------------------------+-- Key-based bisection method+-- -------------------------------------------------------------------------------------------++-- | Amortized \(O(\log n)\). Looks up for \((k, v)\) pair with the maximum key \(k\) such that+-- \(k \le k_{\mathrm{ref}}\).+--+-- @since 1.2.1.0+{-# INLINE lookupLE #-}+lookupLE :: (HasCallStack, PrimMonad m, Eq f, Monoid f, VU.Unbox f, Ord k, VU.Unbox k, Monoid v, VU.Unbox v, SegAct f v) => Map (PrimState m) f k v -> k -> m (Maybe (k, v))+lookupLE m k = stToPrim $ do+  lookupImplL m k EQ++-- | Amortized \(O(\log n)\). Looks up for \((k, v)\) pair with the maximum key \(k\) such that+-- \(k \lt k_{\mathrm{ref}}\).+--+-- @since 1.2.1.0+{-# INLINE lookupLT #-}+lookupLT :: (HasCallStack, PrimMonad m, Eq f, Monoid f, VU.Unbox f, Ord k, VU.Unbox k, Monoid v, VU.Unbox v, SegAct f v) => Map (PrimState m) f k v -> k -> m (Maybe (k, v))+lookupLT m k = stToPrim $ do+  lookupImplL m k LT++-- | Amortized \(O(\log n)\).+{-# INLINEABLE lookupImplL #-}+lookupImplL :: (HasCallStack, Eq f, Monoid f, VU.Unbox f, Ord k, VU.Unbox k, Monoid v, VU.Unbox v, SegAct f v) => Map s f k v -> k -> Ordering -> ST s (Maybe (k, v))+lookupImplL Map {..} k o = do+  root <- VGM.read (Seq.unHandle rootMap) 0+  if P.nullIndex root+    then pure Nothing+    else do+      (!l, !root') <- Raw.maxRightWithST seqMap root $ \i -> do+        ki <- VGM.read kMap (coerce i)+        pure $! compare ki k <= o+      if P.nullIndex l+        then do+          VGM.write (Seq.unHandle rootMap) 0 root'+          pure Nothing+        else do+          Raw.splayST seqMap l True -- TODO: is it True?+          VGM.write (Seq.unHandle rootMap) 0 l+          kl <- VGM.read kMap (coerce l)+          vl <- VGM.read (Seq.vSeq seqMap) (coerce l)+          pure $! Just (kl, vl)++-- | Amortized \(O(\log n)\). Looks up for \((k, v)\) pair with the minimum key \(k\) such that+-- \(k \ge k_{\mathrm{ref}}\).+--+-- @since 1.2.1.0+{-# INLINE lookupGE #-}+lookupGE :: (HasCallStack, PrimMonad m, Eq f, Monoid f, VU.Unbox f, Ord k, VU.Unbox k, Monoid v, VU.Unbox v, SegAct f v) => Map (PrimState m) f k v -> k -> m (Maybe (k, v))+lookupGE m k = stToPrim $ do+  lookupImplR m k LT++-- | Amortized \(O(\log n)\). Looks up for \((k, v)\) pair with the minimum key \(k\) such that+-- \(k \gt k_{\mathrm{ref}}\).+--+-- @since 1.2.1.0+{-# INLINE lookupGT #-}+lookupGT :: (HasCallStack, PrimMonad m, Eq f, Monoid f, VU.Unbox f, Ord k, VU.Unbox k, Monoid v, VU.Unbox v, SegAct f v) => Map (PrimState m) f k v -> k -> m (Maybe (k, v))+lookupGT m k = stToPrim $ do+  lookupImplR m k EQ++-- | Amortized \(O(\log n)\).+{-# INLINEABLE lookupImplR #-}+lookupImplR :: (HasCallStack, Eq f, Monoid f, VU.Unbox f, Ord k, VU.Unbox k, Monoid v, VU.Unbox v, SegAct f v) => Map s f k v -> k -> Ordering -> ST s (Maybe (k, v))+lookupImplR Map {..} k o = do+  let handle = Seq.unHandle rootMap+  root <- VGM.read handle 0+  if P.nullIndex root+    then pure Nothing+    else do+      let Raw.Seq {..} = seqMap+      (!l, !root') <- Raw.maxRightWithST seqMap root $ \i -> do+        k' <- VGM.read kMap (coerce i)+        pure $! compare k' k <= o++      if P.nullIndex l+        then do+          r <- Raw.splayKthST seqMap (coerce root') 0+          VGM.write handle 0 r+          kr <- VGM.read kMap (coerce r)+          vr <- VGM.read vSeq (coerce r)+          pure $ Just (kr, vr)+        else do+          Raw.splayST seqMap l True -- TODO: is it `True`?+          r0 <- VGM.read rSeq (coerce l)+          if P.nullIndex r0+            then do+              VGM.write handle 0 l+              pure Nothing+            else do+              r <- Raw.splayKthST seqMap (coerce r0) 0+              VGM.write handle 0 r+              kr <- VGM.read kMap (coerce r)+              vr <- VGM.read vSeq (coerce r)+              pure $ Just (kr, vr)++-- -------------------------------------------------------------------------------------------+-- Index-based operations+-- -------------------------------------------------------------------------------------------++-- | Amortized \(O(\log n)\).+--+-- @since 1.2.1.0+{-# INLINE readAt #-}+readAt :: (HasCallStack, PrimMonad m, Eq f, Monoid f, VU.Unbox f, Monoid v, VU.Unbox v, SegAct f v) => Map (PrimState m) f k v -> Int -> m v+readAt Map {..} i = stToPrim $ do+  Seq.read seqMap rootMap i++-- | Amortized \(O(\log n)\).+--+-- @since 1.2.1.0+{-# INLINE readMaybeAt #-}+readMaybeAt :: (HasCallStack, PrimMonad m, Eq f, Monoid f, VU.Unbox f, Monoid v, VU.Unbox v, SegAct f v) => Map (PrimState m) f k v -> Int -> m (Maybe v)+readMaybeAt Map {..} i = stToPrim $ do+  Seq.readMaybe seqMap rootMap i++-- | Amortized \(O(\log n)\).+--+-- @since 1.2.1.0+{-# INLINE writeAt #-}+writeAt :: (HasCallStack, PrimMonad m, Eq f, Monoid f, VU.Unbox f, Monoid v, VU.Unbox v, SegAct f v) => Map (PrimState m) f k v -> Int -> v -> m ()+writeAt Map {..} i v = stToPrim $ do+  Seq.write seqMap rootMap i v++-- | Amortized \(O(\log n)\).+--+-- @since 1.2.1.0+{-# INLINE modifyAt #-}+modifyAt :: (HasCallStack, PrimMonad m, Eq f, Monoid f, VU.Unbox f, Monoid v, VU.Unbox v, SegAct f v) => Map (PrimState m) f k v -> (v -> v) -> Int -> m ()+modifyAt Map {..} f i = stToPrim $ do+  Seq.modify seqMap rootMap f i++-- | Amortized \(O(\log n)\).+--+-- @since 1.2.1.0+{-# INLINE exchangeAt #-}+exchangeAt :: (HasCallStack, PrimMonad m, Eq f, Monoid f, VU.Unbox f, Monoid v, VU.Unbox v, SegAct f v) => Map (PrimState m) f k v -> Int -> v -> m v+exchangeAt Map {..} i v = stToPrim $ do+  Seq.exchange seqMap rootMap i v++-- | Amortized \(O(\log n)\).+--+-- @since 1.2.1.0+{-# INLINE prodInInterval #-}+prodInInterval :: (HasCallStack, PrimMonad m, Eq f, Monoid f, VU.Unbox f, Monoid v, VU.Unbox v, SegAct f v) => Map (PrimState m) f k v -> Int -> Int -> m v+prodInInterval Map {..} l r = stToPrim $ do+  Seq.prod seqMap rootMap l r++-- | Amortized \(O(\log n)\).+--+-- @since 1.2.1.0+{-# INLINE applyInInterval #-}+applyInInterval :: (HasCallStack, PrimMonad m, Eq f, Monoid f, VU.Unbox f, Monoid v, VU.Unbox v, SegAct f v) => Map (PrimState m) f k v -> Int -> Int -> f -> m ()+applyInInterval Map {..} l r f = stToPrim $ do+  Seq.applyIn seqMap rootMap l r f++-- | Amortized \(O(\log n)\).+--+-- @since 1.2.1.0+{-# INLINE ilowerBound #-}+ilowerBound ::+  (HasCallStack, PrimMonad m, SegAct f a, Eq f, Monoid f, VU.Unbox f, Monoid a, VU.Unbox a) =>+  -- | Map+  Map (PrimState m) f k a ->+  -- | User predicate \(f(i, v_i)\) that takes the index and the monoid value+  (Int -> a -> Bool) ->+  -- | Maximum \(r\), where \(f(i, v_i)\) holds for \(i \in [0, r)\)+  m Int+ilowerBound Map {..} f = stToPrim $ do+  Seq.ilowerBound seqMap rootMap f++-- | Amortized \(O(\log n)\).+--+-- @since 1.2.1.0+{-# INLINE ilowerBoundM #-}+ilowerBoundM ::+  (HasCallStack, PrimMonad m, SegAct f a, Eq f, Monoid f, VU.Unbox f, Monoid a, VU.Unbox a) =>+  -- | Map+  Map (PrimState m) f k a ->+  -- | User predicate \(f(i, v_i)\) that takes the index and the monoid value+  (Int -> a -> m Bool) ->+  -- | Maximum \(r\), where \(f(i, v_i)\) holds for \(i \in [0, r)\)+  m Int+ilowerBoundM Map {..} f = do+  Seq.ilowerBoundM seqMap rootMap f++-- | Amortized \(O(\log n)\).+--+-- @since 1.2.1.0+{-# INLINE ilowerBoundProd #-}+ilowerBoundProd ::+  (HasCallStack, PrimMonad m, SegAct f a, Eq f, Monoid f, VU.Unbox f, Monoid a, VU.Unbox a) =>+  -- | Map+  Map (PrimState m) f k a ->+  -- | User predicate \(f(i, v_0 \dots v_i)\) that takes the index and the monoid product+  (Int -> a -> Bool) ->+  -- | Maximum \(r\), where \(f(i, v_0 \dots v_i)\) holds for \(i \in [0, r)\)+  m Int+ilowerBoundProd Map {..} f = stToPrim $ do+  Seq.ilowerBoundProd seqMap rootMap f++-- | Amortized \(O(\log n)\).+--+-- @since 1.2.1.0+{-# INLINE ilowerBoundProdM #-}+ilowerBoundProdM ::+  (HasCallStack, PrimMonad m, SegAct f a, Eq f, Monoid f, VU.Unbox f, Monoid a, VU.Unbox a) =>+  -- | Map+  Map (PrimState m) f k a ->+  -- | User predicate \(f(i, v_0 \dots v_i)\) that takes the index and the monoid product+  (Int -> a -> m Bool) ->+  -- | Maximum \(r\), where \(f(i, v_0 \dots v_i)\) holds for \(i \in [0, r)\)+  m Int+ilowerBoundProdM Map {..} f = do+  Seq.ilowerBoundProdM seqMap rootMap f++-- -------------------------------------------------------------------------------------------+-- Conversions+-- -------------------------------------------------------------------------------------------++-- | \(O(n)\) Returns the \(k, v\) pairs in the map+--+-- @since 1.2.1.0+{-# INLINEABLE freeze #-}+freeze :: (HasCallStack, PrimMonad m, Eq f, Monoid f, VU.Unbox f, Ord k, VU.Unbox k, Monoid v, VU.Unbox v, SegAct f v) => Map (PrimState m) f k v -> m (VU.Vector (k, v))+freeze Map {..} = stToPrim $ do+  let Raw.Seq {..} = seqMap+  root0 <- VGM.read (Seq.unHandle rootMap) 0+  if P.nullIndex root0+    then pure VU.empty+    else do+      assertRootST seqMap root0+      size_ <- VGM.read sSeq (coerce root0)+      res <- VUM.unsafeNew size_+      let inner i root+            | P.nullIndex root = pure i+            | otherwise = do+                -- visit from left to right+                Raw.propNodeST seqMap root+                i' <- inner i =<< VGM.read lSeq (coerce root)+                kx <- VGM.read kMap (coerce root)+                vx <- VGM.read vSeq (coerce root)+                VGM.write res i' (kx, vx)+                inner (i' + 1) =<< VGM.read rSeq (coerce root)+      _ <- inner 0 root0+      VU.unsafeFreeze res

@@ -18,6 +18,10 @@     freeNodeST,     freeSubtreeST, +    -- * Metadata+    capacity,+    lengthST,+     -- * Merge/split     mergeST,     merge3ST,@@ -78,6 +82,17 @@      -- * Conversions     freezeST,++    -- * Internals+    -- | These functions are exported primarily for @Map@ implementations.+    splitMaxRightWithST,+    maxRightWithST,+    updateNodeST,+    writeNodeST,+    modifyNodeST,+    exchangeNodeST,+    propNodeST,+    applyNodeST,   ) where @@ -173,7 +188,7 @@ -- -- @since 1.2.0.0 {-# INLINEABLE newNodeST #-}-newNodeST :: (Monoid f, VU.Unbox f, VU.Unbox a) => Seq s f a -> a -> ST s P.Index+newNodeST :: (HasCallStack, Monoid f, VU.Unbox f, VU.Unbox a) => Seq s f a -> a -> ST s P.Index newNodeST Seq {..} x = do   i <- P.alloc poolSeq ()   VGM.write lSeq (coerce i) P.undefIndex@@ -190,7 +205,7 @@ -- -- @since 1.2.0.0 {-# INLINEABLE newSeqST #-}-newSeqST :: (Monoid f, VU.Unbox f, Monoid a, VU.Unbox a) => Seq s f a -> VU.Vector a -> ST s P.Index+newSeqST :: (HasCallStack, Monoid f, VU.Unbox f, Monoid a, VU.Unbox a) => Seq s f a -> VU.Vector a -> ST s P.Index newSeqST seq@Seq {..} !xs = do   -- [l, r)   let inner l r@@ -199,8 +214,8 @@         | otherwise = do             let !m = (l + r) `div` 2             rootL <- inner l m-            rootR <- inner (m + 1) r             root <- newNodeST seq (xs VG.! m)+            rootR <- inner (m + 1) r             unless (P.nullIndex rootL) $ do               VGM.write lSeq (coerce root) rootL               VGM.write pSeq (coerce rootL) root@@ -235,6 +250,26 @@       P.free poolSeq c0  -- -------------------------------------------------------------------------------------------------+-- Metadata+-- -------------------------------------------------------------------------------------------------++-- | \(O(1)\) Returns the capacity of the sequence storage.+--+-- @since 1.2.1.0+{-# INLINE capacity #-}+capacity :: Seq s f a -> Int+capacity = nSeq++-- | \(O(1)\) Returns the length of a sequence or a subtree.+--+-- @since 1.2.1.0+{-# INLINE lengthST #-}+lengthST :: Seq s f a -> P.Index -> ST s Int+lengthST Seq {..} i+  | P.nullIndex i = pure 0+  | otherwise = VGM.read sSeq (coerce i)++-- ------------------------------------------------------------------------------------------------- -- Merge/split -- ------------------------------------------------------------------------------------------------- @@ -250,9 +285,9 @@ assertRootOrNullST Seq {pSeq} i   | P.nullIndex i = pure ()   | otherwise = do-    p <- VGM.read pSeq (coerce i)-    let !_ = ACIA.runtimeAssert (P.nullIndex p) $ "AtCoder.Extra.Seq.Raw.assertRootOrNullST: not a root (node `" ++ show i ++ "`, parent `" ++ show p ++ "`)"-    pure ()+      p <- VGM.read pSeq (coerce i)+      let !_ = ACIA.runtimeAssert (P.nullIndex p) $ "AtCoder.Extra.Seq.Raw.assertRootOrNullST: not a root (node `" ++ show i ++ "`, parent `" ++ show p ++ "`)"+      pure ()  -- | Amortized \(O(\log n)\). Merges two sequences \(l, r\) into one in the given order, ignoring -- empty sequences.@@ -267,12 +302,8 @@   | P.nullIndex lRoot = pure rRoot   | P.nullIndex rRoot = pure lRoot   | otherwise = do-      do-        -- TODO: delete-        lp <- VGM.read pSeq (coerce lRoot)-        rp <- VGM.read pSeq (coerce rRoot)-        let !_ = ACIA.runtimeAssert (lp == rp) "AtCoder.Extra.Seq.Raw.mergeST: given non-root node"-        pure ()+      assertRootST seq lRoot+      assertRootST seq rRoot       rRoot' <- splayKthST seq rRoot 0       VGM.write lSeq (coerce rRoot') lRoot       VGM.write pSeq (coerce lRoot) rRoot'@@ -372,8 +403,8 @@   s <- do     rootL <- VGM.read lSeq (coerce root)     if P.nullIndex rootL-      then VGM.read sSeq (coerce rootL)-      else pure 0+      then pure 0+      else VGM.read sSeq (coerce rootL)   split3ST seq root s (s + 1)  -- | Amortized \(O(\log n)\). Captures the root of a subtree of \([l, r)\). Splay the new root after@@ -404,7 +435,7 @@           --    [        )           --             * root' (splayed)           --          * rootL (detached from the root)-          -- \* rootL' (splayed)+          -- * rootL' (splayed)           --    * right(rootL'): node that corresponds to [l, r)           root' <- splayKthST seq root r           rootL <- VGM.read lSeq $ coerce root'@@ -445,13 +476,13 @@ readMaybeST seq@Seq {..} root k   | P.nullIndex root = pure Nothing   | otherwise = do-    assertRootST seq root-    s <- VGM.read sSeq (coerce root)-    if 0 <= k && k < s-      then do-        root' <- splayKthST seq root k-        Just . (,root') <$> VGM.read vSeq (coerce root')-      else pure Nothing+      assertRootST seq root+      s <- VGM.read sSeq (coerce root)+      if 0 <= k && k < s+        then do+          root' <- splayKthST seq root k+          Just . (,root') <$> VGM.read vSeq (coerce root')+        else pure Nothing  -- | Amortized \(O(\log n)\). Writes to the \(k\)-th node's monoid value. --@@ -523,13 +554,13 @@ prodMaybeST seq@Seq {sSeq} root l r   | P.nullIndex root = pure Nothing   | otherwise = do-    s <- VGM.read sSeq (coerce root)-    if not (ACIA.testInterval l r s)-      then pure Nothing-      else-        if l == r-          then pure $ Just (mempty, root)-          else Just <$> unsafeProdST seq root l r+      s <- VGM.read sSeq (coerce root)+      if not (ACIA.testInterval l r s)+        then pure Nothing+        else+          if l == r+            then pure $ Just (mempty, root)+            else Just <$> unsafeProdST seq root l r  -- | Amortized \(O(\log n)\). --@@ -564,13 +595,12 @@ -- -- ==== Constraints -- - \(0 \le l \le r \le n\)--- - The root must point to a non-empty sequence. -- -- @since 1.2.0.0 {-# INLINEABLE applyInST #-} applyInST :: (HasCallStack, SegAct f a, Eq f, Monoid f, VU.Unbox f, Monoid a, VU.Unbox a) => Seq s f a -> P.Index -> Int -> Int -> f -> ST s P.Index applyInST seq@Seq {..} root l r act = do-  assertRootST seq root+  -- assertRootOrNullST seq root   s <- if P.nullIndex root then pure 0 else VGM.read sSeq (coerce root)   let !_ = ACIA.checkInterval "AtCoder.Extra.Seq.applyInST" l r s   if l == r@@ -589,9 +619,9 @@ applyToRootST seq@Seq {..} root act   | P.nullIndex root = pure ()   | otherwise = do-    rootP <- VGM.read pSeq (coerce root)-    when (P.nullIndex rootP) $ do-      applyNodeST seq root act+      rootP <- VGM.read pSeq (coerce root)+      when (P.nullIndex rootP) $ do+        applyNodeST seq root act  -- | Amortized \(O(\log n)\). Reverses the sequence in \([l, r)\). --@@ -605,17 +635,17 @@ reverseST seq@Seq {sSeq} root0 l r   | P.nullIndex root0 = pure P.undefIndex   | otherwise = do-    s <- VGM.read sSeq (coerce root0)-    if not (ACIA.testInterval l r s)-      then pure root0-      else-        if l == r-          then pure root0-          else do-            root' <- sliceST seq root0 l r-            reverseNodeST seq root'-            splayST seq root' True-            pure root'+      s <- VGM.read sSeq (coerce root0)+      if not (ACIA.testInterval l r s)+        then pure root0+        else+          if l == r+            then pure root0+            else do+              root' <- sliceST seq root0 l r+              reverseNodeST seq root'+              splayST seq root' True+              pure root'  -- | Amortized \(O(\log n)\). Inserts a new node at \(k\) with initial monoid value \(v\). This -- functions for an empty index.@@ -745,6 +775,7 @@ {-# INLINEABLE splayST #-} splayST :: (HasCallStack, SegAct f a, Eq f, Monoid f, VU.Unbox f, Monoid a, VU.Unbox a) => Seq s f a -> P.Index -> Bool -> ST s () splayST seq@Seq {..} i doneParentProp = do+  -- we have no chance to call `splayST` with `doneParentProp == False` though   if doneParentProp     then propNodeST seq i     else propNodeFromRootST seq i@@ -812,9 +843,6 @@  -- | Amortized \(O(\log n)\). ----- ==== Constraints--- - The node must be a root.--- -- @since 1.2.0.0 {-# INLINE ilowerBoundST #-} ilowerBoundST ::@@ -828,15 +856,14 @@   -- | (r, root)   ST s (Int, P.Index) ilowerBoundST seq root f = stToPrim $ do-  (!r, !_, !root') <- imaxRightST seq root f-  splayST seq root' True-  pure (r, root')+  if P.nullIndex root+    then pure (0, P.undefIndex)+    else do+      (!r, !_, !root') <- imaxRightST seq root f+      pure (r, root')  -- | Amortized \(O(\log n)\). ----- ==== Constraints--- - The node must be a root.--- -- @since 1.2.0.0 {-# INLINE ilowerBoundM #-} ilowerBoundM ::@@ -850,9 +877,11 @@   -- | (r, root)   m (Int, P.Index) ilowerBoundM seq root f = do-  (!r, !_, !root') <- imaxRightM seq root f-  stToPrim $ splayST seq root' True-  pure (r, root')+  if P.nullIndex root+    then pure (0, P.undefIndex)+    else do+      (!r, !_, !root') <- imaxRightM seq root f+      pure (r, root')  -- | Amortized \(O(\log n)\). --@@ -872,8 +901,11 @@   -- | (r, root)   ST s (Int, P.Index) ilowerBoundProdST seq root f = do-  (!r, !_, !root') <- imaxRightProdST seq root f-  pure (r, root')+  if P.nullIndex root+    then pure (0, P.undefIndex)+    else do+      (!r, !_, !root') <- imaxRightProdST seq root f+      pure (r, root')  -- | Amortized \(O(\log n)\). --@@ -893,15 +925,15 @@   -- | (r, root)   m (Int, P.Index) ilowerBoundProdM seq root f = do-  (!r, !_, !root') <- imaxRightProdM seq root f-  pure (r, root')+  if P.nullIndex root+    then pure (0, P.undefIndex)+    else do+      (!r, !_, !root') <- imaxRightProdM seq root f+      pure (r, root')  -- | Amortized \(O(\log n)\). Given a monotonious sequence, returns the rightmost node \(v_k\) -- where \(f(v)\) holds for every \([0, i) (0 \le i \lt k)\). ----- ==== Constraints--- - The node must be a root.--- -- @since 1.2.0.0 {-# INLINE isplitMaxRightST #-} isplitMaxRightST ::@@ -919,9 +951,6 @@ -- | Amortized \(O(\log n)\). Given a monotonious sequence, returns the rightmost node \(v_k\) -- where \(f(v)\) holds for every \([0, i) (0 \le i \lt k)\). ----- ==== Constraints--- - The node must be a root.--- -- @since 1.2.0.0 {-# INLINEABLE isplitMaxRightM #-} isplitMaxRightM ::@@ -961,9 +990,6 @@ -- | Amortized \(O(\log n)\). Given a monotonious sequence, returns the rightmost node \(v_k\) -- where \(f(v)\) holds for every \([0, i) (0 \le i \lt k)\). ----- ==== Constraints--- - The node must be a root.--- -- @since 1.2.0.0 {-# INLINE isplitMaxRightProdST #-} isplitMaxRightProdST ::@@ -981,9 +1007,6 @@ -- | Amortized \(O(\log n)\). Given a monotonious sequence, returns the rightmost node \(v_k\) -- where \(f(v)\) holds for every \([0, i) (0 \le i \lt k)\). ----- ==== Constraints--- - The node must be a root.--- -- @since 1.2.0.0 {-# INLINEABLE isplitMaxRightProdM #-} isplitMaxRightProdM ::@@ -1072,7 +1095,7 @@               if P.nullIndex l                 then pure offset                 else (offset +) <$> VGM.read sSeq (coerce l)-            b <- f pos v+            !b <- f pos v             if b               then do                 r <- stToPrim $ VGM.read rSeq $ coerce root@@ -1142,7 +1165,7 @@               VGM.write rSeq (coerce root) rootR               updateNodeST seq root               pure $! acc <> prodRoot-            b <- f pos prodM+            !b <- f pos prodM             if b               then do                 r <- stToPrim $ VGM.read rSeq $ coerce root@@ -1161,30 +1184,103 @@ -- | Amortized \(O(n)\). Returns the sequence of monoid values. -- -- @since 1.2.0.0-{-# INLINE freezeST #-}+{-# INLINEABLE freezeST #-} freezeST :: (HasCallStack, SegAct f a, Eq f, Monoid f, VU.Unbox f, Monoid a, VU.Unbox a) => Seq s f a -> P.Index -> ST s (VU.Vector a)-freezeST seq@Seq {sSeq, lSeq, rSeq, vSeq} root0 = do-  size <- VGM.read sSeq (coerce root0)-  res <- VUM.unsafeNew size-  let inner i root-        | P.nullIndex root = pure i-        | otherwise = do-            -- visit from left to right-            propNodeST seq root-            i' <- inner i =<< VGM.read lSeq (coerce root)-            vx <- VGM.read vSeq (coerce root)-            VGM.write res i' vx-            inner (i' + 1) =<< VGM.read rSeq (coerce root)-  _ <- inner 0 root0-  VU.unsafeFreeze res+freezeST seq@Seq {sSeq, lSeq, rSeq, vSeq} root0+  | P.nullIndex root0 = pure VU.empty+  | otherwise = do+      size <- VGM.read sSeq (coerce root0)+      res <- VUM.unsafeNew size+      let inner i root+            | P.nullIndex root = pure i+            | otherwise = do+                -- visit from left to right+                propNodeST seq root+                i' <- inner i =<< VGM.read lSeq (coerce root)+                vx <- VGM.read vSeq (coerce root)+                VGM.write res i' vx+                inner (i' + 1) =<< VGM.read rSeq (coerce root)+      _ <- inner 0 root0+      VU.unsafeFreeze res  -- ---------------------------------------------------------------------------------------------------- Node methods+-- Internals and node methods -- ------------------------------------------------------------------------------------------------- --- NOTE(pref): inlining these functions are important for the speed+-- | Amortized \(O(\log n)\).+--+-- @since 1.2.1.0+{-# INLINEABLE splitMaxRightWithST #-}+splitMaxRightWithST ::+  (HasCallStack, SegAct f a, Eq f, Monoid f, VU.Unbox f, Monoid a, VU.Unbox a) =>+  -- | Sequence storage+  Seq s f a ->+  -- | Root node+  P.Index ->+  -- | User predicate \(f(i)\)+  (P.Index -> ST s Bool) ->+  -- | (left, right) sequences where \(f\) holds for the left+  ST s (P.Index, P.Index)+splitMaxRightWithST seq@Seq {..} root f+  | P.nullIndex root = pure (P.undefIndex, P.undefIndex)+  | otherwise = do+      assertRootST seq root+      (!c, !_) <- maxRightWithST seq root f+      if P.nullIndex c+        then do+          -- `f` does hot hold+          splayST seq root True+          pure (P.undefIndex, root)+        else do+          splayST seq c True+          right <- VGM.read rSeq (coerce c)+          if P.nullIndex right+            then do+              -- `f` holds for the whole sequence+              pure (c, P.undefIndex)+            else do+              -- `f` holds for part of the sequence. detach the right child+              VGM.write pSeq (coerce right) P.undefIndex+              VGM.write rSeq (coerce c) P.undefIndex+              updateNodeST seq c+              pure (c, right) +-- | Amortized \(O(\log n)\). Given a monotonious sequence, returns the rightmost node \(v_k\)+-- where \(f(v)\) holds for every \([0, i) (0 \le i \lt k)\).+--+-- ==== Constraints+-- - The node must be a root.+--+-- @since 1.2.1.0+{-# INLINEABLE maxRightWithST #-}+maxRightWithST ::+  (HasCallStack, SegAct f a, Eq f, Monoid f, VU.Unbox f, Monoid a, VU.Unbox a) =>+  -- | Sequence storage+  Seq s f a ->+  -- | Root node+  P.Index ->+  -- | User predicate+  (P.Index -> ST s Bool) ->+  -- | (rightmost node, new root)+  ST s (P.Index, P.Index)+maxRightWithST seq@Seq {..} root0 f = do+  let inner parent lastYes root+        | P.nullIndex root = pure (lastYes, parent)+        | otherwise = do+            stToPrim $ propNodeST seq root+            !b <- f root+            if b+              then inner root root =<< VGM.read rSeq (coerce root)+              else inner root lastYes =<< VGM.read lSeq (coerce root)+  (!yes, !root') <- inner P.undefIndex P.undefIndex root0+  stToPrim $ splayST seq root' True+  pure (yes, root')++-- NOTE(pref): inlining node functions are important for the speed+ -- | \(O(1)\) Recomputes the node size and the monoid product.+--+-- @since 1.2.1.0 {-# INLINEABLE updateNodeST #-} updateNodeST :: (Monoid a, VU.Unbox a) => Seq s f a -> P.Index -> ST s () updateNodeST Seq {..} i = do@@ -1208,7 +1304,9 @@   VGM.write sSeq (coerce i) size''   VGM.write prodSeq (coerce i) prod'' --- | \(O(1)\) Writes to the monoid.+-- | \(O(1)\) Writes to the monoid value of a node.+--+-- @since 1.2.1.0 {-# INLINE writeNodeST #-} writeNodeST :: (Monoid a, VU.Unbox a) => Seq s f a -> P.Index -> a -> ST s () writeNodeST seq@Seq {..} root v = do@@ -1216,7 +1314,9 @@   VGM.write vSeq (coerce root) v   updateNodeST seq root --- | \(O(1)\) Modifies the monoid.+-- | \(O(1)\) Modifies the monoid value of a node.+--+-- @since 1.2.1.0 {-# INLINE modifyNodeST #-} modifyNodeST :: (HasCallStack, Monoid a, VU.Unbox a) => Seq s f a -> (a -> a) -> P.Index -> ST s () modifyNodeST seq@Seq {..} f root = do@@ -1224,7 +1324,9 @@   VGM.modify vSeq f $ coerce root   updateNodeST seq root --- | \(O(1)\) Modifies the monoid.+-- | \(O(1)\) Exchanges the monoid value of a node.+--+-- @since 1.2.1.0 {-# INLINE exchangeNodeST #-} exchangeNodeST :: (HasCallStack, Monoid a, VU.Unbox a) => Seq s f a -> P.Index -> a -> ST s a exchangeNodeST seq@Seq {..} root v = do@@ -1248,12 +1350,15 @@   VGM.modify revSeq (xor (Bit True)) $ coerce i  -- | Amortized \(O(\log n)\). Propgates the lazily propagated values on a node.+--+-- @since 1.2.1.0 {-# INLINE propNodeST #-} -- NOTE(pref): Although this function is large, inlining it needs for the speed. propNodeST :: (HasCallStack, SegAct f a, Eq f, VU.Unbox f, Monoid a, VU.Unbox a) => Seq s f a -> P.Index -> ST s () propNodeST seq@Seq {..} i = do   -- action   act <- VGM.exchange lazySeq (coerce i) mempty+  -- this is where `Eq f` is required:   when (act /= mempty) $ do     l <- VGM.read lSeq $ coerce i     unless (P.nullIndex l) $ do@@ -1277,7 +1382,7 @@ -- | Amortized \(O(\log n)\). Propagetes from the root to the given node. {-# INLINE propNodeFromRootST #-} propNodeFromRootST :: (HasCallStack, SegAct f a, VU.Unbox f, VU.Unbox a, Monoid a) => Seq s f a -> P.Index -> ST s ()-propNodeFromRootST Seq {..} i0 = inner i0+propNodeFromRootST Seq {..} = inner   where     inner i = do       p <- VGM.read pSeq $ coerce i@@ -1286,6 +1391,8 @@       inner i  -- | Amortized \(O(\log n)\). Propgates at a node.+--+-- @since 1.2.1.0 {-# INLINE applyNodeST #-} applyNodeST :: (HasCallStack, SegAct f a, VU.Unbox f, Monoid a, VU.Unbox a) => Seq s f a -> P.Index -> f -> ST s () applyNodeST Seq {..} i act = do

@@ -51,7 +51,7 @@     modify,     prod,     prodMaybe,-    allProd,+    allProd, -- FIXME: rename to prodAll     -- wavelet matrix methods could be implemented, too   ) where

@@ -10,6 +10,11 @@ -- *** Exception: AtCoder.Internal.Assert.doctest: given invalid index `-1` over length `3` -- ... --+-- >>> let !_ = checkIndexBounded "AtCoder.Internal.Assert.doctest" 2 1 3+-- >>> let !_ = checkIndexBounded "AtCoder.Internal.Assert.doctest" (-1) 1 3+-- *** Exception: AtCoder.Internal.Assert.doctest: given invalid index `-1` over bounds `[1, 3)`+-- ...+-- -- >>> let !_ = checkVertex "AtCoder.Internal.Assert.doctest" 0 3 -- >>> let !_ = checkVertex "AtCoder.Internal.Assert.doctest" (-1) 3 -- *** Exception: AtCoder.Internal.Assert.doctest: given invalid vertex `-1` over the number of vertices `3`@@ -30,6 +35,11 @@ -- *** Exception: AtCoder.Internal.Assert.doctest: given invalid interval `[0, 4)` over length `3` -- ... --+-- >>> let !_ = checkIntervalBounded "AtCoder.Internal.Assert.doctest"  2 4 0 5+-- >>> let !_ = checkIntervalBounded "AtCoder.Internal.Assert.doctest" (-1) 0 0 5+-- *** Exception: AtCoder.Internal.Assert.doctest: given invalid interval `[-1, 0)` over bounds `[0, 5)`+-- ...+-- -- @since 1.0.0.0 module AtCoder.Internal.Assert   ( -- * Runtime assertion@@ -38,10 +48,13 @@     -- * Tests     testIndex,     testInterval,+    testIntervalBounded,      -- * Index assertions     checkIndex,     errorIndex,+    checkIndexBounded,+    errorIndexBounded,     checkVertex,     errorVertex,     checkEdge,@@ -52,6 +65,8 @@     -- * Interval assertion     checkInterval,     errorInterval,+    checkIntervalBounded,+    errorIntervalBounded,   ) where @@ -80,6 +95,13 @@ testInterval :: Int -> Int -> Int -> Bool testInterval l r n = 0 <= l && l <= r && r <= n +-- | \(O(1)\) Tests whether \([l, r)\) is a valid interval in \([l_0, r_0)\).+--+-- @since 1.2.1.0+{-# INLINE testIntervalBounded #-}+testIntervalBounded :: Int -> Int -> Int -> Int -> Bool+testIntervalBounded l r l0 r0 = l0 <= l && l <= r && r <= r0+ -- | \(O(1)\) Asserts \(0 \leq i \lt n\) for an array index \(i\). -- -- @since 1.0.0.0@@ -97,6 +119,23 @@ errorIndex funcName i n =   error $ funcName ++ ": given invalid index `" ++ show i ++ "` over length `" ++ show n ++ "`" +-- | \(O(1)\) Asserts \(l_0 \leq i \lt r_0\) for an array index \(i\).+--+-- @since 1.2.1.0+{-# INLINE checkIndexBounded #-}+checkIndexBounded :: (HasCallStack) => String -> Int -> Int -> Int -> ()+checkIndexBounded funcName i l r+  | l <= i && i < r = ()+  | otherwise = errorIndexBounded funcName i l r++-- | \(O(1)\) Emits index boundary error.+--+-- @since 1.2.1.0+{-# INLINE errorIndexBounded #-}+errorIndexBounded :: (HasCallStack) => String -> Int -> Int -> Int -> a+errorIndexBounded funcName i l r =+  error $ funcName ++ ": given invalid index `" ++ show i ++ "` over bounds `[" ++ show l ++ ", " ++ show r ++ ")`"+ -- | \(O(1)\) Asserts \(0 \leq i \lt n\) for a graph vertex \(i\). -- -- @since 1.0.0.0@@ -162,3 +201,19 @@ {-# INLINE errorInterval #-} errorInterval :: (HasCallStack) => String -> Int -> Int -> Int -> a errorInterval funcName l r n = error $ funcName ++ ": given invalid interval `[" ++ show l ++ ", " ++ show r ++ ")` over length `" ++ show n ++ "`"++-- | \(O(1)\) Asserts \(0 \leq l \leq r \leq n\) for a half-open interval \([l, r)\).+--+-- @since 1.2.1.0+{-# INLINE checkIntervalBounded #-}+checkIntervalBounded :: (HasCallStack) => String -> Int -> Int -> Int -> Int -> ()+checkIntervalBounded funcName l r l0 r0+  | testIntervalBounded l r l0 r0 = ()+  | otherwise = errorIntervalBounded funcName l r l0 r0++-- | \(O(1)\) Asserts \(0 \leq l \leq r \leq n\) for a half-open interval \([l, r)\).+--+-- @since 1.2.1.0+{-# INLINE errorIntervalBounded #-}+errorIntervalBounded :: (HasCallStack) => String -> Int -> Int -> Int -> Int -> a+errorIntervalBounded funcName l r l0 r0 = error $ funcName ++ ": given invalid interval `[" ++ show l ++ ", " ++ show r ++ ")` over bounds `[" ++ show l0 ++ ", " ++ show r0 ++ ")`"

@@ -20,11 +20,20 @@ -- >>> length buf -- 2 ----- Access each elements with `read`, `write`, `modify` or `modifyM`:+-- Access each elements with `read`, `readMaybe`, `write`, `modify` or `modifyM`: -- -- >>> B.read buf 0 -- 10 --+-- >>> B.readMaybe buf (-1)+-- Nothing+--+-- >>> B.readMaybe buf 0+-- Just 10+--+-- >>> B.readMaybe buf 2+-- Nothing+-- -- >>> B.write buf 1 0   -- [10, 0,  _  _] -- -- Remove elements with `pushBack`:@@ -61,6 +70,7 @@     -- * Reading     back,     read,+    readMaybe,      -- * Modifications     pushBack,@@ -158,6 +168,17 @@   len <- VGM.read lenB 0   let !_ = ACIA.checkIndex "AtCoder.Internal.Buffer.read" i len   VGM.read vecB i++-- | \(O(1)\) Yields the element at the given position, or `Nothing` if the index is out of range.+--+-- @since 1.2.1.0+{-# INLINE readMaybe #-}+readMaybe :: (PrimMonad m, VU.Unbox a) => Buffer (PrimState m) a -> Int -> m (Maybe a)+readMaybe Buffer {..} i = do+  len <- VGM.read lenB 0+  if ACIA.testIndex i len+    then Just <$> VGM.unsafeRead vecB i+    else pure Nothing  -- | \(O(1)\) Appends an element to the back. --

@@ -24,6 +24,15 @@ -- >>> GV.read growVec 1 -- 20 --+-- >>> GV.readMaybe growVec (-1)+-- Nothing+--+-- >>> GV.readMaybe growVec 0+-- Just 10+--+-- >>> GV.readMaybe growVec 3+-- Nothing+-- -- >>> GV.popBack growVec -- Just 12 --@@ -54,6 +63,7 @@      -- * Readings     read,+    readMaybe,      -- * Modifications @@ -157,6 +167,18 @@   let len = VUM.length vec   let !_ = ACIA.checkIndex "AtCoder.Internal.GrowVec.read" i len   VGM.read vec i++-- | \(O(1)\) Yields the element at the given position, or `Nothing` if the index is out of range.+--+-- @since 1.2.1.0+{-# INLINE readMaybe #-}+readMaybe :: (HasCallStack, PrimMonad m, VU.Unbox a) => GrowVec (PrimState m) a -> Int -> m (Maybe a)+readMaybe GrowVec {..} i = do+  vec <- readMutVar vecGV+  len <- VGM.unsafeRead posGV 0+  if ACIA.testIndex i len+    then Just <$> VGM.unsafeRead vec i+    else pure Nothing  -- | \(O(1)\) Writes to the element at the given position. Will throw an exception if the index is -- out of range.

@@ -79,7 +79,7 @@ -- -- @since 1.0.0.0 module AtCoder.LazySegTree-  ( -- Lazy segment tree+  ( -- * Lazy segment tree     SegAct (..),     LazySegTree (nLst, sizeLst, logLst), @@ -97,7 +97,7 @@     -- * Products     prod,     prodMaybe,-    allProd,+    allProd, -- FIXME: rename to prodAll      -- * Applications     applyAt,@@ -557,6 +557,7 @@   -- propagate   for_ [logLst, logLst - 1 .. 1] $ \i -> do     pushST self $ p' .>>. i+  -- FIXME: length should be always `1`   let !len = bit $! logLst - (63 - countLeadingZeros p')   VGM.modify dLst (segActWithLength len f) p'   -- evaluate

@@ -5,6 +5,12 @@ import Tests.Convolution qualified import Tests.Dsu qualified import Tests.Extra.Bisect qualified+import Tests.Extra.DynLazySegTree qualified+import Tests.Extra.DynLazySegTree.Persistent qualified+import Tests.Extra.DynSegTree qualified+import Tests.Extra.DynSegTree.Persistent qualified+import Tests.Extra.DynSparseSegTree qualified+import Tests.Extra.DynSparseSegTree.Persistent qualified import Tests.Extra.HashMap qualified import Tests.Extra.IntMap qualified import Tests.Extra.IntSet qualified@@ -15,6 +21,7 @@ import Tests.Extra.Semigroup.Matrix qualified import Tests.Extra.Semigroup.Permutation qualified import Tests.Extra.Seq qualified+import Tests.Extra.Seq.Map qualified import Tests.Extra.WaveletMatrix qualified import Tests.Extra.WaveletMatrix.BitVector qualified import Tests.Extra.WaveletMatrix.Raw qualified@@ -47,6 +54,12 @@         testGroup           "Extra"           [ testGroup "Bisect" Tests.Extra.Bisect.tests,+            testGroup "DynLazySegTree" Tests.Extra.DynLazySegTree.tests,+            testGroup "DynLazySegTree.Persistent" Tests.Extra.DynLazySegTree.Persistent.tests,+            testGroup "DynSegTree" Tests.Extra.DynSegTree.tests,+            testGroup "DynSegTree.Persistent" Tests.Extra.DynSegTree.Persistent.tests,+            testGroup "DynSparseSegTree" Tests.Extra.DynSparseSegTree.tests,+            testGroup "DynSparseSegTree.Persistent" Tests.Extra.DynSparseSegTree.Persistent.tests,             testGroup "HashMap" Tests.Extra.HashMap.tests,             testGroup "IntervalMap" Tests.Extra.IntervalMap.tests,             testGroup "IntMap" Tests.Extra.IntMap.tests,@@ -57,6 +70,7 @@             testGroup "Semigroup.Matrix" Tests.Extra.Semigroup.Matrix.tests,             testGroup "Semigroup.Permutation" Tests.Extra.Semigroup.Permutation.tests,             testGroup "Seq" Tests.Extra.Seq.tests,+            testGroup "Seq.Map" Tests.Extra.Seq.Map.tests,             testGroup "WaveletMatrix" Tests.Extra.WaveletMatrix.tests,             testGroup "WaveletMatrix.BitVector" Tests.Extra.WaveletMatrix.BitVector.tests,             testGroup "WaveletMatrix.Raw" Tests.Extra.WaveletMatrix.Raw.tests,

@@ -0,0 +1,184 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ViewPatterns #-}++module Tests.Extra.DynLazySegTree where++import AtCoder.Extra.DynLazySegTree (SegAct (..))+import AtCoder.Extra.DynLazySegTree qualified as Seg+import AtCoder.Extra.Monoid.Affine1 (Affine1 (..))+import AtCoder.Extra.Monoid.Affine1 qualified as Affine1+import AtCoder.ModInt qualified as M+import Control.Monad.ST (RealWorld, runST)+import Data.Foldable (for_)+import Data.Semigroup (Sum (..))+import Data.Vector.Algorithms.Intro qualified as VAI+import Data.Vector.Generic.Mutable qualified as VGM+import Data.Vector.Unboxed qualified as VU+import Data.Vector.Unboxed.Mutable qualified as VUM+import GHC.Stack (HasCallStack)+import Test.QuickCheck.Monadic as QCM+import Test.Tasty+import Test.Tasty.QuickCheck as QC+import Tests.Util++type Mint = M.ModInt998244353++modInt :: Int -> Mint+modInt = M.new++data Init = Init+  { n :: {-# UNPACK #-} !Int,+    q :: {-# UNPACK #-} !Int,+    refM :: !(IO (VUM.MVector RealWorld (Sum Mint))),+    segM :: !(IO (Seg.DynLazySegTree RealWorld (Affine1 Mint) (Sum Mint)))+  }++instance Show Init where+  show Init {..} = show n++initialProd :: Int -> Int -> Sum Mint+initialProd l r = Sum . modInt $ sum [l .. r - 1]++instance QC.Arbitrary Init where+  arbitrary = do+    n <- QC.chooseInt (1, 256)+    q <- QC.chooseInt (1, 5 * n)+    l0 <- QC.chooseInt (-256, 256)+    -- initial node values: l0, l0 + 1, l0 + 2, ..+    let cap = Seg.recommendedCapacity n q+    pure+      . Init n q (VUM.generate n (\i -> initialProd (i + l0) (i + l0 + 1)))+      $ Seg.buildWith cap l0 (l0 + n) initialProd++data Query+  = Write !Int !(Sum Mint)+  | Modify !Int !(Sum Mint)+  | ModifyM !Int !(Sum Mint)+  | Prod !(Int, Int)+  | AllProd+  | ApplyAt !Int !(Affine1 Mint)+  | ApplyIn !(Int, Int) !(Affine1 Mint)+  | ApplyAll !(Affine1 Mint)+  | ResetInterval !(Int, Int)+  deriving (Show)++-- | Arbitrary return type for the `Query` result.+data Result+  = None+  | S !(Sum Mint)+  | F !(VU.Vector (Sum Mint))+  deriving (Show, Eq)++queryGen :: Int -> QC.Gen Query+queryGen n = do+  QC.oneof+    [ Write <$> k <*> v,+      Modify <$> k <*> v,+      ModifyM <$> k <*> v,+      Prod <$> i,+      pure AllProd,+      ApplyAt <$> k <*> f,+      ApplyIn <$> i <*> f,+      ApplyAll <$> f,+      ResetInterval <$> i+    ]+  where+    k = QC.chooseInt (0, n - 1)+    v = Sum . modInt <$> QC.arbitrary+    i = intervalGen n+    f = Affine1.new <$> (modInt <$> arbitrary) <*> (modInt <$> arbitrary)++-- | containers. (referencial implementation)+handleRef :: Int -> VUM.MVector RealWorld (Sum Mint) -> Query -> IO Result+handleRef l0 vec q = case q of+  Write k v -> do+    VGM.write vec k v+    pure None+  Modify k v -> do+    VGM.modify vec (+ v) k+    pure None+  ModifyM k v -> do+    VGM.modify vec (+ v) k+    pure None+  Prod (!l, !r) -> do+    (S <$>) . VGM.foldl' (<>) mempty $ VGM.slice l (r - l) vec+  AllProd -> do+    S <$> VGM.foldl' (<>) mempty vec+  ApplyAt i f -> do+    VGM.modify vec (segAct f) i+    pure None+  ApplyIn (!l, !r) f -> do+    for_ [l .. r - 1] $ \i -> do+      VGM.modify vec (segAct f) i+    pure None+  ApplyAll f -> do+    for_ [0 .. VGM.length vec - 1] $ \i -> do+      VGM.modify vec (segAct f) i+    pure None+  ResetInterval (!l, !r) -> do+    for_ [l .. r - 1] $ \i -> do+      VGM.write vec i $! initialProd (l0 + i) (l0 + i + 1)+    pure None++-- | ac-library-hs.+handleAcl :: (HasCallStack) => Seg.DynLazySegTree RealWorld (Affine1 Mint) (Sum Mint) -> Seg.Index -> Query -> IO Result+handleAcl seg root q = case q of+  Write (d -> k) v -> do+    Seg.write seg root k v+    pure None+  Modify (d -> k) v -> do+    Seg.modify seg root (+ v) k+    pure None+  ModifyM (d -> k) v -> do+    Seg.modifyM seg root (pure . (+ v)) k+    pure None+  Prod (d -> l, d -> r) -> do+    S <$> Seg.prod seg root l r+  AllProd -> do+    S <$> Seg.allProd seg root+  ApplyAt (d -> i) f -> do+    Seg.applyAt seg root i f+    pure None+  ApplyIn (d -> l, d -> r) f -> do+    Seg.applyIn seg root l r f+    pure None+  ApplyAll f -> do+    Seg.applyAll seg root f+    pure None+  ResetInterval (d -> l, d -> r) -> do+    Seg.resetInterval seg root l r+    pure None+  where+    d = (+ Seg.l0Ldst seg)++prop_randomTest :: Init -> QC.Property+prop_randomTest Init {..} = QCM.monadicIO $ do+  qs <- QCM.pick $ QC.vectorOf q (queryGen n)+  ref <- QCM.run refM+  seg <- QCM.run segM+  let l0 = Seg.l0Ldst seg+  let bounds = (Seg.l0Ldst seg, Seg.r0Ldst seg)+  root <- QCM.run $ Seg.newRoot seg+  for_ qs $ \query -> do+    expected <- QCM.run $ handleRef l0 ref query+    res <- QCM.run $ handleAcl seg root query+    QCM.assertWith (expected == res) $ show (bounds, query, expected, res)++-- prop_foldl is tested with large array verification problem++prop_maxRight :: Int -> [QC.NonNegative Int] -> QC.Property+prop_maxRight xRef xs_ =+  not (null xs_) QC.==> do+    let xs = VU.modify VAI.sort $ VU.fromList $ map (\(QC.NonNegative x) -> x) xs_+        expected = VU.length . VU.takeWhile (<= xRef) $ VU.scanl1' (+) xs+        res = runST $ do+          seg <- Seg.new @_ @() @(Sum Int) (2 * VU.length xs) 0 (VU.length xs)+          root <- Seg.newSeq seg $ VU.map Sum xs+          Seg.maxRight seg root (<= Sum xRef)+     in expected QC.=== res++tests :: [TestTree]+tests =+  [ QC.testProperty "randomTest" prop_randomTest,+    QC.testProperty "maxRight" prop_maxRight+  ]

@@ -0,0 +1,189 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ViewPatterns #-}++-- | Same test with non-persistent version+module Tests.Extra.DynLazySegTree.Persistent where++import AtCoder.Extra.DynLazySegTree.Persistent (SegAct (..))+import AtCoder.Extra.DynLazySegTree.Persistent qualified as Seg+import AtCoder.Extra.Monoid.Affine1 (Affine1 (..))+import AtCoder.Extra.Monoid.Affine1 qualified as Affine1+import AtCoder.ModInt qualified as M+import Control.Monad.ST (RealWorld, runST)+import Data.Foldable (for_)+import Data.Semigroup (Sum (..))+import Data.Vector.Algorithms.Intro qualified as VAI+import Data.Vector.Generic.Mutable qualified as VGM+import Data.Vector.Unboxed qualified as VU+import Data.Vector.Unboxed.Mutable qualified as VUM+import GHC.Stack (HasCallStack)+import Test.QuickCheck.Monadic as QCM+import Test.Tasty+import Test.Tasty.QuickCheck as QC+import Tests.Util++type Mint = M.ModInt998244353++modInt :: Int -> Mint+modInt = M.new++data Init = Init+  { n :: {-# UNPACK #-} !Int,+    q :: {-# UNPACK #-} !Int,+    refM :: !(IO (VUM.MVector RealWorld (Sum Mint))),+    segM :: !(IO (Seg.DynLazySegTree RealWorld (Affine1 Mint) (Sum Mint)))+  }++instance Show Init where+  show Init {..} = show n++initialProd :: Int -> Int -> Sum Mint+initialProd l r = Sum . modInt $ sum [l .. r - 1]++instance QC.Arbitrary Init where+  arbitrary = do+    n <- QC.chooseInt (1, 256)+    q <- QC.chooseInt (1, 5 * n)+    l0 <- QC.chooseInt (-256, 256)+    -- initial node values: l0, l0 + 1, l0 + 2, ..+    let cap = Seg.recommendedCapacity n q+    pure+      . Init n q (VUM.generate n (\i -> initialProd (i + l0) (i + l0 + 1)))+      $ Seg.buildWith cap l0 (l0 + n) initialProd++data Query+  = Write !Int !(Sum Mint)+  | Modify !Int !(Sum Mint)+  | ModifyM !Int !(Sum Mint)+  | Prod !(Int, Int)+  | AllProd+  | ApplyAt !Int !(Affine1 Mint)+  | ApplyIn !(Int, Int) !(Affine1 Mint)+  | ApplyAll !(Affine1 Mint)+  | ResetInterval !(Int, Int)+  deriving (Show)++-- | Arbitrary return type for the `Query` result.+data Result+  = None+  | S !(Sum Mint)+  | F !(VU.Vector (Sum Mint))+  deriving (Show, Eq)++queryGen :: Int -> QC.Gen Query+queryGen n = do+  QC.oneof+    [ Write <$> k <*> v,+      Modify <$> k <*> v,+      ModifyM <$> k <*> v,+      Prod <$> i,+      pure AllProd,+      ApplyAt <$> k <*> f,+      ApplyIn <$> i <*> f,+      ApplyAll <$> f,+      ResetInterval <$> i+    ]+  where+    k = QC.chooseInt (0, n - 1)+    v = Sum . modInt <$> QC.arbitrary+    i = intervalGen n+    f = Affine1.new <$> (modInt <$> arbitrary) <*> (modInt <$> arbitrary)++-- | containers. (referencial implementation)+handleRef :: Int -> VUM.MVector RealWorld (Sum Mint) -> Query -> IO Result+handleRef l0 vec q = case q of+  Write k v -> do+    VGM.write vec k v+    pure None+  Modify k v -> do+    VGM.modify vec (+ v) k+    pure None+  ModifyM k v -> do+    VGM.modify vec (+ v) k+    pure None+  Prod (!l, !r) -> do+    (S <$>) . VGM.foldl' (<>) mempty $ VGM.slice l (r - l) vec+  AllProd -> do+    S <$> VGM.foldl' (<>) mempty vec+  ApplyAt i f -> do+    VGM.modify vec (segAct f) i+    pure None+  ApplyIn (!l, !r) f -> do+    for_ [l .. r - 1] $ \i -> do+      VGM.modify vec (segAct f) i+    pure None+  ApplyAll f -> do+    for_ [0 .. VGM.length vec - 1] $ \i -> do+      VGM.modify vec (segAct f) i+    pure None+  ResetInterval (!l, !r) -> do+    for_ [l .. r - 1] $ \i -> do+      VGM.write vec i $! initialProd (l0 + i) (l0 + i + 1)+    pure None++-- | ac-library-hs.+handleAcl :: (HasCallStack) => Seg.DynLazySegTree RealWorld (Affine1 Mint) (Sum Mint) -> VUM.MVector RealWorld Seg.Index -> Query -> IO Result+handleAcl seg rootVec q = do+  root <- VGM.read rootVec 0+  case q of+    Write (d -> k) v -> do+      VGM.write rootVec 0 =<< Seg.write seg root k v+      VGM.write rootVec 0 =<< Seg.write seg root k v+      pure None+    Modify (d -> k) v -> do+      VGM.write rootVec 0 =<< Seg.modify seg root (+ v) k+      pure None+    ModifyM (d -> k) v -> do+      VGM.write rootVec 0 =<< Seg.modifyM seg root (pure . (+ v)) k+      pure None+    Prod (d -> l, d -> r) -> do+      S <$> Seg.prod seg root l r+    AllProd -> do+      S <$> Seg.allProd seg root+    ApplyAt (d -> i) f -> do+      VGM.write rootVec 0 =<< Seg.applyAt seg root i f+      pure None+    ApplyIn (d -> l, d -> r) f -> do+      VGM.write rootVec 0 =<< Seg.applyIn seg root l r f+      pure None+    ApplyAll f -> do+      VGM.write rootVec 0 =<< Seg.applyAll seg root f+      pure None+    ResetInterval (d -> l, d -> r) -> do+      VGM.write rootVec 0 =<< Seg.resetInterval seg root l r+      pure None+  where+    d = (+ Seg.l0Ldst seg)++prop_randomTest :: Init -> QC.Property+prop_randomTest Init {..} = QCM.monadicIO $ do+  qs <- QCM.pick $ QC.vectorOf q (queryGen n)+  ref <- QCM.run refM+  seg <- QCM.run segM+  let l0 = Seg.l0Ldst seg+  let bounds = (Seg.l0Ldst seg, Seg.r0Ldst seg)+  root <- QCM.run $ Seg.newRoot seg+  rootVec <- QCM.run $ VUM.replicate 1 root+  for_ qs $ \query -> do+    expected <- QCM.run $ handleRef l0 ref query+    res <- QCM.run $ handleAcl seg rootVec query+    QCM.assertWith (expected == res) $ show (bounds, query, expected, res)++-- prop_foldl is tested with large array verification problem++prop_maxRight :: Int -> [QC.NonNegative Int] -> QC.Property+prop_maxRight xRef xs_ =+  not (null xs_) QC.==> do+    let xs = VU.modify VAI.sort $ VU.fromList $ map (\(QC.NonNegative x) -> x) xs_+        expected = VU.length . VU.takeWhile (<= xRef) $ VU.scanl1' (+) xs+        res = runST $ do+          seg <- Seg.new @_ @() @(Sum Int) (2 * VU.length xs) 0 (VU.length xs)+          root <- Seg.newSeq seg $ VU.map Sum xs+          Seg.maxRight seg root (<= Sum xRef)+     in expected QC.=== res++tests :: [TestTree]+tests =+  [ QC.testProperty "randomTest" prop_randomTest,+    QC.testProperty "maxRight" prop_maxRight+  ]

@@ -0,0 +1,154 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ViewPatterns #-}++module Tests.Extra.DynSegTree where++import AtCoder.Extra.DynSegTree qualified as Seg+import AtCoder.ModInt qualified as M+import Control.Monad.ST (RealWorld, runST)+import Data.Foldable (for_)+import Data.Semigroup (Sum (..))+import Data.Vector.Algorithms.Intro qualified as VAI+import Data.Vector.Generic.Mutable qualified as VGM+import Data.Vector.Unboxed qualified as VU+import Data.Vector.Unboxed.Mutable qualified as VUM+import GHC.Stack (HasCallStack)+import Test.QuickCheck.Monadic as QCM+import Test.Tasty+import Test.Tasty.QuickCheck as QC+import Tests.Util++type Mint = M.ModInt998244353++modInt :: Int -> Mint+modInt = M.new++data Init = Init+  { n :: {-# UNPACK #-} !Int,+    q :: {-# UNPACK #-} !Int,+    refM :: !(IO (VUM.MVector RealWorld (Sum Mint))),+    segM :: !(IO (Seg.DynSegTree RealWorld (Sum Mint)))+  }++instance Show Init where+  show Init {..} = show n++initialProd :: Int -> Int -> Sum Mint+initialProd l r = Sum . modInt $ sum [l .. r - 1]++instance QC.Arbitrary Init where+  arbitrary = do+    n <- QC.chooseInt (1, 256)+    q <- QC.chooseInt (1, 5 * n)+    l0 <- QC.chooseInt (-256, 256)+    -- initial node values: l0, l0 + 1, l0 + 2, ..+    let cap = Seg.recommendedCapacity n q+    pure+      . Init n q (VUM.generate n (\i -> initialProd (i + l0) (i + l0 + 1)))+      $ Seg.buildWith cap l0 (l0 + n) initialProd++data Query+  = Write !Int !(Sum Mint)+  | Modify !Int !(Sum Mint)+  | ModifyM !Int !(Sum Mint)+  | Prod !(Int, Int)+  | AllProd+  | ResetInterval !(Int, Int)+  deriving (Show)++-- | Arbitrary return type for the `Query` result.+data Result+  = None+  | S !(Sum Mint)+  | F !(VU.Vector (Sum Mint))+  deriving (Show, Eq)++queryGen :: Int -> QC.Gen Query+queryGen n = do+  QC.oneof+    [ Write <$> k <*> v,+      Modify <$> k <*> v,+      ModifyM <$> k <*> v,+      Prod <$> i,+      pure AllProd,+      ResetInterval <$> i+    ]+  where+    k = QC.chooseInt (0, n - 1)+    v = Sum . modInt <$> QC.arbitrary+    i = intervalGen n++-- | containers. (referencial implementation)+handleRef :: Int -> VUM.MVector RealWorld (Sum Mint) -> Query -> IO Result+handleRef l0 vec q = case q of+  Write k v -> do+    VGM.write vec k v+    pure None+  Modify k v -> do+    VGM.modify vec (+ v) k+    pure None+  ModifyM k v -> do+    VGM.modify vec (+ v) k+    pure None+  Prod (!l, !r) -> do+    (S <$>) . VGM.foldl' (<>) mempty $ VGM.slice l (r - l) vec+  AllProd -> do+    S <$> VGM.foldl' (<>) mempty vec+  ResetInterval (!l, !r) -> do+    for_ [l .. r - 1] $ \i -> do+      VGM.write vec i $! initialProd (l0 + i) (l0 + i + 1)+    pure None++-- | ac-library-hs.+handleAcl :: (HasCallStack) => Seg.DynSegTree RealWorld (Sum Mint) -> Seg.Index -> Query -> IO Result+handleAcl seg root q = case q of+  Write (d -> k) v -> do+    Seg.write seg root k v+    pure None+  Modify (d -> k) v -> do+    Seg.modify seg root (+ v) k+    pure None+  ModifyM (d -> k) v -> do+    Seg.modifyM seg root (pure . (+ v)) k+    pure None+  Prod (d -> l, d -> r) -> do+    S <$> Seg.prod seg root l r+  AllProd -> do+    S <$> Seg.allProd seg root+  ResetInterval (d -> l, d -> r) -> do+    Seg.resetInterval seg root l r+    pure None+  where+    d = (+ Seg.l0Dst seg)++prop_randomTest :: Init -> QC.Property+prop_randomTest Init {..} = QCM.monadicIO $ do+  qs <- QCM.pick $ QC.vectorOf q (queryGen n)+  ref <- QCM.run refM+  seg <- QCM.run segM+  let l0 = Seg.l0Dst seg+  let bounds = (Seg.l0Dst seg, Seg.r0Dst seg)+  root <- QCM.run $ Seg.newRoot seg+  for_ qs $ \query -> do+    expected <- QCM.run $ handleRef l0 ref query+    res <- QCM.run $ handleAcl seg root query+    QCM.assertWith (expected == res) $ show (bounds, query, expected, res)++-- prop_foldl is tested with large array verification problem++prop_maxRight :: Int -> [QC.NonNegative Int] -> QC.Property+prop_maxRight xRef xs_ =+  not (null xs_) QC.==> do+    let xs = VU.modify VAI.sort $ VU.fromList $ map (\(QC.NonNegative x) -> x) xs_+        expected = VU.length . VU.takeWhile (<= xRef) $ VU.scanl1' (+) xs+        res = runST $ do+          seg <- Seg.new @_ @(Sum Int) (2 * VU.length xs) 0 (VU.length xs)+          root <- Seg.newSeq seg $ VU.map Sum xs+          Seg.maxRight seg root (<= Sum xRef)+     in expected QC.=== res++tests :: [TestTree]+tests =+  [ QC.testProperty "randomTest" prop_randomTest,+    QC.testProperty "maxRight" prop_maxRight+  ]

@@ -0,0 +1,159 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ViewPatterns #-}++-- | Same test with non-persistent version+module Tests.Extra.DynSegTree.Persistent where++import AtCoder.Extra.DynSegTree.Persistent qualified as Seg+import AtCoder.ModInt qualified as M+import Control.Monad.ST (RealWorld, runST)+import Data.Foldable (for_)+import Data.Semigroup (Sum (..))+import Data.Vector.Algorithms.Intro qualified as VAI+import Data.Vector.Generic.Mutable qualified as VGM+import Data.Vector.Unboxed qualified as VU+import Data.Vector.Unboxed.Mutable qualified as VUM+import GHC.Stack (HasCallStack)+import Test.QuickCheck.Monadic as QCM+import Test.Tasty+import Test.Tasty.QuickCheck as QC+import Tests.Util++type Mint = M.ModInt998244353++modInt :: Int -> Mint+modInt = M.new++data Init = Init+  { n :: {-# UNPACK #-} !Int,+    q :: {-# UNPACK #-} !Int,+    refM :: !(IO (VUM.MVector RealWorld (Sum Mint))),+    segM :: !(IO (Seg.DynSegTree RealWorld (Sum Mint)))+  }++instance Show Init where+  show Init {..} = show n++initialProd :: Int -> Int -> Sum Mint+initialProd l r = Sum . modInt $ sum [l .. r - 1]++instance QC.Arbitrary Init where+  arbitrary = do+    n <- QC.chooseInt (1, 256)+    q <- QC.chooseInt (1, 5 * n)+    l0 <- QC.chooseInt (-256, 256)+    -- initial node values: l0, l0 + 1, l0 + 2, ..+    let cap = Seg.recommendedCapacity n q+    pure+      . Init n q (VUM.generate n (\i -> initialProd (i + l0) (i + l0 + 1)))+      $ Seg.buildWith cap l0 (l0 + n) initialProd++data Query+  = Write !Int !(Sum Mint)+  | Modify !Int !(Sum Mint)+  | ModifyM !Int !(Sum Mint)+  | Prod !(Int, Int)+  | AllProd+  | ResetInterval !(Int, Int)+  deriving (Show)++-- | Arbitrary return type for the `Query` result.+data Result+  = None+  | S !(Sum Mint)+  | F !(VU.Vector (Sum Mint))+  deriving (Show, Eq)++queryGen :: Int -> QC.Gen Query+queryGen n = do+  QC.oneof+    [ Write <$> k <*> v,+      Modify <$> k <*> v,+      ModifyM <$> k <*> v,+      Prod <$> i,+      pure AllProd,+      ResetInterval <$> i+    ]+  where+    k = QC.chooseInt (0, n - 1)+    v = Sum . modInt <$> QC.arbitrary+    i = intervalGen n++-- | containers. (referencial implementation)+handleRef :: Int -> VUM.MVector RealWorld (Sum Mint) -> Query -> IO Result+handleRef l0 vec q = case q of+  Write k v -> do+    VGM.write vec k v+    pure None+  Modify k v -> do+    VGM.modify vec (+ v) k+    pure None+  ModifyM k v -> do+    VGM.modify vec (+ v) k+    pure None+  Prod (!l, !r) -> do+    (S <$>) . VGM.foldl' (<>) mempty $ VGM.slice l (r - l) vec+  AllProd -> do+    S <$> VGM.foldl' (<>) mempty vec+  ResetInterval (!l, !r) -> do+    for_ [l .. r - 1] $ \i -> do+      VGM.write vec i $! initialProd (l0 + i) (l0 + i + 1)+    pure None++-- | ac-library-hs.+handleAcl :: (HasCallStack) => Seg.DynSegTree RealWorld (Sum Mint) -> VUM.MVector RealWorld Seg.Index -> Query -> IO Result+handleAcl seg rootVec q = do+  root <- VGM.read rootVec 0+  case q of+    Write (d -> k) v -> do+      VGM.write rootVec 0 =<< Seg.write seg root k v+      VGM.write rootVec 0 =<< Seg.write seg root k v+      pure None+    Modify (d -> k) v -> do+      VGM.write rootVec 0 =<< Seg.modify seg root (+ v) k+      pure None+    ModifyM (d -> k) v -> do+      VGM.write rootVec 0 =<< Seg.modifyM seg root (pure . (+ v)) k+      pure None+    Prod (d -> l, d -> r) -> do+      S <$> Seg.prod seg root l r+    AllProd -> do+      S <$> Seg.allProd seg root+    ResetInterval (d -> l, d -> r) -> do+      VGM.write rootVec 0 =<< Seg.resetInterval seg root l r+      pure None+  where+    d = (+ Seg.l0Dst seg)++prop_randomTest :: Init -> QC.Property+prop_randomTest Init {..} = QCM.monadicIO $ do+  qs <- QCM.pick $ QC.vectorOf q (queryGen n)+  ref <- QCM.run refM+  seg <- QCM.run segM+  let l0 = Seg.l0Dst seg+  let bounds = (Seg.l0Dst seg, Seg.r0Dst seg)+  root <- QCM.run $ Seg.newRoot seg+  rootVec <- QCM.run $ VUM.replicate 1 root+  for_ qs $ \query -> do+    expected <- QCM.run $ handleRef l0 ref query+    res <- QCM.run $ handleAcl seg rootVec query+    QCM.assertWith (expected == res) $ show (bounds, query, expected, res)++-- prop_foldl is tested with large array verification problem++prop_maxRight :: Int -> [QC.NonNegative Int] -> QC.Property+prop_maxRight xRef xs_ =+  not (null xs_) QC.==> do+    let xs = VU.modify VAI.sort $ VU.fromList $ map (\(QC.NonNegative x) -> x) xs_+        expected = VU.length . VU.takeWhile (<= xRef) $ VU.scanl1' (+) xs+        res = runST $ do+          seg <- Seg.new @_ @(Sum Int) (2 * VU.length xs) 0 (VU.length xs)+          root <- Seg.newSeq seg $ VU.map Sum xs+          Seg.maxRight seg root (<= Sum xRef)+     in expected QC.=== res++tests :: [TestTree]+tests =+  [ QC.testProperty "randomTest" prop_randomTest,+    QC.testProperty "maxRight" prop_maxRight+  ]

@@ -0,0 +1,141 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ViewPatterns #-}++module Tests.Extra.DynSparseSegTree where++import AtCoder.Extra.DynSparseSegTree qualified as Seg+import AtCoder.ModInt qualified as M+import Control.Monad.ST (RealWorld, runST)+import Data.Foldable (for_)+import Data.Semigroup (Sum (..))+import Data.Vector.Algorithms.Intro qualified as VAI+import Data.Vector.Generic.Mutable qualified as VGM+import Data.Vector.Unboxed qualified as VU+import Data.Vector.Unboxed.Mutable qualified as VUM+import GHC.Stack (HasCallStack)+import Test.QuickCheck.Monadic as QCM+import Test.Tasty+import Test.Tasty.QuickCheck as QC+import Tests.Util++type Mint = M.ModInt998244353++modInt :: Int -> Mint+modInt = M.new++data Init = Init+  { n :: {-# UNPACK #-} !Int,+    q :: {-# UNPACK #-} !Int,+    refM :: !(IO (VUM.MVector RealWorld (Sum Mint))),+    segM :: !(IO (Seg.DynSparseSegTree RealWorld (Sum Mint)))+  }++instance Show Init where+  show Init {..} = show n++instance QC.Arbitrary Init where+  arbitrary = do+    n <- QC.chooseInt (1, 256)+    q <- QC.chooseInt (1, 5 * n)+    l0 <- QC.chooseInt (-256, 256)+    let cap = Seg.recommendedCapacity n q+    pure $ Init n q (VUM.replicate n mempty) (Seg.new cap l0 (l0 + n))++data Query+  = Write !Int !(Sum Mint)+  | Modify !Int !(Sum Mint)+  | ModifyM !Int !(Sum Mint)+  | Prod !(Int, Int)+  | AllProd+  deriving (Show)++-- | Arbitrary return type for the `Query` result.+data Result+  = None+  | S !(Sum Mint)+  | F !(VU.Vector (Sum Mint))+  deriving (Show, Eq)++queryGen :: Int -> QC.Gen Query+queryGen n = do+  QC.oneof+    [ Write <$> k <*> v,+      Modify <$> k <*> v,+      ModifyM <$> k <*> v,+      Prod <$> i,+      pure AllProd+    ]+  where+    k = QC.chooseInt (0, n - 1)+    v = Sum . modInt <$> QC.arbitrary+    i = intervalGen n++-- | containers. (referencial implementation)+handleRef :: VUM.MVector RealWorld (Sum Mint) -> Query -> IO Result+handleRef vec q = case q of+  Write k v -> do+    VGM.write vec k v+    pure None+  Modify k v -> do+    VGM.modify vec (+ v) k+    pure None+  ModifyM k v -> do+    VGM.modify vec (+ v) k+    pure None+  Prod (!l, !r) -> do+    (S <$>) . VGM.foldl' (<>) mempty $ VGM.slice l (r - l) vec+  AllProd -> do+    S <$> VGM.foldl' (<>) mempty vec++-- | ac-library-hs.+handleAcl :: (HasCallStack) => Seg.DynSparseSegTree RealWorld (Sum Mint) -> Seg.Handle RealWorld -> Query -> IO Result+handleAcl seg root q = case q of+  Write (d -> k) v -> do+    Seg.write seg root k v+    pure None+  Modify (d -> k) v -> do+    Seg.modify seg root (+ v) k+    pure None+  ModifyM (d -> k) v -> do+    Seg.modifyM seg root (pure . (+ v)) k+    pure None+  Prod (d -> l, d -> r) -> do+    S <$> Seg.prod seg root l r+  AllProd -> do+    S <$> Seg.allProd seg root+  where+    d = (+ Seg.l0Dsst seg)++prop_randomTest :: Init -> QC.Property+prop_randomTest Init {..} = QCM.monadicIO $ do+  qs <- QCM.pick $ QC.vectorOf q (queryGen n)+  ref <- QCM.run refM+  seg <- QCM.run segM+  let bounds = (Seg.l0Dsst seg, Seg.r0Dsst seg)+  -- FIXME: the root is null and not updated+  root <- QCM.run $ Seg.newRoot seg+  for_ qs $ \query -> do+    expected <- QCM.run $ handleRef ref query+    res <- QCM.run $ handleAcl seg root query+    QCM.assertWith (expected == res) $ show (bounds, query, expected, res)++-- prop_foldl is tested with large array verification problem++prop_maxRight :: Int -> [QC.NonNegative Int] -> QC.Property+prop_maxRight xRef xs_ =+  not (null xs_) QC.==> do+    let xs = VU.modify VAI.sort $ VU.fromList $ map (\(QC.NonNegative x) -> x) xs_+        expected = VU.length . VU.takeWhile (<= xRef) $ VU.scanl1' (+) xs+        res = runST $ do+          seg <- Seg.new @_ @(Sum Int) (2 * VU.length xs) 0 (VU.length xs)+          root <- Seg.newRoot seg+          VU.iforM_ xs $ \i x -> do+            Seg.write seg root i $ Sum x+          Seg.maxRight seg root (<= Sum xRef)+     in expected QC.=== res++tests :: [TestTree]+tests =+  [ QC.testProperty "randomTest" prop_randomTest,+    QC.testProperty "maxRight" prop_maxRight+  ]

@@ -0,0 +1,145 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ViewPatterns #-}++module Tests.Extra.DynSparseSegTree.Persistent where++import AtCoder.Extra.DynSparseSegTree.Persistent qualified as Seg+import AtCoder.ModInt qualified as M+import Control.Monad.ST (RealWorld, runST)+import Data.Foldable (for_)+import Data.Semigroup (Sum (..))+import Data.Vector.Algorithms.Intro qualified as VAI+import Data.Vector.Generic.Mutable qualified as VGM+import Data.Vector.Unboxed qualified as VU+import Data.Vector.Unboxed.Mutable qualified as VUM+import GHC.Stack (HasCallStack)+import Test.QuickCheck.Monadic as QCM+import Test.Tasty+import Test.Tasty.QuickCheck as QC+import Tests.Util++type Mint = M.ModInt998244353++modInt :: Int -> Mint+modInt = M.new++data Init = Init+  { n :: {-# UNPACK #-} !Int,+    q :: {-# UNPACK #-} !Int,+    refM :: !(IO (VUM.MVector RealWorld (Sum Mint))),+    segM :: !(IO (Seg.DynSparseSegTree RealWorld (Sum Mint)))+  }++instance Show Init where+  show Init {..} = show n++instance QC.Arbitrary Init where+  arbitrary = do+    n <- QC.chooseInt (1, 256)+    q <- QC.chooseInt (1, 5 * n)+    l0 <- QC.chooseInt (-256, 256)+    -- initial node values: l0, l0 + 1, l0 + 2, ..+    let cap = Seg.recommendedCapacity n q+    pure $ Init n q (VUM.replicate n 0) (Seg.new cap l0 (l0 + n))++data Query+  = Write !Int !(Sum Mint)+  | Modify !Int !(Sum Mint)+  | ModifyM !Int !(Sum Mint)+  | Prod !(Int, Int)+  | AllProd+  deriving (Show)++-- | Arbitrary return type for the `Query` result.+data Result+  = None+  | S !(Sum Mint)+  | F !(VU.Vector (Sum Mint))+  deriving (Show, Eq)++queryGen :: Int -> QC.Gen Query+queryGen n = do+  QC.oneof+    [ Write <$> k <*> v,+      Modify <$> k <*> v,+      ModifyM <$> k <*> v,+      Prod <$> i,+      pure AllProd+    ]+  where+    k = QC.chooseInt (0, n - 1)+    v = Sum . modInt <$> QC.arbitrary+    i = intervalGen n++-- | containers. (referencial implementation)+handleRef :: VUM.MVector RealWorld (Sum Mint) -> Query -> IO Result+handleRef vec q = case q of+  Write k v -> do+    VGM.write vec k v+    pure None+  Modify k v -> do+    VGM.modify vec (+ v) k+    pure None+  ModifyM k v -> do+    VGM.modify vec (+ v) k+    pure None+  Prod (!l, !r) -> do+    (S <$>) . VGM.foldl' (<>) mempty $ VGM.slice l (r - l) vec+  AllProd -> do+    S <$> VGM.foldl' (<>) mempty vec++-- | ac-library-hs.+handleAcl :: (HasCallStack) => Seg.DynSparseSegTree RealWorld (Sum Mint) -> VUM.MVector RealWorld Seg.Index -> Query -> IO Result+handleAcl seg rootVec q = do+  root <- VGM.read rootVec 0+  case q of+    Write (d -> k) v -> do+      VGM.write rootVec 0 =<< Seg.write seg root k v+      VGM.write rootVec 0 =<< Seg.write seg root k v+      pure None+    Modify (d -> k) v -> do+      VGM.write rootVec 0 =<< Seg.modify seg root (+ v) k+      pure None+    ModifyM (d -> k) v -> do+      VGM.write rootVec 0 =<< Seg.modifyM seg root (pure . (+ v)) k+      pure None+    Prod (d -> l, d -> r) -> do+      S <$> Seg.prod seg root l r+    AllProd -> do+      S <$> Seg.allProd seg root+  where+    d = (+ Seg.l0Dsst seg)++prop_randomTest :: Init -> QC.Property+prop_randomTest Init {..} = QCM.monadicIO $ do+  qs <- QCM.pick $ QC.vectorOf q (queryGen n)+  ref <- QCM.run refM+  seg <- QCM.run segM+  let bounds = (Seg.l0Dsst seg, Seg.r0Dsst seg)+  root <- QCM.run $ Seg.newRoot seg+  rootVec <- QCM.run $ VUM.replicate 1 root+  for_ qs $ \query -> do+    expected <- QCM.run $ handleRef ref query+    res <- QCM.run $ handleAcl seg rootVec query+    QCM.assertWith (expected == res) $ show (bounds, query, expected, res)++-- prop_foldl is tested with large array verification problem++prop_maxRight :: Int -> [QC.NonNegative Int] -> QC.Property+prop_maxRight xRef xs_ =+  not (null xs_) QC.==> do+    -- TODO: remove sort+    let xs = VU.modify VAI.sort $ VU.fromList $ map (\(QC.NonNegative x) -> x) xs_+        expected = VU.length . VU.takeWhile (<= xRef) $ VU.scanl1' (+) xs+        res = runST $ do+          seg <- Seg.new @_ @(Sum Int) (Seg.recommendedCapacity (VU.length xs) (VU.length xs)) 0 (VU.length xs)+          root0 <- Seg.newRoot seg+          root <- VU.ifoldM' (Seg.write seg) root0 $ VU.map Sum xs+          Seg.maxRight seg root (<= Sum xRef)+     in expected QC.=== res++tests :: [TestTree]+tests =+  [ QC.testProperty "randomTest" prop_randomTest,+    QC.testProperty "maxRight" prop_maxRight+  ]

@@ -14,6 +14,7 @@ import Data.List qualified as L import Data.Semigroup (Sum (..)) import Data.Sequence qualified as S+import Data.Vector.Algorithms.Intro qualified as VAI import Data.Vector.Generic.Mutable qualified as VGM import Data.Vector.Unboxed qualified as VU import Data.Vector.Unboxed.Mutable qualified as VUM@@ -326,10 +327,31 @@     i4 <- VGM.read lastRight2 0     pure . QC.conjoin $ map (QC.=== k) [i1, i2, i3, i4] +prop_newSeq :: [Int] -> QC.Property+prop_newSeq xs_ = do+  let xs = VU.fromList xs_+      ys = runST $ do+        s <- Seq.new $ VU.length xs+        root <- Seq.newSeq @_ @() @(Sum Int) s $ VU.map Sum xs+        VU.map getSum <$> Seq.freeze s root+   in xs QC.=== ys++prop_lowerBound :: Int -> [Int] -> QC.Property+prop_lowerBound xRef xs_ = do+  let xs = VU.modify VAI.sort $ VU.fromList xs_+      expected = VU.length $ VU.takeWhile (<= xRef) xs+      res = runST $ do+        s <- Seq.new $ VU.length xs+        root <- Seq.newSeq @_ @() @(Sum Int) s $ VU.map Sum xs+        Seq.ilowerBound s root (\_ x -> x <= Sum xRef)+   in expected QC.=== res+ tests :: [TestTree] tests =   [ unit_empty,     unsafePerformIO spec_boundaries,     QC.testProperty "random test" prop_randomTest,-    QC.testProperty "bisect index" prop_bisectIndex+    QC.testProperty "bisect index" prop_bisectIndex,+    QC.testProperty "newSeq preserves the ordering" prop_newSeq,+    QC.testProperty "lowerBound" prop_lowerBound   ]

@@ -0,0 +1,283 @@+{-# LANGUAGE RecordWildCards #-}++module Tests.Extra.Seq.Map (tests) where++import AtCoder.Extra.Monoid.Affine1 (Affine1 (..))+import AtCoder.Extra.Monoid.Affine1 qualified as Affine1+import AtCoder.Extra.Seq.Map qualified as Map+import AtCoder.LazySegTree (SegAct (..))+import Control.Monad (foldM_)+import Control.Monad.Primitive (PrimMonad, PrimState)+import Control.Monad.ST (RealWorld, runST)+import Data.List qualified as L+import Data.Map qualified as M+import Data.Semigroup (Sum (..))+import Data.Vector.Algorithms.Intro qualified as VAI+import Data.Vector.Unboxed qualified as VU+import Test.Hspec+import Test.QuickCheck.Monadic as QCM+import Test.Tasty+import Test.Tasty.QuickCheck as QC+import Tests.Util (intervalGen)+import Prelude hiding (seq)++data Init = Init+  { q :: {-# UNPACK #-} !Int,+    ref0 :: !(M.Map Int (Sum Int)),+    mapM :: !(IO (Map.Map RealWorld (Affine1 Int) Int (Sum Int)))+  }++instance Show Init where+  show Init {..} = show ref0++instance QC.Arbitrary Init where+  arbitrary = do+    q <- QC.chooseInt (1, 640)+    pure $ Init q M.empty $ Map.new q++data Query+  = Reset+  | Capacity+  | Size+  | Member !Int+  | Adjust !Int !(Sum Int)+  | Insert !Int !(Sum Int)+  | InsertWith !Int !(Sum Int)+  | Delete !Int+  | Delete_ !Int+  | Prod !(Int, Int)+  | ProdMaybe !(Int, Int)+  | ProdAll+  | ApplyIn !(Int, Int) !(Affine1 Int)+  | ApplyAll !(Affine1 Int)+  | LookupLE !Int+  | LookupLT !Int+  | LookupGE !Int+  | LookupGT !Int+  | ReadAt !Int+  | ReadMaybeAt !Int+  | WriteAt !Int !(Sum Int)+  | ExchangeAt !Int !(Sum Int)+  | ProdInInterval !(Int, Int)+  | ApplyInInterval !(Int, Int) !(Affine1 Int)+  -- | ILowerBound !(Sum Int)+  -- | ILowerBoundM !(Sum Int)+  | ILowerBoundProd !(Sum Int)+  | ILowerBoundProdM !(Sum Int)+  | Freeze+  deriving (Show)++-- | Arbitrary return type for the `Query` result.+data Result+  = None+  | B !Bool+  | I !Int+  | S !(Sum Int)+  | MKV !(Maybe (Int, Sum Int))+  | MS !(Maybe (Sum Int))+  | F !(VU.Vector (Int, Sum Int))+  deriving (Show, Eq)++queryGen :: Int -> QC.Gen Query+queryGen n = do+  QC.frequency $+    [ (rare, pure Reset),+      (rare, pure Capacity),+      (rare, pure Size),+      (often, Member <$> keyGen),+      (often, Adjust <$> keyGen <*> valGen),+      (half, Insert <$> keyGen <*> valGen),+      (half, InsertWith <$> keyGen <*> valGen),+      (half, Delete <$> keyGen),+      (half, Delete_ <$> keyGen),+      (half, Prod <$> keyGen2),+      (half, (ProdMaybe .) . (,) <$> keyGen <*> keyGen),+      (half, pure ProdAll),+      (often, ApplyIn <$> keyGen2 <*> fGen),+      (often, ApplyAll <$> fGen),+      (half, LookupLE <$> keyGen),+      (half, LookupLT <$> keyGen),+      (half, LookupGE <$> keyGen),+      (half, LookupGT <$> keyGen),+      -- (half, ReadAt <$> iGen),+      (half, ReadMaybeAt <$> maybeIGen),+      -- (half, WriteAt <$> iGen <*> valGen),+      -- (half, ExchangeAt <$> iGen <*> valGen),+      (half, ProdInInterval <$> intervalGen n),+      (often, ApplyInInterval <$> intervalGen n <*> fGen),+      (half, ILowerBoundProd <$> valGen),+      (half, ILowerBoundProdM <$> valGen),+      (rare, pure Freeze)+    ]+      ++ if n == 0+        then []+        else+          [ (half, ReadAt <$> iGen),+            (half, WriteAt <$> iGen <*> valGen),+            (half, ExchangeAt <$> iGen <*> valGen)+          ]+  where+    rare = 1+    often = 10+    half = 5+    keyGen = QC.chooseInt (-30, 30)+    keyGen2 = do+      l <- QC.chooseInt (-30, 30)+      r <- QC.chooseInt (l, 30)+      pure (l, r)+    -- use non-negative values for monotoniously increasing sum+    valGen = Sum <$> QC.chooseInt (0, 10)+    -- NOTE: it might throw an error on overflow:+    fGen = Affine1.new <$> QC.chooseInt (0, 4) <*> QC.chooseInt (0, 4)+    iGen = QC.chooseInt (0, n - 1)+    maybeIGen = QC.chooseInt (-1, n)++-- | containers. (referencial implementation)+handleRef :: Int -> M.Map Int (Sum Int) -> Query -> (M.Map Int (Sum Int), Result)+handleRef capacity m q = case q of+  Reset -> (M.empty, None)+  Capacity -> (m, I capacity)+  Size -> (m, I (M.size m))+  Member k -> (m, B (M.member k m))+  Adjust k v -> (M.adjust (+ v) k m, None)+  Insert k v -> (M.insert k v m, None)+  InsertWith k v -> (M.insertWith (+) k v m, None)+  Delete k -> (M.delete k m, MS $ M.lookup k m)+  Delete_ k -> (M.delete k m, None)+  Prod (!l, !r) -> (m, S $ prod l r)+  ProdMaybe (!l, !r)+    | l > r -> (m, MS Nothing)+    | otherwise -> (m, MS . Just $ prod l r)+  ProdAll -> (m, S $ M.foldl' (<>) mempty m)+  ApplyIn (!l, !r) f -> (apply l r f, None)+  ApplyAll f -> (M.map (segAct f) m, None)+  LookupLE k -> (m, MKV $ M.lookupLE k m)+  LookupLT k -> (m, MKV $ M.lookupLT k m)+  LookupGE k -> (m, MKV $ M.lookupGE k m)+  LookupGT k -> (m, MKV $ M.lookupGT k m)+  ReadAt i -> (m, S . snd $ M.elemAt i m)+  ReadMaybeAt i+    | 0 <= i && i < M.size m -> (m, MS $ snd <$> M.lookupMin (M.drop i m))+    | otherwise -> (m, MS Nothing)+  WriteAt i x -> (M.updateAt (\_ _ -> Just x) i m, None)+  ExchangeAt i x -> (M.updateAt (\_ _ -> Just x) i m, S (snd (M.elemAt i m)))+  ProdInInterval (!l, !r) -> (m, S (prodIn l r))+  ApplyInInterval (!l, !r) f -> (applyIn l r f, None)+  ILowerBoundProd v -> (m, lbProd v)+  ILowerBoundProdM v -> (m, lbProd v)+  Freeze -> (m, F (VU.fromList (M.assocs m)))+  where+    slice l r = M.takeWhileAntitone (< r) . M.dropWhileAntitone (< l)+    prod l r = M.foldl' (<>) mempty $ slice l r m+    apply l r f = M.mapWithKey (\k x -> if l <= k && k < r then segAct f x else x) m+    prodIn l r =+      L.foldl' (<>) mempty+        . map snd+        . filter (\(!i, !_) -> l <= i && i < r)+        . zip [0 :: Int ..]+        $ M.elems m+    applyIn l r f =+      M.fromList+        . zipWith+          (\i (!k, !x) -> if l <= i && i < r then (k, segAct f x) else (k, x))+          [0 :: Int ..]+        $ M.assocs m+    -- lb x = I . length . takeWhile (<= x) $ M.elems m+    lbProd x = I . length . takeWhile (<= x) . tail . L.scanl' (<>) mempty $ M.elems m++-- | ac-library-hs.+handleAcl :: (HasCallStack, PrimMonad m) => Map.Map (PrimState m) (Affine1 Int) Int (Sum Int) -> Query -> m Result+handleAcl m q = case q of+  Reset -> do+    Map.reset m+    pure None+  Capacity -> do+    pure . I $ Map.capacity m+  Size -> do+    I <$> Map.size m+  Insert k v -> do+    Map.insert m k v+    pure None+  InsertWith k v -> do+    Map.insertWith m (+) k v+    pure None+  Adjust k v -> do+    Map.adjust m (+ v) k+    pure None+  Delete k -> do+    MS <$> Map.delete m k+  Delete_ k -> do+    Map.delete_ m k+    pure None+  Prod (!l, !r) -> do+    S <$> Map.prod m l r+  ProdMaybe (!l, !r) -> do+    MS <$> Map.prodMaybe m l r+  ProdAll -> do+    S <$> Map.allProd m+  ApplyIn (!l, !r) f -> do+    Map.applyIn m l r f+    pure None+  ApplyAll f -> do+    Map.applyAll m f+    pure None+  Member k -> do+    B <$> Map.member m k+  LookupLE v -> do+    MKV <$> Map.lookupLE m v+  LookupLT v -> do+    MKV <$> Map.lookupLT m v+  LookupGE v -> do+    MKV <$> Map.lookupGE m v+  LookupGT v -> do+    MKV <$> Map.lookupGT m v+  ReadAt i -> do+    S <$> Map.readAt m i+  ReadMaybeAt i -> do+    MS <$> Map.readMaybeAt m i+  WriteAt i x -> do+    Map.writeAt m i x+    pure None+  ExchangeAt i x -> do+    S <$> Map.exchangeAt m i x+  ProdInInterval (!l, !r) -> do+    S <$> Map.prodInInterval m l r+  ApplyInInterval (!l, !r) f -> do+    Map.applyInInterval m l r f+    pure None+  ILowerBoundProd xRef -> do+    I <$> Map.ilowerBoundProd m (\_ x -> x <= xRef)+  ILowerBoundProdM xRef -> do+    I <$> Map.ilowerBoundProdM m (\_ x -> pure (x <= xRef))+  Freeze -> do+    F <$> Map.freeze m++prop_randomTest :: Init -> QC.Property+prop_randomTest Init {..} = QCM.monadicIO $ do+  m <- QCM.run mapM+  foldM_+    ( \ref _ -> do+        query <- QCM.pick (queryGen (M.size ref))+        -- run the query+        let (!ref', !expected) = handleRef q ref query+        res <- QCM.run $ handleAcl m query+        QCM.assertWith (expected == res) $ show (query, expected, res)+        pure ref'+    )+    ref0+    [0 .. q - 1]++prop_build :: [Int] -> QC.Property+prop_build ks_ =+  let ks = VU.fromList ks_+      expected = VU.modify VAI.sort ks+      res = runST $ do+        m <- Map.build @_ @() @Int @() (VU.length ks) $ VU.map (,()) ks+        VU.map fst <$> Map.freeze m+   in expected QC.=== res++tests :: [TestTree]+tests =+  [ QC.testProperty "random test" prop_randomTest,+    QC.testProperty "build" prop_build+  ]

@@ -93,6 +93,7 @@   (@?= Max 5) =<< LST.allProd seg   LST.applyAt seg 2 $ Sum (-10)   (@?= Max (-5)) =<< LST.prod seg 2 3+  (@?= Max 5) =<< LST.allProd seg   (@?= Max 0) =<< LST.prod seg 2 4  unit_prodMaybeBounds :: TestTree