ac-library-hs 1.2.4.0 → 1.2.5.0

raw patch · 6 files changed

+443/−11 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +15/−10
• ac-library-hs.cabal +4/−1
• src/AtCoder/Extra/Mo.hs +150/−0
• src/AtCoder/Extra/SqrtDecomposition.hs +199/−0
• test/Main.hs +2/−0
• test/Tests/Extra/Ix0.hs +73/−0

@@ -1,8 +1,13 @@ # Revision history for acl-hs +## 1.2.5.0 -- April 2025++- Added AtCoder.`Extra.Mo`+- Added AtCoder.`Extra.SqrtDecomposition`+ ## 1.2.4.0 -- April 2025 -- Added `Dsu.mergeMaybe`+- Added `AtCoder.Dsu.mergeMaybe` - Added `AtCoder.Extra.Graph` functions   - `rev`   - `connectedComponents`@@ -16,7 +21,7 @@  ## 1.2.3.0 -- March 2025 -- Added `Extra.SegTree2d` and `Extra.SegTree2d.Dense`.+- Added `AtCoder.Extra.SegTree2d` and `Extra.SegTree2d.Dense`.  ## 1.2.2.1 -- March 2025 @@ -24,16 +29,16 @@  ## 1.2.2.0 -- Feb 2025 -- Added `Extra.KdTree` and `Extra.LazyKdTree`.+- Added `AtCoder.Extra.KdTree` and `Extra.LazyKdTree`. - Added `clear` function to the dynamic segment tree family.-- Fixed `Extra.Hld.new` for a tree with a single vertex.+- Fixed AtCoder.`Extra.Hld.new` for a tree with a single vertex.  ## 1.2.1.0 -- Feb 2025  - Added dynamic segment tree family.-- Added `Extra.Seq.Map`.-- Fixed `Extra.Pool.size`.-- `Handle` is moved from `Extra.Seq` to `Extra.Pool`.+- Added `AtCoder.Extra.Seq.Map`.+- Fixed `AtCoder.Extra.Pool.size`.+- `Handle` is moved from `AtCoder.Extra.Seq` to `AtCoder.Extra.Pool`.  ## 1.2.0.0 -- Feb 2025 @@ -41,9 +46,9 @@ - Tweaked `INLINE` settings for less compile time. - Breaking changes:   - `Matrix.diag` now does not take length parameter.-  - `Extra.Math.primitiveRoot` is renamed to `primitiveRoot32`.+  - `AtCoder.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.+  - `SegAct` implementation for `AtCoder.Extra.Monoid.RangeAdd` over `Max` and `Min` were fixed.  ## 1.1.1.0 -- Jan 2025 @@ -64,5 +69,5 @@  - First version. - Added ACL-compatible modules.-- Added Extra module of `Math` (binary exponentiation) and `Monoid` (`SegAct` instances).+- Added `AtCoder.Extra.Math` (binary exponentiation) and `AtCoder.Extra.Monoid` (`SegAct` instances). 

@@ -4,7 +4,7 @@ -- PVP summary:  +-+------- breaking API changes --               | | +----- non-breaking API additions --               | | | +--- code changes with no API change-version:         1.2.4.0+version:         1.2.5.0 synopsis:        Data structures and algorithms description:   Haskell port of [ac-library](https://github.com/atcoder/ac-library), a library for competitive@@ -70,6 +70,7 @@     AtCoder.Extra.KdTree     AtCoder.Extra.LazyKdTree     AtCoder.Extra.Math+    AtCoder.Extra.Mo     AtCoder.Extra.Monoid     AtCoder.Extra.Monoid.Affine1     AtCoder.Extra.Monoid.Mat2x2@@ -87,6 +88,7 @@     AtCoder.Extra.Seq     AtCoder.Extra.Seq.Map     AtCoder.Extra.Seq.Raw+    AtCoder.Extra.SqrtDecomposition     AtCoder.Extra.Tree     AtCoder.Extra.Tree.Hld     AtCoder.Extra.Tree.Lct@@ -149,6 +151,7 @@     Tests.Extra.IntervalMap     Tests.Extra.IntMap     Tests.Extra.IntSet+    Tests.Extra.Ix0     Tests.Extra.KdTree     Tests.Extra.LazyKdTree     Tests.Extra.Math

@@ -0,0 +1,150 @@+-- | Mo's algorithm for handling \([l, r)\) offline queries in \(O((n + q) \sqrt n f)\) time+-- complecity, where \(n\) is the length of index, \(q\) is the number of queries and \(f\) is the+-- time for processing element addition or deletion. Due to the high time complexity, it is+-- recommended to choose an efficient data structure such as Fenwick Tree for query processing.+--+-- @since 1.2.5.0+module AtCoder.Extra.Mo+  ( run,+    sortIndices,+    process,+  )+where++import Control.Monad (when)+import Control.Monad.Primitive (PrimMonad)+import Data.Bool (bool)+import Data.Foldable (for_)+import Data.Vector.Algorithms.Intro qualified as VAI+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)++-- | \(O((n + q) \sqrt n)\) Runs Mo's algorithm. Internally it's a call of `sortIndices` and+-- `process`.+--+-- @since 1.2.5.0+{-# INLINE run #-}+run ::+  (HasCallStack, PrimMonad m, VU.Unbox a) =>+  -- | Defines index bounds \([0, n)\).+  Int ->+  -- | Query intervals \([l, r)\).+  VU.Vector (Int, Int) ->+  -- | Called on adding left index \(l\).+  (Int -> m ()) ->+  -- | Called on adding left index \(r\).+  (Int -> m ()) ->+  -- | Called on deleting left index \(l\).+  (Int -> m ()) ->+  -- | Called on deleting right index \(r\).+  (Int -> m ()) ->+  -- | Returns result for query index \(i\).+  (Int -> m a) ->+  -- | Result for each query.+  m (VU.Vector a)+run n !lrs !addL !addR !delL !delR !query = do+  let !is = sortIndices n lrs+  process is lrs addL addR delL delR query++-- | \(O(n (\log n))\) Sorts indices of \([l, r)\) queries in an efficient order for processing.+--+-- @since 1.2.5.0+{-# INLINEABLE sortIndices #-}+sortIndices ::+  (HasCallStack) =>+  -- | Defines index bounds \([0, n)\).+  Int ->+  -- | Query intervals \([l, r)\).+  VU.Vector (Int, Int) ->+  -- | Sorted indices to the query intervals.+  VU.Vector Int+sortIndices n !lrs+  | VU.null lrs = VU.empty+  | otherwise = VU.create $ do+      let !q = VU.length lrs+      let !blockLen :: Int = max 1 $ round (sqrt 3 * fromIntegral n / sqrt (fromIntegral (2 * q)) :: Double)+      is <- VUM.generate q id++      -- sort by block index then right:+      VAI.sortBy+        ( \i1 i2 -> do+            let (!l1, !r1) = lrs VG.! i1+                (!l2, !r2) = lrs VG.! i2+                !b1 = l1 `div` blockLen+                !b2 = l2 `div` blockLen+                !res = compare b1 b2 <> bool (compare r2 r1) (compare r1 r2) (even b1)+             in res+        )+        is++      -- The following trick doesn't seem to make it faster though?++      let -- {-# INLINE cost #-}+          cost i1 i2 = do+            (!l1, !r1) <- (lrs VG.!) <$> VGM.read is i1+            (!l2, !r2) <- (lrs VG.!) <$> VGM.read is i2+            pure $ abs (l1 - l2) + abs (r1 - r2)++      when (q > 6) $ do+        for_ [0 .. q - 6] $ \k -> do+          do+            c1 <- cost k (k + 2)+            c2 <- cost (k + 1) (k + 3)+            c3 <- cost k (k + 1)+            c4 <- cost (k + 2) (k + 3)+            when (c1 + c2 < c3 + c4) $ do+              VGM.swap is (k + 1) (k + 2)+          do+            c1 <- cost k (k + 3)+            c2 <- cost (k + 1) (k + 4)+            c3 <- cost k (k + 1)+            c4 <- cost (k + 3) (k + 4)+            when (c1 + c2 < c3 + c4) $ do+              VGM.swap is (k + 1) (k + 3)++      pure is++-- | \(O((n + q) \sqrt n)\) Processes \([l, r)\) interval queries. User would usually use `run`+-- instead.+--+-- @since 1.2.5.0+{-# INLINEABLE process #-}+process ::+  (HasCallStack, PrimMonad m, VU.Unbox a) =>+  -- | Sorted indices to query intervals \([l, r)\).+  VU.Vector Int ->+  -- | Query intervals \([l, r)\).+  VU.Vector (Int, Int) ->+  -- | Called on adding left index \(l\).+  (Int -> m ()) ->+  -- | Called on adding right index \(r\).+  (Int -> m ()) ->+  -- | Called on deleting left index \(l\).+  (Int -> m ()) ->+  -- | Called on deleting right index \(r\).+  (Int -> m ()) ->+  -- | Returns result for query index \(i\).+  (Int -> m a) ->+  -- | Result for each query.+  m (VU.Vector a)+process !is !lrs !addL !addR !delL !delR !query = do+  let !q = VU.length lrs+  !result <- VUM.unsafeNew q++  VU.foldM'_+    ( \(!l0, !r0) i -> do+        let (!l, !r) = lrs VG.! i+        for_ [l0 - 1, l0 - 2 .. l] addL+        for_ [r0, r0 + 1 .. r - 1] addR+        for_ [l0, l0 + 1 .. l - 1] delL+        for_ [r0 - 1, r0 - 2 .. r] delR+        VGM.unsafeWrite result i =<< query i+        pure (l, r)+    )+    (0 :: Int, 0 :: Int)+    is++  VU.unsafeFreeze result

@@ -0,0 +1,199 @@+-- | Square root decomposition is a technique that divides a sequence of values into around+-- \(\sqrt n\) blocks, aggregating the state information for each block. It allows user to process+-- interval query block by block, typically in \(O(\sqrt n)\) time, where a whole block processing+-- take \(O(1)\) time and partial block processing take \(O(\sqrt n)\) time.+--+-- For simplicity, in this document, we assume that highder order functions applided to an entier+-- block (@readFull@ and @actFull@) work in \(O(1)\) time, and those applied to a part of block work+-- in \(O(\sqrt n)\) time. In total, \(q\) query processing takes \(O(q \sqrt n)\) time. Note that+-- it's a rather large number and often requires performance tuning.+--+-- ==== Lazy propagation+-- Typiaclly, an action to a whole block can be delayed; store the aggregation value for the block,+-- delay the internal sequence update, and restore them when part of the block is accessed. Such+-- lazy propagation should be handled on the user side on partial block access functions+-- (@foldPart@ or @actPart@) are called.+--+-- @since 1.2.5.0+module AtCoder.Extra.SqrtDecomposition+  ( -- | These function signatures try to resemble those for lists.+    forM_,+    foldMapM,+    foldMapWithM,+    foldM,+    foldM_,+  )+where++import AtCoder.Internal.Assert qualified as ACIA+import Control.Monad (when)+import Data.Foldable (for_)+import Data.Vector.Unboxed qualified as VU++-- INLINE all the functions, even if the performance gain is just a little bit.++-- | \(O(\sqrt n)\) Runs user function for each block.+{-# INLINE forM_ #-}+forM_ ::+  (Monad m) =>+  -- | Context: block length.+  Int ->+  -- | Function: @actFull@ function that takes target block index.+  (Int -> m ()) ->+  -- | Function: @actPart@ function that takes target block index, left index and right index.+  (Int -> Int -> Int -> m ()) ->+  -- | Input: \(l\).+  Int ->+  -- | Input: \(r\).+  Int ->+  -- | Unit.+  m ()+forM_ !blockLen !actFull !actPart !l !r = do+  let !_ = ACIA.runtimeAssert (l <= r) "AtCoder.Extra.SqrtDecomposition.forM_: `l <= r` must hold"+  let (!il, !remL) = l `divMod` blockLen+  let (!ir, !remR) = r `divMod` blockLen+  if il == ir+    then do+      when (remR > remL) $ do+        actPart il l r+    else do+      if remL == 0+        then actFull il+        else actPart il l (l - remL + blockLen)+      for_ [il + 1 .. ir - 1] $ \iBlock -> do+        actFull iBlock+      when (remR > 0) $ do+        actPart ir (r - remR) r++-- | \(O(\sqrt n)\) Runs user function for each block and concatanate their monoid output.+--+-- @since 1.2.5.0+{-# INLINE foldMapM #-}+foldMapM ::+  (Monad m, Monoid a) =>+  -- | Context: block length.+  Int ->+  -- | Function: @readFull@ function that takes target block index and returns monoid value of it.+  (Int -> m a) ->+  -- | Function: @readPart@ function that takes target block index, left index and right index, and+  -- returns monoid value for it.+  (Int -> Int -> Int -> m a) ->+  -- | Input: \(l\).+  Int ->+  -- | Input: \(r\).+  Int ->+  -- | Concatenated output.+  m a+foldMapM blockLen = foldMapWithM blockLen (<>)++-- | \(O(\sqrt n)\) Runs user function for each block and concatanates their output with user+-- function.+--+-- @since 1.2.5.0+{-# INLINE foldMapWithM #-}+foldMapWithM ::+  (Monad m) =>+  -- | Context: block length.+  Int ->+  -- | Merges function for output values.+  (a -> a -> a) ->+  -- | Function: @readFull@ function that takes target block index and returns monoid value of it.+  (Int -> m a) ->+  -- | Function: @readPart@ function that takes target block index, left index and right index, and+  -- returns output value of it.+  (Int -> Int -> Int -> m a) ->+  -- | Input: \(l\).+  Int ->+  -- | Input: \(r\).+  Int ->+  -- | Concatenated output.+  m a+foldMapWithM !blockLen !merge !readFull !readPart !l !r = do+  let !_ = ACIA.runtimeAssert (l <= r) "AtCoder.Extra.SqrtDecomposition.foldMapWithM: `l <= r` must hold"+  let (!il, !remL) = l `divMod` blockLen+  let (!ir, !remR) = r `divMod` blockLen+  if il == ir+    then do+      readPart il l r+    else do+      !sx <-+        if remL == 0+          then readFull il+          else readPart il l (l - remL + blockLen)+      !sm <-+        VU.foldM'+          (\ !acc iBlock -> merge acc <$> readFull iBlock)+          sx+          $ VU.generate (ir - 1 - il) (+ (il + 1))+      if remR == 0+        then pure sm+        else do+          rx <- readPart ir (r - remR) r+          pure $! merge sm rx++-- | \(O(\sqrt n)\) Runs user function for each block, performing left folding.+--+-- @since 1.2.5.0+{-# INLINE foldM #-}+foldM ::+  (Monad m) =>+  -- | Context: block length.+  Int ->+  -- | Function: @foldFull@ function that takes target block index and returns monoid value of it.+  (a -> Int -> m a) ->+  -- | Function: @foldPart@ function that takes target block index, left and right local index and returns monoid+  -- value of it.+  (a -> Int -> Int -> Int -> m a) ->+  -- | Initial folding value.+  a ->+  -- | Input: \(l\).+  Int ->+  -- | Input: \(r\).+  Int ->+  -- | Folding result.+  m a+foldM !blockLen !foldFull !foldPart !s0 !l !r = do+  let !_ = ACIA.runtimeAssert (l <= r) "AtCoder.Extra.SqrtDecomposition.foldM: `l <= r` must hold"+  let (!il, !remL) = l `divMod` blockLen+  let (!ir, !remR) = r `divMod` blockLen+  if il == ir+    then do+      foldPart s0 il l r+    else do+      !sx <-+        if remL == 0+          then foldFull s0 il+          else foldPart s0 il l (l - remL + blockLen)+      !sm <-+        VU.foldM'+          foldFull+          sx+          $ VU.generate (ir - 1 - il) (+ (il + 1))+      if remR == 0+        then pure sm+        else foldPart sm ir (r - remR) r++-- | \(O(\sqrt n)\) `foldM` with return value discarded.+--+-- @since 1.2.5.0+{-# INLINE foldM_ #-}+foldM_ ::+  (Monad m) =>+  -- | Context: Block length.+  Int ->+  -- | @readFull@ function that takes target block index and returns monoid value of it.+  (a -> Int -> m a) ->+  -- | @readPart@ function that takes target block index, left and right local index and returns monoid+  -- value of it.+  (a -> Int -> Int -> Int -> m a) ->+  -- | Initial folding value.+  a ->+  -- | Input: \(l\).+  Int ->+  -- | Input: \(r\).+  Int ->+  -- | Unit.+  m ()+foldM_ !blockLen !readFull !readPart !s0 !l !r = do+  _ <- foldM blockLen readFull readPart s0 l r+  pure ()

@@ -16,6 +16,7 @@ import Tests.Extra.IntMap qualified import Tests.Extra.IntSet qualified import Tests.Extra.IntervalMap qualified+import Tests.Extra.Ix0 qualified import Tests.Extra.KdTree qualified import Tests.Extra.LazyKdTree qualified import Tests.Extra.Math qualified@@ -68,6 +69,7 @@             testGroup "Graph" Tests.Extra.Graph.tests,             testGroup "HashMap" Tests.Extra.HashMap.tests,             testGroup "IntervalMap" Tests.Extra.IntervalMap.tests,+            testGroup "Ix0" Tests.Extra.Ix0.tests,             testGroup "IntMap" Tests.Extra.IntMap.tests,             testGroup "IntSet" Tests.Extra.IntSet.tests,             testGroup "KdTree" Tests.Extra.KdTree.tests,

@@ -0,0 +1,73 @@+module Tests.Extra.Ix0 where++import AtCoder.Extra.Ix0+import Test.Tasty+import Test.Tasty.QuickCheck as QC++prop_ix1 :: QC.Gen QC.Property+prop_ix1 = do+  d1 <- QC.chooseInt (1, 10)+  let expected = [0 .. d1 - 1]+  let res = [index0 d1 x1 | x1 <- [0 .. d1 - 1]]+  pure $ res QC.=== expected++prop_ix2 :: QC.Gen QC.Property+prop_ix2 = do+  d2 <- QC.chooseInt (1, 10)+  d1 <- QC.chooseInt (1, 10)+  let expected = [0 .. d2 * d1 - 1]+  let res = [index0 (d2, d1) (x2, x1) | x2 <- [0 .. d2 - 1], x1 <- [0 .. d1 - 1]]+  pure $ res QC.=== expected++prop_ix3 :: QC.Gen QC.Property+prop_ix3 = do+  d3 <- QC.chooseInt (1, 10)+  d2 <- QC.chooseInt (1, 10)+  d1 <- QC.chooseInt (1, 10)+  let expected = [0 .. d3 * d2 * d1 - 1]+  let res = [index0 (d3, d2, d1) (x3, x2, x1) | x3 <- [0 .. d3 - 1], x2 <- [0 .. d2 - 1], x1 <- [0 .. d1 - 1]]+  pure $ res QC.=== expected++prop_ix4 :: QC.Gen QC.Property+prop_ix4 = do+  d4 <- QC.chooseInt (1, 10)+  d3 <- QC.chooseInt (1, 10)+  d2 <- QC.chooseInt (1, 10)+  d1 <- QC.chooseInt (1, 10)+  let expected = [0 .. d4 * d3 * d2 * d1 - 1]+  let res = [index0 (d4, d3, d2, d1) (x4, x3, x2, x1) | x4 <- [0 .. d4 - 1], x3 <- [0 .. d3 - 1], x2 <- [0 .. d2 - 1], x1 <- [0 .. d1 - 1]]+  pure $ res QC.=== expected++prop_ix5 :: QC.Gen QC.Property+prop_ix5 = do+  d5 <- QC.chooseInt (1, 10)+  d4 <- QC.chooseInt (1, 10)+  d3 <- QC.chooseInt (1, 10)+  d2 <- QC.chooseInt (1, 10)+  d1 <- QC.chooseInt (1, 10)+  let expected = [0 .. d5 * d4 * d3 * d2 * d1 - 1]+  let res = [index0 (d5, d4, d3, d2, d1) (x5, x4, x3, x2, x1) | x5 <- [0 .. d5 - 1], x4 <- [0 .. d4 - 1], x3 <- [0 .. d3 - 1], x2 <- [0 .. d2 - 1], x1 <- [0 .. d1 - 1]]+  pure $ res QC.=== expected++prop_ix6 :: QC.Gen QC.Property+prop_ix6 = do+  d6 <- QC.chooseInt (1, 10)+  d5 <- QC.chooseInt (1, 10)+  d4 <- QC.chooseInt (1, 10)+  d3 <- QC.chooseInt (1, 10)+  d2 <- QC.chooseInt (1, 10)+  d1 <- QC.chooseInt (1, 10)+  let expected = [0 .. d6 * d5 * d4 * d3 * d2 * d1 - 1]+  let res = [index0 (d6, d5, d4, d3, d2, d1) (x6, x5, x4, x3, x2, x1) | x6 <- [0 .. d6 - 1], x5 <- [0 .. d5 - 1], x4 <- [0 .. d4 - 1], x3 <- [0 .. d3 - 1], x2 <- [0 .. d2 - 1], x1 <- [0 .. d1 - 1]]+  pure $ res QC.=== expected++-- indices should be successive+tests :: [TestTree]+tests =+  [ QC.testProperty "Ix0 1" prop_ix1,+    QC.testProperty "Ix0 2" prop_ix2,+    QC.testProperty "Ix0 3" prop_ix3,+    QC.testProperty "Ix0 4" prop_ix4,+    QC.testProperty "Ix0 5" prop_ix5,+    QC.testProperty "Ix0 6" prop_ix6+  ]