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 +5/−0
- README.md +6/−0
- seqn.cabal +4/−3
- src/Data/Seqn/Internal/MSeq.hs +170/−46
- src/Data/Seqn/Internal/Seq.hs +45/−34
- src/Data/Seqn/MSeq.hs +28/−15
- test/ListExtra.hs +3/−0
- test/ListLikeTests.hs +1/−2
- test/MSeq.hs +50/−7
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]