diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,4 +1,4 @@ -# 0.2.2.0 - July 2024 +# 0.2.2.1 - July 2024 * Add `sort`, `sortBy`, `sortOn` ([#23](https://github.com/konsumlamm/rrb-vector/pull/22)) * Fix bug in `><` ([#19](https://github.com/konsumlamm/rrb-vector/pull/19)) diff --git a/bench/Traverse.hs b/bench/Traverse.hs deleted file mode 100644 --- a/bench/Traverse.hs +++ /dev/null @@ -1,21 +0,0 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE MagicHash #-} -{-# LANGUAGE NumericUnderscores #-} -{-# LANGUAGE UnboxedTuples #-} - -import Control.Monad (join) -import Data.Foldable -import Data.Functor ((<&>)) - -import qualified Data.RRBVector as RRB -import Test.Tasty.Bench - -default (Int) - -main :: IO () -main = defaultMain $ [10, 100, 1_000, 10_000, 100_000] <&> \n -> - let !v = RRB.fromList [1 .. n] - in bgroup (show n) - [ bench "Vector" $ whnf (join (<>)) v - , bench "List" $ whnf (join (\xs ys -> RRB.fromList (toList xs <> toList ys))) v - ] diff --git a/rrb-vector.cabal b/rrb-vector.cabal --- a/rrb-vector.cabal +++ b/rrb-vector.cabal @@ -1,5 +1,5 @@ name: rrb-vector -version: 0.2.2.0 +version: 0.2.2.1 synopsis: Efficient RRB-Vectors description: An RRB-Vector is an efficient sequence data structure. @@ -42,11 +42,11 @@ hs-source-dirs: src exposed-modules: Data.RRBVector + Data.RRBVector.Internal.Debug + other-modules: Data.RRBVector.Internal Data.RRBVector.Internal.Array Data.RRBVector.Internal.Buffer - Data.RRBVector.Internal.Debug - other-modules: Data.RRBVector.Internal.IntRef Data.RRBVector.Internal.Sorting build-depends: @@ -76,15 +76,6 @@ benchmark rrb-bench hs-source-dirs: bench main-is: Main.hs - type: exitcode-stdio-1.0 - default-language: Haskell2010 - ghc-options: -O2 - build-depends: base, rrb-vector, tasty-bench - default-extensions: ExtendedDefaultRules - -benchmark traverse - hs-source-dirs: bench - main-is: Traverse.hs type: exitcode-stdio-1.0 default-language: Haskell2010 ghc-options: -O2 diff --git a/src/Data/RRBVector.hs b/src/Data/RRBVector.hs --- a/src/Data/RRBVector.hs +++ b/src/Data/RRBVector.hs @@ -31,7 +31,7 @@ , (!?), (!) , update , adjust, adjust' - , take, drop, slice, splitAt + , take, drop, splitAt , insertAt, deleteAt , findIndexL, findIndexR, findIndicesL, findIndicesR -- * With Index diff --git a/src/Data/RRBVector/Internal.hs b/src/Data/RRBVector/Internal.hs --- a/src/Data/RRBVector/Internal.hs +++ b/src/Data/RRBVector/Internal.hs @@ -22,7 +22,7 @@ , (!?), (!) , update , adjust, adjust' - , take, drop, slice, splitAt + , take, drop, splitAt , insertAt, deleteAt , findIndexL, findIndexR, findIndicesL, findIndicesR -- * Transformations @@ -627,10 +627,6 @@ | n <= 0 = v | n >= size = empty | otherwise = normalize $ Root (size - n) sh (dropTree n sh tree) - --- | \(O(\log n)\). Slice the vector between the two indices (inclusive). -slice :: (Int, Int) -> Vector a -> Vector a -slice (i, j) = drop i . take (j + 1) -- | \(O(\log n)\). Split the vector at the given index. -- diff --git a/test/Arbitrary.hs b/test/Arbitrary.hs --- a/test/Arbitrary.hs +++ b/test/Arbitrary.hs @@ -1,56 +1,20 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE LambdaCase #-} module Arbitrary where #if !(MIN_VERSION_base(4,18,0)) import Control.Applicative (liftA2) #endif -import Control.Monad.ST -import Data.Bool (bool) -import Debug.Trace +import Data.Foldable (toList) import Test.Tasty.QuickCheck -import qualified Data.RRBVector.Internal as V -import qualified Data.RRBVector.Internal.Buffer as Buffer +import qualified Data.RRBVector as V import Data.RRBVector.Internal.Debug -arbitraryVectorOf :: Gen a -> Gen (V.Vector a) -arbitraryVectorOf gen = sized $ \n -> do - xs <- vectorOf n gen - if n <= V.blockSize - then pure $ V.fromList xs - else nodes V.Leaf xs >>= \case - [tree] -> pure $ V.Root (V.treeSize 0 tree) 0 tree - ts -> iterateNodes V.blockShift ts - where - nodes f trees = do - sizes <- infiniteListOf (arbitrary >>= bool (pure V.blockSize) (choose (1, V.blockSize - 1))) - pure $ runST $ do - buffer <- Buffer.new V.blockSize - let loop _ [] = do - result <- Buffer.get buffer - pure [f result] - loop (sz : sizes') (t : ts) = do - size <- Buffer.size buffer - if size == sz then do - result <- Buffer.get buffer - Buffer.push buffer t - rest <- loop sizes' ts - pure (f result : rest) - else do - Buffer.push buffer t - loop (sz : sizes') ts - loop sizes trees - {-# INLINE nodes #-} - - iterateNodes sh trees = do - ts <- nodes (V.computeSizes sh) trees - case ts of - [tree] -> pure $ V.Root (V.treeSize sh tree) sh tree - trees' -> iterateNodes (V.up sh) trees' +builders :: [[a] -> V.Vector a] +builders = [V.fromList, fromListUnbalanced] instance (Arbitrary a) => Arbitrary (V.Vector a) where arbitrary = arbitrary1 @@ -58,7 +22,11 @@ -- TODO: improve instance instance Arbitrary1 V.Vector where - liftArbitrary = arbitraryVectorOf + liftArbitrary gen = do + build <- elements builders + fmap build (liftArbitrary gen) + + liftShrink shr = concatMap (sequence builders) . liftShrink shr . toList -- A custom 'Testable' instance to use 'showTree'. instance {-# OVERLAPPING #-} (Arbitrary a, Show a, Testable prop) => Testable (V.Vector a -> prop) where diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -1,10 +1,6 @@ -import Data.Foldable (for_) import Test.Tasty import Test.Tasty.QuickCheck -import Data.RRBVector -import Data.RRBVector.Internal.Debug - import Properties (properties) import Strictness (strictness) @@ -13,8 +9,3 @@ [ properties , strictness ] - -main' :: IO () -main' = do - vs <- sample' (arbitrary :: Gen (Vector Int)) - for_ vs $ \v -> putStrLn (showTree v)