diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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. diff --git a/seqn.cabal b/seqn.cabal --- a/seqn.cabal +++ b/seqn.cabal @@ -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 diff --git a/src/Data/Seqn/Internal/MSeq.hs b/src/Data/Seqn/Internal/MSeq.hs --- a/src/Data/Seqn/Internal/MSeq.hs +++ b/src/Data/Seqn/Internal/MSeq.hs @@ -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) diff --git a/src/Data/Seqn/Internal/Seq.hs b/src/Data/Seqn/Internal/Seq.hs --- a/src/Data/Seqn/Internal/Seq.hs +++ b/src/Data/Seqn/Internal/Seq.hs @@ -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 --- : +-- There are multiple ways to implement tails (and inits): -- --- 1. (Generate or imap) with drop : --- 2. Send down a stack and rebuild : --- 3. (Unfold, replicateA or traverse) with uncons : +-- 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 diff --git a/src/Data/Seqn/MSeq.hs b/src/Data/Seqn/MSeq.hs --- a/src/Data/Seqn/MSeq.hs +++ b/src/Data/Seqn/MSeq.hs @@ -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: -- diff --git a/test/ListExtra.hs b/test/ListExtra.hs --- a/test/ListExtra.hs +++ b/test/ListExtra.hs @@ -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 diff --git a/test/ListLikeTests.hs b/test/ListLikeTests.hs --- a/test/ListLikeTests.hs +++ b/test/ListLikeTests.hs @@ -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 -> diff --git a/test/MSeq.hs b/test/MSeq.hs --- a/test/MSeq.hs +++ b/test/MSeq.hs @@ -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 (( + 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 (