packages feed

seqn 0.1.0.0 → 0.1.1.0

raw patch · 9 files changed

+312/−107 lines, 9 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

+ Data.Seqn.Internal.MSeq: foldlSliceSummaryComponents :: Measured a => (b -> Measure a -> b) -> b -> (Int, Int) -> MSeq a -> b
+ Data.Seqn.Internal.MSeq: sliceSummary :: (Measured a, Monoid (Measure a)) => (Int, Int) -> MSeq a -> Measure a
+ Data.Seqn.Internal.MSeq: sliceSummaryMay :: Measured a => (Int, Int) -> MSeq a -> Maybe (Measure a)
+ Data.Seqn.MSeq: foldlSliceSummaryComponents :: Measured a => (b -> Measure a -> b) -> b -> (Int, Int) -> MSeq a -> b
+ Data.Seqn.MSeq: sliceSummary :: (Measured a, Monoid (Measure a)) => (Int, Int) -> MSeq a -> Measure a
+ Data.Seqn.MSeq: sliceSummaryMay :: Measured a => (Int, Int) -> MSeq a -> Maybe (Measure a)

Files

CHANGELOG.md view
@@ -1,3 +1,8 @@+### 0.1.1.0 -- 2024-07-12++* New `MSeq` functions: `sliceSummaryMay`, `sliceSummary`,+  `foldlSliceSummaryComponents`.+ ### 0.1.0.0 -- 2024-06-16  * First version.
README.md view
@@ -41,3 +41,9 @@ The interface and implementation of `seqn` is largely influenced by the libraries [`containers`](https://hackage.haskell.org/package/containers) and [`fingertree`](https://hackage.haskell.org/package/fingertree).++## Contributing++Questions, bug reports, documentation improvements, code contributions welcome!+Please [open an issue](https://github.com/meooow25/seqn/issues) as the first+step.
seqn.cabal view
@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               seqn-version:            0.1.0.0+version:            0.1.1.0 synopsis:           Sequences and measured sequences license:            BSD-3-Clause license-file:       LICENSE@@ -25,8 +25,9 @@   , GHC == 9.0.2   , GHC == 9.2.8   , GHC == 9.4.8-  , GHC == 9.6.4-  , GHC == 9.8.1+  , GHC == 9.6.5+  , GHC == 9.8.2+  , GHC == 9.10.1  source-repository head     type: git
src/Data/Seqn/Internal/MSeq.hs view
@@ -114,6 +114,9 @@     -- * Measured queries   , summaryMay   , summary+  , sliceSummaryMay+  , sliceSummary+  , foldlSliceSummaryComponents   , binarySearchPrefix   , binarySearchSuffix @@ -140,6 +143,7 @@ import Data.Functor.Const (Const(..)) import Data.Functor.Identity (Identity(..)) import Data.List.NonEmpty (NonEmpty(..))+import Data.Maybe (fromMaybe) import qualified Data.Monoid as Monoid import qualified Data.Primitive.Array as A import Data.Semigroup (Semigroup(..))@@ -290,7 +294,7 @@       | c <= 0 -> MEmpty       | fromIntegral c * toi (length t) > toi (maxBound :: Int) ->           error "MSeq.stimes: result size too large"-      | otherwise -> MTree x (stimesLoop (c'-1) x xs xs)+      | otherwise -> stimesGo x (c'-1) xs xs       where         c' = fromIntegral c :: Int         toi :: Int -> Integer@@ -300,13 +304,16 @@   -- See Note [Complexity of stimes] in Data.Seqn.Internal.Seq    sconcat (x:|xs) = mconcat (x:xs)+  {-# INLINABLE sconcat #-} -stimesLoop :: Measured a => Int -> a -> MTree a -> MTree a -> MTree a-stimesLoop c !x !xs !acc-  | c <= 0 = acc-  | c `mod` 2 == 0 = stimesLoop (c `div` 2) x (T.bin x xs xs) acc-  | otherwise = stimesLoop (c `div` 2) x (T.bin x xs xs) (T.link x xs acc)-{-# INLINABLE stimesLoop #-}+stimesGo :: Measured a => a -> Int -> MTree a -> MTree a -> MSeq a+stimesGo !x = go+  where+    go c !xs !acc+      | c <= 0 = MTree x acc+      | c `mod` 2 == 0 = go (c `div` 2) (T.bin x xs xs) acc+      | otherwise = go (c `div` 2) (T.bin x xs xs) (T.link x xs acc)+{-# INLINE stimesGo #-}  -- | -- [@mempty@]: The empty sequence.@@ -349,7 +356,9 @@ -- | \(O(\log n)\). A sequence with a repeated element. -- If the length is negative, 'empty' is returned. replicate :: Measured a => Int -> a -> MSeq a-replicate !n x = stimes n (MTree x MTip)+replicate n !x+  | n <= 0 = MEmpty+  | otherwise = stimesGo x (n-1) MTip MTip {-# INLINABLE replicate #-}  -- | \(O(n)\). Generate a sequence from a length and an applicative action.@@ -467,6 +476,7 @@ -- | \(O(\log n)\). Infix version of 'lookup'. (!?) :: MSeq a -> Int -> Maybe a (!?) = flip lookup+{-# INLINE (!?) #-}  -- | \(O(\log n)\). Infix version of 'index'. Calls @error@ if the index is out -- of bounds.@@ -476,7 +486,7 @@ -- | \(O(\log n)\). Update an element at an index. If the index is out of -- bounds, the sequence is returned unchanged. update :: Measured a => Int -> a -> MSeq a -> MSeq a-update i x = adjust (const x) i+update i x t = adjust (const x) i t {-# INLINABLE update #-}  -- | \(O(\log n)\). Adjust the element at an index. If the index is out of@@ -722,11 +732,6 @@ -- ~~~~~~~~~~~~~~~~~~~ -- MSeq cannot be a Functor because of the Measured constraint on the element -- type. So class methods which require Functor are provided as standalone.------ This problem has a decent solution in the form of the Mono* classes from the--- mono-traversable package. I would use it here if it had not decided to--- provide instances for all popular packages, giving it a ridiculous dependency--- footprint of split, unordered-containers, and vector!  -- | \(O(n)\). Map over a sequence. map :: Measured b => (a -> b) -> MSeq a -> MSeq b@@ -785,7 +790,8 @@   U.SNothing -> error "intersperse: impossible"   U.SJust (U.S2 xs' _) -> MTree x xs'   where-    go T.MTip = T.singleton y+    yt = T.singleton y+    go T.MTip = yt     go (T.MBin sz _ z l r) = T.binn (sz*2+1) z (go l) (go r)     -- No need to balance, x <= 3y => 2x+1 <= 3(2y+1) intersperse _ MEmpty = MEmpty@@ -858,16 +864,17 @@ infixIndices t1 t2   | null t1 = [0 .. length t2]   | compareLength t1 t2 == GT = []-  | otherwise = X.build $ \lcons lnil ->+  | otherwise =     let n1 = length t1         t1a = infixIndicesMkArray n1 t1-        !(!mt, !mt0) = KMP.build t1a-        f !i x k = \ !m -> case KMP.step mt m x of-          (b,m') ->-            if b-            then lcons (i-n1+1) (k m')-            else k m'-    in IFo.ifoldr f (\ !_ -> lnil) t2 mt0+        !(!mt, !m0) = KMP.build t1a+    in X.build $ \lcons lnil ->+         let f !i x k !m = case KMP.step mt m x of+               (b,m') ->+                 if b+                 then lcons (i-n1+1) (k m')+                 else k m'+         in IFo.ifoldr f (\ !_ -> lnil) t2 m0 {-# INLINE infixIndices #-} -- Inline for fusion  infixIndicesMkArray :: Int -> MSeq a -> A.Array a@@ -909,7 +916,7 @@  -- | \(O(n_1 + n_2)\). Whether the first sequence is a substring of the second. isInfixOf :: Eq a => MSeq a -> MSeq a -> Bool-isInfixOf t1 t2 = not (null (infixIndices t1 t2))+isInfixOf t1 t2 = foldr (\_ _ -> True) False (infixIndices t1 t2) {-# INLINABLE isInfixOf #-}  -- | \(O(n_1 + n_2)\). Whether the first sequence is a subsequence of the second.@@ -1008,19 +1015,136 @@ -- -- @summaryMay == 'foldMap' (Just . 'measure')@ summaryMay :: Measured a => MSeq a -> Maybe (Measure a)-summaryMay = \case+summaryMay t = case t of   MTree x xs -> Just $! measure x T.<<> xs   MEmpty -> Nothing+{-# INLINE summaryMay #-}  -- | \(O(1)\). The summary is the fold of measures of all elements in the -- sequence. -- -- @summary == 'foldMap' 'measure'@ summary :: (Measured a, Monoid (Measure a)) => MSeq a -> Measure a-summary = \case-  MTree x xs -> measure x T.<<> xs-  MEmpty -> mempty+summary t = fromMaybe mempty (summaryMay t)+{-# INLINABLE summary #-} +-- | \(O(\log n)\). The summary of a slice of the sequence. The slice is+-- indicated by its bounds (inclusive).+--+-- @sliceSummaryMay lu == 'summaryMay' . 'slice' lu@+--+-- @since 0.1.1.0+sliceSummaryMay :: Measured a => (Int, Int) -> MSeq a -> Maybe (Measure a)+sliceSummaryMay (!ql, !qu) t = case t of+  MEmpty -> Nothing+  MTree x xs+    | ql > qu || qu < 0 || length t - 1 < ql -> Nothing+    | otherwise -> Just $! foldlMap1SliceSummaryComponents id (<>) ql qu x xs+{-# INLINE sliceSummaryMay #-}++-- | \(O(\log n)\). The summary of a slice of the sequence. The slice is+-- indicated by its bounds (inclusive).+--+-- @sliceSummary lu == 'summary' . 'slice' lu@+--+-- @since 0.1.1.0+sliceSummary+  :: (Measured a, Monoid (Measure a)) => (Int, Int) -> MSeq a -> Measure a+sliceSummary lu t = fromMaybe mempty (sliceSummaryMay lu t)+{-# INLINABLE sliceSummary #-}++-- | Strict left fold over measures covering a slice. These measures are+-- summaries of \(O(\log n)\) adjacent slices which form the requested slice+-- when concatenated.+--+-- @foldlSliceSummaryComponents (<>) mempty == 'sliceSummary'@+--+-- This function is useful when+--+-- * Some property of the summary of a slice is desired.+-- * It is expensive to compute the summary, i.e. @(<>)@ for @Measure a@ is+--   expensive.+-- * It is possible, and cheaper, to compute the property given components+--   of the summary of the slice.+--+-- ==== __Examples__+--+-- One use case for this is order statistic queries on a slice, such as counting+-- the number of elements less than some value.+--+-- It requires a @Multiset@ structure as outlined below, which can be+-- implemented using sorted arrays/balanced binary trees.+--+-- @+-- data Multiset a+-- singleton :: Ord a => a -> MultiSet a -- O(1)+-- (<>) :: Ord a => Multiset a -> Multiset a -> Multiset a -- O(n1 + n2)+-- countLessThan :: Ord a => a -> Multiset a -> Int -- O(log n)+-- @+--+-- @+-- import Data.Seqn.MSeq (Measured, MSeq)+-- import qualified Data.Seqn.MSeq as MSeq+--+-- newtype Elem a = Elem a deriving Show+--+-- instance Ord a => Measured (Elem a) where+--   type Measure (Elem a) = Multiset a+--   measure (Elem x) = singleton x+--+-- -- | O(n log n).+-- fromList :: Ord a => [a] -> MSeq (Elem a)+-- fromList = MSeq.fromList . map Elem+--+-- -- | O(log^2 n).+-- countLessThanInSlice :: Ord a => a -> (Int, Int) -> MSeq (Elem a) -> Int+-- countLessThanInSlice k =+--   MSeq.foldlSliceSummaryComponents (\\acc xs -> acc + countLessThan k xs) 0+-- @+--+-- @since 0.1.1.0+foldlSliceSummaryComponents+  :: Measured a => (b -> Measure a -> b) -> b -> (Int, Int) -> MSeq a -> b+foldlSliceSummaryComponents f !z (!ql, !qu) t = case t of+  MEmpty -> z+  MTree x xs+    | ql > qu || qu < 0 || length t - 1 < ql -> z+    | otherwise -> foldlMap1SliceSummaryComponents (f z) f ql qu x xs+{-# INLINE foldlSliceSummaryComponents #-}++-- Precondition: slice (ql, qu) (Tree x0 xs0) is non-empty+foldlMap1SliceSummaryComponents+  :: Measured a+  => (Measure a -> b) -> (b -> Measure a -> b)+  -> Int -> Int -> a -> MTree a -> b+foldlMap1SliceSummaryComponents f g !ql !qu x0 xs0+  | ql <= 0 && 0 <= qu = go (f (measure x0)) 1 xs0+  | otherwise = go1 1 xs0+  where+    go1 !i (MBin sz v y l r)+      | ql <= i && k <= qu = f v+      | ql < j && i <= qu =+          if ql <= j && j <= qu+          then go (g (go1 i l) (measure y)) (j+1) r+          else go1 i l+      | ql <= j && j <= qu = go (f (measure y)) (j+1) r+      | otherwise = go1 (j+1) r+      where+        k = i + sz - 1+        j = i + T.size l+    go1 _ MTip = error "MSeq.foldlMap1SliceSummaryComponents: impossible"++    go !z !i (MBin sz v x l r)+      | qu < i || k < ql = z+      | ql <= i && k <= qu = g z v+      | ql <= j && j <= qu = go (g (go z i l) (measure x)) (j+1) r+      | otherwise = go (go z i l) (j+1) r+      where+        k = i + sz - 1+        j = i + T.size l+    go z _ MTip = z+{-# INLINE foldlMap1SliceSummaryComponents #-}+ -- | \(O(\log n)\). Perform a binary search on the summaries of the non-empty -- prefixes of the sequence. --@@ -1039,21 +1163,21 @@ -- @ -- import "Data.Monoid" (Sum(..)) ----- newtype A = A Int deriving Show+-- newtype Elem = E Int deriving Show ----- instance Measured A where---   type Measure A = Sum Int---   measure (A x) = Sum x+-- instance Measured Elem where+--   type Measure Elem = Sum Int+--   measure (E x) = Sum x -- @ ----- >>> let xs = fromList [A 1, A 2, A 3, A 4]+-- >>> let xs = fromList [E 1, E 2, E 3, E 4] -- -- The summaries of the prefixes of @xs@ by index are: ----- * @0: measure (A 1) = Sum 1@.--- * @1: measure (A 1) <> measure (A 2) = Sum 3@.--- * @2: measure (A 1) <> measure (A 2) <> measure (A 3) = Sum 6@.--- * @3: measure (A 1) <> measure (A 2) <> measure (A 3) <> measure (A 4) = Sum 10@.+-- * @0: measure (E 1) = Sum 1@.+-- * @1: measure (E 1) <> measure (E 2) = Sum 3@.+-- * @2: measure (E 1) <> measure (E 2) <> measure (E 3) = Sum 6@.+-- * @3: measure (E 1) <> measure (E 2) <> measure (E 3) <> measure (E 4) = Sum 10@. -- -- >>> binarySearchPrefix (> Sum 4) xs -- (Just 1,Just 2)@@ -1123,21 +1247,21 @@ -- @ -- import "Data.Monoid" (Sum(..)) ----- newtype A = A Int deriving Show+-- newtype Elem = E Int deriving Show ----- instance Measured A where---   type Measure A = Sum Int---   measure (A x) = Sum x+-- instance Measured Elem where+--   type Measure Elem = Sum Int+--   measure (E x) = Sum x -- @ ----- >>> let xs = fromList [A 1, A 2, A 3, A 4]+-- >>> let xs = fromList [E 1, E 2, E 3, E 4] -- -- The summaries of the suffixes of @xs@ by index are: ----- * @0: measure (A 1) <> measure (A 2) <> measure (A 3) <> measure (A 4) = Sum 10@.--- * @1: measure (A 2) <> measure (A 3) <> measure (A 4) = Sum 9@.--- * @2: measure (A 3) <> measure (A 4) = Sum 7@.--- * @3: measure (A 4) = Sum 4@.+-- * @0: measure (E 1) <> measure (E 2) <> measure (E 3) <> measure (E 4) = Sum 10@.+-- * @1: measure (E 2) <> measure (E 3) <> measure (E 4) = Sum 9@.+-- * @2: measure (E 3) <> measure (E 4) = Sum 7@.+-- * @3: measure (E 4) = Sum 4@. -- -- >>> binarySearchSuffix (> Sum 4) xs -- (Just 2,Just 3)
src/Data/Seqn/Internal/Seq.hs view
@@ -283,7 +283,7 @@       | c <= 0 -> Empty       | fromIntegral c * toi (length t) > toi (maxBound :: Int) ->           error "Seq.stimes: result size too large"-      | otherwise -> Tree x (stimesLoop (c'-1) x xs xs)+      | otherwise -> stimesGo x (c'-1) xs xs       where         c' = fromIntegral c :: Int         toi :: Int -> Integer@@ -296,12 +296,12 @@ -- Note [Complexity of stimes] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~ ----- Let stimesLoop be initially called with trees (xs and acc) of size (n-1).+-- Let stimesGo be initially called with trees (xs and acc) of size (n-1). ----- stimesLoop is called O(log c) times in total, since c halves on every call.+-- go is called O(log c) times in total, since c halves on every call. -- At any iteration, xs is made up of initial tree bin-ed with itself multiple -- times, and acc is made up of the some of the xs linked together.--- All operations in stimesLoop are O(1) except for link, which takes+-- All operations in go are O(1) except for link, which takes -- O(log(size xs) - log(size acc)). -- -- The cost of the ith iteration is O(1) if 2^i is in c.@@ -318,11 +318,14 @@ -- = O(p_k - p_1) -- = O(\log c) -stimesLoop :: Int -> a -> Tree a -> Tree a -> Tree a-stimesLoop c !x !xs !acc-  | c <= 0 = acc-  | c `mod` 2 == 0 = stimesLoop (c `div` 2) x (T.bin x xs xs) acc-  | otherwise = stimesLoop (c `div` 2) x (T.bin x xs xs) (T.link x xs acc)+stimesGo :: a -> Int -> Tree a -> Tree a -> Seq a+stimesGo !x = go+  where+    go c !xs !acc+      | c <= 0 = Tree x acc+      | c `mod` 2 == 0 = go (c `div` 2) (T.bin x xs xs) acc+      | otherwise = go (c `div` 2) (T.bin x xs xs) (T.link x xs acc)+{-# INLINE stimesGo #-}  -- | -- [@mempty@]: The empty sequence.@@ -475,7 +478,9 @@ -- >>> replicate 3 "ha" -- ["ha","ha","ha"] replicate :: Int -> a -> Seq a-replicate !n x = stimes n (Tree x Tip)+replicate n !x+  | n <= 0 = Empty+  | otherwise = stimesGo x (n-1) Tip Tip  -- | \(O(n)\). Generate a sequence from a length and an applicative action. -- If the length is negative, 'empty' is returned.@@ -597,8 +602,8 @@ ----------  -- Precondition: 0 <= i < size xs-index_ :: Int -> Tree a -> a-index_ !i xs = getConst (T.adjustF Const i xs)+indexTree :: Int -> Tree a -> a+indexTree !i xs = getConst (T.adjustF Const i xs)  -- | \(O(\log n)\). Look up the element at an index. --@@ -612,7 +617,7 @@ lookup !i (Tree x xs)   | i < 0 || T.size xs < i = Nothing   | i == 0 = Just x-  | otherwise = Just $! index_ (i-1) xs+  | otherwise = Just $! indexTree (i-1) xs lookup _ Empty = Nothing {-# INLINE lookup #-} @@ -629,12 +634,13 @@ index !i = \case   Tree x xs     | i == 0 -> x-    | otherwise -> index_ (i-1) xs+    | otherwise -> indexTree (i-1) xs   Empty -> error "Seq.index: out of bounds"  -- | \(O(\log n)\). Infix version of 'lookup'. (!?) :: Seq a -> Int -> Maybe a (!?) = flip lookup+{-# INLINE (!?) #-}  -- | \(O(\log n)\). Infix version of 'index'. Calls @error@ if the index is out -- of bounds.@@ -651,7 +657,7 @@ -- >>> update 3 True (singleton False) -- [False] update :: Int -> a -> Seq a -> Seq a-update i x = adjust (const x) i+update i x t = adjust (const x) i t  -- | \(O(\log n)\). Adjust the element at an index. If the index is out of -- bounds the sequence is returned unchanged.@@ -872,15 +878,18 @@ -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- tails :: Seq a -> Seq (Seq a) ----- There are many ways to implement tails (and inits), with different--- <WHNF, WHNF for ith tail>:+-- There are multiple ways to implement tails (and inits): ----- 1. (Generate or imap) with drop                 : <O(n), O(log n)>--- 2. Send down a stack and rebuild                : <O(n), O(log n)>--- 3. (Unfold, replicateA or traverse) with uncons : <O(n log n), O(n log n)>+-- 1. imap (or generate) with drop+-- 2. Send down a stack and rebuild+-- 3. traverse (or unfold or replicateA) with uncons ----- We do 3 for because it is faster in benchmarks. It cannot be done lazily,--- unlike 1 and 2, but that is fine because Seq is value-strict.+-- We do 3 with traverse because it is seen to be faster in benchmarks. Note+-- that in 3 a tail requires all previous tails to be calculated, while this is+-- not true for 1 and 2. But Seqn is value-strict, so it's not like we lose an+-- opportunity to be lazy. If a user wants arbitrary tails, they can use drop+-- which is not too bad. 3 takes ~17% less time compared to 1, according to the+-- "tails" benchmark.   -- | \(O \left(\frac{n}{c} \log c \right)\). Split a sequence into chunks of the@@ -968,8 +977,8 @@ -- is the result of multiple links of (root, right child) caused by the split -- at a chunk boundary, again with total size bounded by c. This takes -- O(log c). For an explanation see the description of the finishing step in--- Note [fromList complexity]. The same applies to the right tree. Hence, each--- chunk is balanced in O(log c) and to balance all the chunks we need+-- Note [fromList implementation]. The same applies to the right tree. Hence,+-- each chunk is balanced in O(log c) and to balance all the chunks we need -- O((n/c) log c). -- -- Now the result tree has size ceil(n/c), which needs to be balanced. This is@@ -1174,7 +1183,8 @@   U.SNothing -> error "Seq.intersperse: impossible"   U.SJust (U.S2 xs' _) -> Tree x xs'   where-    go T.Tip = T.Bin 1 y T.Tip T.Tip+    yt = T.Bin 1 y T.Tip T.Tip+    go T.Tip = yt     go (T.Bin sz z l r) = T.Bin (sz*2+1) z (go l) (go r)     -- No need to balance, x <= 3y => 2x+1 <= 3(2y+1) intersperse _ Empty = Empty@@ -1294,16 +1304,17 @@ infixIndices t1 t2   | null t1 = [0 .. length t2]   | compareLength t1 t2 == GT = []-  | otherwise = X.build $ \lcons lnil ->+  | otherwise =     let n1 = length t1         t1a = infixIndicesMkArray n1 t1-        !(!mt, !mt0) = KMP.build t1a-        f !i x k = \ !m -> case KMP.step mt m x of-          (b,m') ->-            if b-            then lcons (i-n1+1) (k m')-            else k m'-    in IFo.ifoldr f (\ !_ -> lnil) t2 mt0+        !(!mt, !m0) = KMP.build t1a+    in X.build $ \lcons lnil ->+         let f !i x k !m = case KMP.step mt m x of+               (b,m') ->+                 if b+                 then lcons (i-n1+1) (k m')+                 else k m'+         in IFo.ifoldr f (\ !_ -> lnil) t2 m0 {-# INLINE infixIndices #-} -- Inline for fusion  infixIndicesMkArray :: Int -> Seq a -> A.Array a@@ -1373,7 +1384,7 @@ -- >>> fromList [2,4] `isInfixOf` fromList [2,3,4] -- False isInfixOf :: Eq a => Seq a -> Seq a -> Bool-isInfixOf t1 t2 = not (null (infixIndices t1 t2))+isInfixOf t1 t2 = foldr (\_ _ -> True) False (infixIndices t1 t2) {-# INLINABLE isInfixOf #-}  -- | \(O(n_1 + n_2)\). Whether the first sequence is a subsequence of the
src/Data/Seqn/MSeq.hs view
@@ -5,7 +5,7 @@ -- An @MSeq@ is -- -- * Spine-strict, hence finite. @MSeq@ cannot represent infinite sequences.--- * Value-strict. It is guaranteed that if a @MSeq@ is in+-- * Value-strict. It is guaranteed that if an @MSeq@ is in --   [weak head normal form](https://wiki.haskell.org/Weak_head_normal_form) --   (WHNF), every element of the @Seq@ is also in WHNF. --@@ -22,11 +22,20 @@ -- -- === Warning ----- The length of a @MSeq@ must not exceed @(maxBound \`div\` 3) :: Int@. If this--- length is exceeded, the behavior of a @MSeq@ is undefined. This value is very--- large in practice, greater than \(7 \cdot 10^8\) on 32-bit systems and--- \(3 \cdot 10^{18}\) on 64-bit systems.+-- The length of an @MSeq@ must not exceed @(maxBound \`div\` 3) :: Int@. If+-- this length is exceeded, the behavior of an @MSeq@ is undefined. This value+-- is very large in practice, greater than \(7 \cdot 10^8\) on 32-bit systems+-- and \(3 \cdot 10^{18}\) on 64-bit systems. --+-- === Note on time complexities+--+-- Many functions operating on @MSeq a@ require a @Measured a@ constraint. The+-- documented time complexities of these functions assume that+-- @measure :: a -> Measure a@ and+-- @(<>) :: Measure a -> Measure a -> Measure a@ both take \(O(1)\) time. If+-- this not the case, the bounds do not hold. Correct bounds can be calculated+-- by the user depending on their implementations of @measure@ and @(<>)@.+-- -- === Implementation -- -- @MSeq@ is implemented as a@@ -61,6 +70,9 @@     -- * Measured queries   , S.summaryMay   , S.summary+  , S.sliceSummaryMay+  , S.sliceSummary+  , S.foldlSliceSummaryComponents   , S.binarySearchPrefix   , S.binarySearchSuffix @@ -167,14 +179,15 @@ -- $tutorial -- -- @MSeq@, like @Seq@, is a sequence which supports operations like @lookup@,--- @splitAt@, @(<>)@, @foldr@, and more. What makes it different is that it--- maintains \"measure\"s of the elements in it. Every element in the sequence--- has an associated measure. The type of this measure must have a @Semigroup@--- instance. An @MSeq@ allows accessing the combined measure of all its elements--- in \(O(1)\) time.+-- @splitAt@, @(<>)@, @foldr@, and more. ----- == Example: Sum+-- Additionally, every element in an @MSeq@ has an associated \"measure\".+-- Such measures can be combined using a @Semigroup@ instance. An @MSeq@ allows+-- accessing the combined measure of all its elements in \(O(1)\) time. The+-- choice of the measure depends on the use case. --+-- == Example 1: Sum+-- -- @ -- data Task = Task --   !Text -- ^ Name@@ -191,7 +204,7 @@ -- if the sum has to be calculated frequently. In the latter case, we could use -- an @MSeq@. ----- We begin with some imports.+-- First, some imports. -- -- @ -- import Data.Seqn.MSeq (Measured, MSeq)@@ -288,10 +301,10 @@ -- >>> splitAtMost 10 tasks -- Nothing ----- Note that the running time of @splitAtMost@ is simply \(O(\log n)\), and not--- dependent on how many tasks are split out.+-- The running time of @splitAtMost@ is simply \(O(\log n)\), and it does not+-- depend on how many tasks are split out. ----- == More information+-- == More uses -- -- More uses of measured sequences can be found in the paper on finger trees: --
test/ListExtra.hs view
@@ -19,6 +19,9 @@ unsnocL =   foldr (\x -> Just . maybe ([], x) (\(~(a, b)) -> (x : a, b))) Nothing +sliceL :: (Int, Int) -> [a] -> [a]+sliceL (l,u) = L.drop l . L.take (u+1)+ takeEndL :: Int -> [a] -> [a] takeEndL n xs = foldr (\_ k -> k . tail) id (L.drop n xs) xs 
test/ListLikeTests.hs view
@@ -279,8 +279,7 @@ drop f = testProperty "drop" $ \n xs -> toL (f n xs) === L.drop n (toL xs)  slice :: Common t => ((Int, Int) -> t -> t) -> TestTree-slice f = testProperty "slice" $ \(i,j) xs ->-  toL (f (i,j) xs) === L.drop i (L.take (j+1) (toL xs))+slice f = testProperty "slice" $ \ij xs -> toL (f ij xs) === sliceL ij (toL xs)  splitAt :: Common t => (Int -> t -> (t,t)) -> TestTree splitAt f = testProperty "splitAt" $ \n xs ->
test/MSeq.hs view
@@ -27,7 +27,7 @@ import Data.Seqn.MSeq import qualified Data.Seqn.Internal.MSeq as MSeqInternal import qualified Data.Seqn.Internal.MTree as MTreeInternal-import ListExtra (unsnocL)+import ListExtra (sliceL, unsnocL) import qualified ListLikeTests as LL import TestUtil ((.:), ListLike(..), Sqrt1(..), tastyLaws) @@ -42,7 +42,36 @@         summaryMay xs === foldMap (Just . measure) (F.toList xs)     , testProperty "summary" $ \(xs :: MSeq D) ->         summary xs === foldMap measure (F.toList xs)-    , testProperty "binarySearchPrefix" $ \(xs :: MSeq S) y ->+    , testProperty "sliceSummaryMay" $ \(xs :: MSeq A) lu ->+        sliceSummaryMay lu xs ===+        foldMap (Just . measure) (sliceL lu (F.toList xs))+    , testProperty "sliceSummary" $ \(xs :: MSeq D) lu ->+        sliceSummary lu xs ===+        foldMap measure (sliceL lu (F.toList xs))+    , testProperty "foldlSliceSummaryComponents mempty (<>) == sliceSummary" $+        \(xs :: MSeq D) lu ->+          foldlSliceSummaryComponents (<>) mempty lu xs ===+          foldMap measure (sliceL lu (F.toList xs))+    , testProperty "foldlSliceSummaryComponents countLessThanInSlice" $+        \(xs :: MSeq (MultisetElem Int)) k lu ->+          let countLessThanInSlice =+                foldlSliceSummaryComponents+                  (\z ys -> z + countLessThanMultiset k ys)+                  0+          in+            countLessThanInSlice lu xs ===+            (length . L.filter ((<k) . unMultisetElem) . sliceL lu . F.toList) xs+    , testProperty "foldlSliceSummaryComponents O(log n)" $+        \(xs :: MSeq D) lu@(l,u) ->+          let res = foldlSliceSummaryComponents (\z _ -> z+1) 0 lu xs+              d = fromIntegral (max 1 (u-l+2)) :: Double+              lim = 4 * ceiling (logBase 2 d) :: Integer+              -- 4*log because 2*log from each side of the root.+              -- 2*log because subtree root + one child for each level.+              -- Could find a tighter bound but this is fine for testing.+          in counterexample ("res=" ++ show res ++ ", lim=" ++ show lim) $+               res <= lim+    , testProperty "binarySearchPrefix" $ \(xs :: MSeq SumElem) y ->         let p = (>=y) . getSum             xs' = F.toList xs             iws =@@ -52,7 +81,7 @@             lastFalse = snd <$> unsnocL [i | (i,w) <- iws, not (p w)]             firstTrue = fst <$> L.uncons [i | (i,w) <- iws, p w]         in binarySearchPrefix p xs === (lastFalse, firstTrue)-    , testProperty "binarySearchSuffix" $ \(xs :: MSeq S) y ->+    , testProperty "binarySearchSuffix" $ \(xs :: MSeq SumElem) y ->         let p = (>=y) . getSum             xs' = F.toList xs             iws =@@ -388,9 +417,23 @@   map (takeL 10)       (mfix (\ ~(LI is) -> generate n (\i -> LI (fromIntegral i : is)))) -newtype S = S Word+newtype SumElem = SumElem Word   deriving newtype (Eq, Ord, Show, Arbitrary) -instance Measured S where-  type Measure S = Sum Word-  measure (S x) = Sum x+instance Measured SumElem where+  type Measure SumElem = Sum Word+  measure (SumElem x) = Sum x++-- Good enough for testing purposes+newtype Multiset a = Multiset [a]+  deriving newtype (Eq, Ord, Show, Semigroup)++countLessThanMultiset :: Ord a => a -> Multiset a -> Int+countLessThanMultiset k (Multiset xs) = length (L.filter (<k) xs)++newtype MultisetElem a = MultisetElem { unMultisetElem :: a }+  deriving newtype (Eq, Ord, Show, Arbitrary)++instance Measured (MultisetElem a) where+  type Measure (MultisetElem a) = Multiset a+  measure (MultisetElem x) = Multiset [x]