rrb-vector 0.2.1.0 → 0.2.2.0
raw patch · 13 files changed
+348/−34 lines, 13 filesdep +samsortdep ~basedep ~primitive
Dependencies added: samsort
Dependency ranges changed: base, primitive
Files
- CHANGELOG.md +6/−0
- bench/Main.hs +7/−0
- bench/Traverse.hs +21/−0
- rrb-vector.cabal +22/−6
- src/Data/RRBVector.hs +6/−1
- src/Data/RRBVector/Internal.hs +25/−9
- src/Data/RRBVector/Internal/Array.hs +4/−1
- src/Data/RRBVector/Internal/Buffer.hs +9/−5
- src/Data/RRBVector/Internal/Debug.hs +115/−2
- src/Data/RRBVector/Internal/Sorting.hs +49/−0
- test/Arbitrary.hs +41/−9
- test/Main.hs +9/−0
- test/Properties.hs +34/−1
CHANGELOG.md view
@@ -1,3 +1,9 @@+# 0.2.2.0 - 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))+* Fix bug in `<|` ([#18](https://github.com/konsumlamm/rrb-vector/pull/18))+ # 0.2.1.0 - December 2023 * Add `findIndexL`, `findIndexR`, `findIndicesL`, `findIndicesR`
bench/Main.hs view
@@ -19,9 +19,16 @@ , bench "<|" $ whnf (42 RRB.<|) v , bench "take" $ whnf (RRB.take idx) v , bench "drop" $ whnf (RRB.drop idx) v+ , bench "splitAt" $ whnf (RRB.splitAt idx) v+ , bench "insertAt" $ whnf (RRB.insertAt idx 42) v+ , bench "deleteAt" $ whnf (RRB.deleteAt idx) v , bench "index" $ nf (RRB.lookup idx) v , bench "adjust" $ whnf (RRB.adjust idx (+ 1)) v , bench "map" $ whnf (RRB.map (+ 1)) v , bench "foldl" $ nf (foldl (+) 0) v , bench "foldr" $ nf (foldr (+) 0) v+ , bench "findIndexL" $ nf (RRB.findIndexL (== idx)) v+ , bench "findIndexR" $ nf (RRB.findIndexR (== idx)) v+ , bench "findIndicesL" $ nf (RRB.findIndicesL (== idx)) v+ , bench "findIndicesR" $ nf (RRB.findIndicesR (== idx)) v ]
+ bench/Traverse.hs view
@@ -0,0 +1,21 @@+{-# 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+ ]
rrb-vector.cabal view
@@ -1,5 +1,5 @@ name: rrb-vector-version: 0.2.1.0+version: 0.2.2.0 synopsis: Efficient RRB-Vectors description: An RRB-Vector is an efficient sequence data structure.@@ -30,8 +30,9 @@ GHC == 9.0.2 GHC == 9.2.8 GHC == 9.4.8- GHC == 9.6.3- GHC == 9.8.1+ GHC == 9.6.5+ GHC == 9.8.2+ GHC == 9.10.1 source-repository head type: git@@ -41,13 +42,19 @@ 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- build-depends: base >= 4.11 && < 5, deepseq >= 1.4.3 && < 1.6, indexed-traversable ^>= 0.1, primitive >= 0.7 && < 0.10+ Data.RRBVector.Internal.Sorting+ build-depends:+ base >= 4.11 && < 5,+ deepseq >= 1.4.3 && < 1.6,+ indexed-traversable ^>= 0.1,+ primitive >= 0.7.3 && < 0.10,+ samsort ^>= 0.1 ghc-options: -O2 -Wall -Wno-name-shadowing -Werror=missing-methods -Werror=missing-fields default-language: Haskell2010 @@ -69,6 +76,15 @@ 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
src/Data/RRBVector.hs view
@@ -31,7 +31,7 @@ , (!?), (!) , update , adjust, adjust'- , take, drop, splitAt+ , take, drop, slice, splitAt , insertAt, deleteAt , findIndexL, findIndexR, findIndicesL, findIndicesR -- * With Index@@ -44,6 +44,10 @@ , map, map', reverse -- * Zipping and unzipping , zip, zipWith, unzip, unzipWith+ -- * Sorting+ --+ -- | Currently implemented using [samsort](https://hackage.haskell.org/package/samsort).+ , sort, sortBy, sortOn ) where import Prelude hiding (replicate, lookup, take, drop, splitAt, map, reverse, zip, zipWith, unzip)@@ -53,3 +57,4 @@ import Data.Traversable.WithIndex import Data.RRBVector.Internal+import Data.RRBVector.Internal.Sorting
src/Data/RRBVector/Internal.hs view
@@ -22,7 +22,7 @@ , (!?), (!) , update , adjust, adjust'- , take, drop, splitAt+ , take, drop, slice, splitAt , insertAt, deleteAt , findIndexL, findIndexR, findIndicesL, findIndicesR -- * Transformations@@ -174,7 +174,7 @@ where subtree = A.index arr i --- Integer log base 2.+-- | Integer log base 2. log2 :: Int -> Int log2 x = bitSizeMinus1 - countLeadingZeros x where@@ -343,7 +343,7 @@ pure = singleton fs <*> xs = foldl' (\acc f -> acc >< map f xs) empty fs liftA2 f xs ys = foldl' (\acc x -> acc >< map (f x) ys) empty xs- xs *> ys = foldl' (\acc _ -> acc >< ys) empty xs+ xs *> ys = stimes (length xs) ys xs <* ys = foldl' (\acc x -> acc >< replicate (length ys) x) empty xs instance Monad Vector where@@ -628,6 +628,10 @@ | 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. -- -- > splitAt n v = (take n v, drop n v)@@ -653,20 +657,32 @@ deleteAt i v = let (left, right) = splitAt (i + 1) v in take i left >< right -- | \(O(n)\). Find the first index from the left that satisfies the predicate.+--+-- @since 0.2.1.0 findIndexL :: (a -> Bool) -> Vector a -> Maybe Int findIndexL f = ifoldr (\i x acc -> if f x then Just i else acc) Nothing+{-# INLINE findIndexL #-} -- | \(O(n)\). Find the first index from the right that satisfies the predicate.+--+-- @since 0.2.1.0 findIndexR :: (a -> Bool) -> Vector a -> Maybe Int findIndexR f = ifoldl (\i acc x -> if f x then Just i else acc) Nothing+{-# INLINE findIndexR #-} -- | \(O(n)\). Find the indices that satisfy the predicate, starting from the left.+--+-- @since 0.2.1.0 findIndicesL :: (a -> Bool) -> Vector a -> [Int] findIndicesL f = ifoldr (\i x acc -> if f x then i : acc else acc) []+{-# INLINE findIndicesL #-} -- | \(O(n)\). Find the indices that satisfy the predicate, starting from the right.+--+-- @since 0.2.1.0 findIndicesR :: (a -> Bool) -> Vector a -> [Int] findIndicesR f = ifoldl (\i acc x -> if f x then i : acc else acc) []+{-# INLINE findIndicesR #-} -- concatenation @@ -678,12 +694,9 @@ Empty >< v = v v >< Empty = v Root size1 sh1 tree1 >< Root size2 sh2 tree2 =- let maxShift = max sh1 sh2- upMaxShift = up maxShift+ let upMaxShift = up (max sh1 sh2) newArr = mergeTrees tree1 sh1 tree2 sh2- in if length newArr == 1- then Root (size1 + size2) maxShift (A.head newArr)- else Root (size1 + size2) upMaxShift (computeSizes upMaxShift newArr)+ in normalize $ Root (size1 + size2) upMaxShift (computeSizes upMaxShift newArr) where mergeTrees tree1@(Leaf arr1) !_ tree2@(Leaf arr2) !_ | length arr1 == blockSize = A.from2 tree1 tree2@@ -768,7 +781,10 @@ -- compute the shift at which the new branch needs to be inserted (0 means there is space in the leaf) -- the size is computed for efficient calculation of the shift in a balanced subtree computeShift !sz !sh !min (Balanced _) =- let newShift = (log2 sz `div` blockShift) * blockShift+ -- @sz - 1@ is the index of the last element+ let hiShift = max ((log2 (sz - 1) `div` blockShift) * blockShift) 0 -- the shift of the root when normalizing+ hi = (sz - 1) `unsafeShiftR` hiShift -- the length of the root node when normalizing minus 1+ newShift = if hi < blockMask then hiShift else hiShift + blockShift in if newShift > sh then min else newShift computeShift _ sh min (Unbalanced arr sizes) = let sz' = indexPrimArray sizes 0 -- the size of the first subtree
src/Data/RRBVector/Internal/Array.hs view
@@ -14,7 +14,7 @@ module Data.RRBVector.Internal.Array ( Array, MutableArray , ifoldrStep, ifoldlStep, ifoldrStep', ifoldlStep'- , empty, singleton, from2+ , empty, singleton, from2, wrap , replicate, replicateSnoc , index, head, last , update, adjust, adjust'@@ -121,6 +121,9 @@ sma <- newSmallArray 2 x writeSmallArray sma 1 y pure sma++wrap :: SmallArray a -> Array a+wrap arr = Array 0 (sizeofSmallArray arr) arr replicate :: Int -> a -> Array a replicate n x = Array 0 n $ runSmallArray (newSmallArray n x)
src/Data/RRBVector/Internal/Buffer.hs view
@@ -13,25 +13,29 @@ import Control.Monad.ST +import Data.Primitive.SmallArray import Data.RRBVector.Internal.IntRef import qualified Data.RRBVector.Internal.Array as A -- | A mutable array buffer with a fixed capacity.-data Buffer s a = Buffer !(A.MutableArray s a) !(IntRef s)+data Buffer s a = Buffer !(SmallMutableArray s a) !(IntRef s) -- | \(O(n)\). Create a new empty buffer with the given capacity. new :: Int -> ST s (Buffer s a) new capacity = do- buffer <- A.new capacity+ buffer <- newSmallArray capacity uninitialized offset <- newIntRef 0 pure (Buffer buffer offset) +uninitialized :: a+uninitialized = errorWithoutStackTrace "uninitialized"+ -- | \(O(1)\). Push a new element onto the buffer. -- The size of the buffer must not exceed the capacity, but this is not checked. push :: Buffer s a -> a -> ST s () push (Buffer buffer offset) x = do idx <- readIntRef offset- A.write buffer idx x+ writeSmallArray buffer idx x writeIntRef offset (idx + 1) -- | \(O(n)\). Freeze the content of the buffer and return it.@@ -39,9 +43,9 @@ get :: Buffer s a -> ST s (A.Array a) get (Buffer buffer offset) = do len <- readIntRef offset- result <- A.freeze buffer 0 len+ result <- freezeSmallArray buffer 0 len writeIntRef offset 0- pure result+ pure (A.wrap result) -- | \(O(1)\). Return the current size of the buffer. size :: Buffer s a -> ST s Int
src/Data/RRBVector/Internal/Debug.hs view
@@ -10,16 +10,19 @@ , pattern Empty, pattern Root , Tree, Shift , pattern Balanced, pattern Unbalanced, pattern Leaf+ , Invariant, valid ) where import Control.Monad.ST (runST)-import Data.Foldable (toList)+import Data.Bits (shiftL)+import Data.Foldable (foldl', toList, traverse_) import Data.List (intercalate)-import Data.Primitive.PrimArray (PrimArray, primArrayToList)+import Data.Primitive.PrimArray (PrimArray, primArrayToList, indexPrimArray, sizeofPrimArray) import Data.RRBVector.Internal hiding (Empty, Root, Balanced, Unbalanced, Leaf) import qualified Data.RRBVector.Internal as RRB import Data.RRBVector.Internal.Array (Array)+import qualified Data.RRBVector.Internal.Array as A import qualified Data.RRBVector.Internal.Buffer as Buffer -- | \(O(n)\). Show the underlying tree of a vector.@@ -85,3 +88,113 @@ pattern Leaf arr <- RRB.Leaf arr {-# COMPLETE Balanced, Unbalanced, Leaf #-}++-- | Structural invariants a vector is expected to hold.+data Invariant+ = RootSizeGt0 -- Root: Size > 0+ | RootShiftDiv -- Root: The shift at the root is divisible by blockShift+ | RootSizeCorrect -- Root: The size at the root is correct+ | RootGt1Child -- Root: The root has more than 1 child if not a Leaf+ | BalShiftGt0 -- Balanced: Shift > 0+ | BalNumChildren -- Balanced: The number of children is blockSize unless+ -- the parent is unbalanced or the node is on the right+ -- edge in which case it is in [1,blockSize]+ | BalFullChildren -- Balanced: All children are full, except for the last+ -- if the node is on the right edge+ | UnbalShiftGt0 -- Unbalanced: Shift > 0+ | UnbalParentUnbal -- Unbalanced: Parent is Unbalanced+ | UnbalNumChildren -- Unbalanced: The number of children is in [1,blockSize]+ | UnbalSizes -- Unbalanced: The sizes array is correct+ | UnbalNotBal -- Unbalanced: The tree is not full enough to be a+ -- Balanced+ | LeafShift0 -- Leaf: Shift == 0+ | LeafNumElems -- Leaf: The number of elements is in [1,blockSize]+ deriving Show++assert :: Invariant -> Bool -> Either Invariant ()+assert i False = Left i+assert _ True = pure ()++-- | Check tree invariants. Returns @Left@ on finding a violated invariant.+valid :: Vector a -> Either Invariant ()+valid RRB.Empty = pure ()+valid (RRB.Root size sh tree) = do+ assert RootSizeGt0 $ size > 0+ assert RootShiftDiv $ sh `mod` blockShift == 0+ assert RootSizeCorrect $ size == countElems tree+ assert RootGt1Child $ case tree of+ Balanced arr -> length arr > 1+ Unbalanced arr _ -> length arr > 1+ Leaf _ -> True+ validTree Unbal sh tree++data NodeDesc+ = Bal -- parent is Balanced+ | BalRightEdge -- parent is Balanced and this node is on the right edge+ | Unbal -- parent is Unbalanced++validTree :: NodeDesc -> Shift -> Tree a -> Either Invariant ()+validTree desc sh (RRB.Balanced arr) = do+ assert BalShiftGt0 $ sh > 0+ assert BalNumChildren $ case desc of+ Bal -> n == blockSize+ BalRightEdge -> n >= 1 && n <= blockSize+ Unbal -> n >= 1 && n <= blockSize+ assert BalFullChildren $+ all (\t -> countElems t == 1 `shiftL` sh) expectedFullChildren+ traverse_ (validTree Bal (down sh)) arrInit+ validTree descLast (down sh) (A.last arr)+ where+ n = length arr+ arrInit = A.take arr (n-1)+ expectedFullChildren = case desc of+ Bal -> arr+ BalRightEdge -> arrInit+ Unbal -> arrInit+ descLast = case desc of+ Bal -> Bal+ BalRightEdge -> BalRightEdge+ Unbal -> BalRightEdge+validTree desc sh (RRB.Unbalanced arr sizes) = do+ assert UnbalShiftGt0 $ sh > 0+ case desc of+ Bal -> assert UnbalParentUnbal False+ BalRightEdge -> assert UnbalParentUnbal False+ Unbal -> assert UnbalNumChildren $ n >= 1 && n <= blockSize+ assert UnbalSizes $ n == sizeofPrimArray sizes+ assert UnbalSizes $+ all (\i -> countElems (A.index arr i) == getSize sizes i) [0 .. n-1]+ assert UnbalNotBal $ not (couldBeBalanced sh arr sizes)+ traverse_ (validTree Unbal (down sh)) arr+ where+ n = length arr+validTree desc sh (RRB.Leaf arr) = do+ assert LeafShift0 $ sh == 0+ assert LeafNumElems $ case desc of+ Bal -> n == blockSize+ BalRightEdge -> n >= 1 && n <= blockSize+ Unbal -> n >= 1 && n <= blockSize+ where+ n = length arr++-- | Check whether an Unbalanced node could be Balanced.+couldBeBalanced :: Shift -> A.Array (Tree a) -> PrimArray Int -> Bool+couldBeBalanced sh arr sizes =+ all (\i -> getSize sizes i == 1 `shiftL` sh) [0 .. n-2] &&+ (case A.last arr of+ Balanced _ -> True+ Unbalanced arr' sizes' -> couldBeBalanced (down sh) arr' sizes'+ Leaf _ -> True)+ where+ n = length arr++getSize :: PrimArray Int -> Int -> Int+getSize sizes 0 = indexPrimArray sizes 0+getSize sizes i = indexPrimArray sizes i - indexPrimArray sizes (i-1)++countElems :: Tree a -> Int+countElems (RRB.Balanced arr) =+ foldl' (\acc tree -> acc + countElems tree) 0 arr+countElems (RRB.Unbalanced arr _) =+ foldl' (\acc tree -> acc + countElems tree) 0 arr+countElems (RRB.Leaf arr) = length arr
+ src/Data/RRBVector/Internal/Sorting.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE MagicHash #-}++module Data.RRBVector.Internal.Sorting+ ( sort+ , sortBy+ , sortOn+ ) where++import Data.Foldable (toList)+import Data.Foldable.WithIndex (ifor_)+import Data.Primitive.Array+import Data.SamSort (sortArrayBy)+import Data.Semigroup (Arg(..))++import Data.RRBVector.Internal++uninitialized :: a+uninitialized = errorWithoutStackTrace "uninitialized"++-- | \(O(n \log n)\). Sort the vector in ascending order.+-- The sort is stable, meaning the order of equal elements is preserved.+--+-- @since 0.2.2.0+sort :: (Ord a) => Vector a -> Vector a+sort = sortBy compare++-- | \(O(n \log n)\). Sort the vector in ascending order according to the specified comparison function.+-- The sort is stable, meaning the order of equal elements is preserved.+--+-- @since 0.2.2.0+sortBy :: (a -> a -> Ordering) -> Vector a -> Vector a+sortBy cmp v =+ let sortedArr = createArray (length v) uninitialized $ \arr@(MutableArray arr#) -> do+ ifor_ v (writeArray arr)+ sortArrayBy cmp arr# 0 (length v)+ in fromList . toList $ sortedArr++-- | \(O(n \log n)\). Sort the vector in ascending order by comparing the results of applying the key function to each element.+-- The sort is stable, meaning the order of equal elements is preserved.+-- @`sortOn` f@ is equivalent to @`sortBy` (`Data.Ord.comparing` f)@, but only evaluates @f@ once for each element.+--+-- @since 0.2.2.0+sortOn :: (Ord b) => (a -> b) -> Vector a -> Vector a+sortOn f v =+ let sortedArr = createArray (length v) uninitialized $ \arr@(MutableArray arr#) -> do+ ifor_ v $ \i x -> let !y = f x in writeArray arr i (Arg y x)+ sortArrayBy compare arr# 0 (length v)+ in fromList . fmap (\(Arg _ x) -> x) . toList $ sortedArr
test/Arbitrary.hs view
@@ -1,32 +1,64 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE LambdaCase #-} module Arbitrary where #if !(MIN_VERSION_base(4,18,0)) import Control.Applicative (liftA2) #endif-import Data.Foldable (toList)+import Control.Monad.ST+import Data.Bool (bool)+import Debug.Trace import Test.Tasty.QuickCheck -import qualified Data.RRBVector as V+import qualified Data.RRBVector.Internal as V+import qualified Data.RRBVector.Internal.Buffer as Buffer import Data.RRBVector.Internal.Debug -builders :: [[a] -> V.Vector a]-builders = [V.fromList, fromListUnbalanced]+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'+ instance (Arbitrary a) => Arbitrary (V.Vector a) where arbitrary = arbitrary1 shrink = shrink1 -- TODO: improve instance instance Arbitrary1 V.Vector where- liftArbitrary gen = do- build <- elements builders- fmap build (liftArbitrary gen)-- liftShrink shr = concatMap (sequence builders) . liftShrink shr . toList+ liftArbitrary = arbitraryVectorOf -- A custom 'Testable' instance to use 'showTree'. instance {-# OVERLAPPING #-} (Arbitrary a, Show a, Testable prop) => Testable (V.Vector a -> prop) where
test/Main.hs view
@@ -1,6 +1,10 @@+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) @@ -9,3 +13,8 @@ [ properties , strictness ]++main' :: IO ()+main' = do+ vs <- sample' (arbitrary :: Gen (Vector Int))+ for_ vs $ \v -> putStrLn (showTree v)
test/Properties.hs view
@@ -10,12 +10,14 @@ import Control.Applicative (liftA2) #endif import Data.Foldable (Foldable(..))-import Data.List (uncons)+import Data.List (sort, sortBy, sortOn, uncons)+import Data.Ord (comparing) import Data.Proxy (Proxy(..)) import Prelude hiding ((==)) -- use @===@ instead import qualified Data.Sequence as Seq import qualified Data.RRBVector as V+import qualified Data.RRBVector.Internal.Debug as VDebug import Test.QuickCheck.Classes.Base import Test.Tasty import Test.Tasty.QuickCheck@@ -65,6 +67,13 @@ proxyV :: Proxy V proxyV = Proxy +checkValid :: Show a => V a -> Property+checkValid v = case VDebug.valid v of+ Left invariant ->+ counterexample ("Invariant violated: " ++ show invariant) $+ counterexample (VDebug.showTree v) False+ _ -> property ()+ properties :: TestTree properties = testGroup "properties" [ testGroup "fromList"@@ -72,22 +81,27 @@ , testProperty "satisfies `toList . fromList = id`" $ \ls -> toList (V.fromList ls) === ls , testProperty "satisfies `fromList [] = empty`" $ V.fromList [] === V.empty , testProperty "satisfies `fromList [x] = singleton x`" $ \x -> V.fromList [x] === V.singleton x+ , testProperty "valid" $ \xs -> checkValid (V.fromList xs) ] , testGroup "replicate" [ testProperty "satisifes `replicate n == fromList . replicate n`" $ \(Positive n) x -> V.replicate n x === V.fromList (replicate n x) , testProperty "returns the empty vector for non-positive n" $ \(NonPositive n) x -> V.replicate n x === V.empty+ , testProperty "valid" $ \n x -> checkValid (V.replicate n x) ] , testGroup "<|" [ testProperty "prepends an element" $ \x v -> toList (x V.<| v) === x : toList v , testProperty "works for the empty vector" $ \x -> x V.<| V.empty === V.singleton x+ , testProperty "valid" $ \x v -> checkValid (x V.<| v) ] , testGroup "|>" [ testProperty "appends an element" $ \v x -> toList (v V.|> x) === toList v ++ [x] , testProperty "works for the empty vector" $ \x -> V.empty V.|> x === V.singleton x+ , testProperty "valid" $ \v x -> checkValid (v V.|> x) ] , testGroup "><" [ testProperty "concatenates two vectors" $ \v1 v2 -> toList (v1 V.>< v2) === toList v1 ++ toList v2 , testProperty "works for the empty vector" $ \v -> (V.empty V.>< v === v) .&&. (v V.>< V.empty === v)+ , testProperty "valid" $ \v1 v2 -> checkValid (v1 V.>< v2) ] , testGroup "lookup" [ testProperty "gets the element at the index" $ \v (NonNegative i) -> V.lookup i v === lookupList i (toList v)@@ -96,33 +110,41 @@ , testGroup "update" [ testProperty "updates the element at the index" $ \v (NonNegative i) x -> toList (V.update i x v) === updateList i x (toList v) , testProperty "returns the vector for negative indices" $ \v (Negative i) x -> V.update i x v === v+ , testProperty "valid" $ \v i x -> checkValid (V.update i x v) ] , testGroup "adjust" [ testProperty "adjusts the element at the index" $ \v (NonNegative i) (Fn f) -> toList (V.adjust i f v) === adjustList i f (toList v) , testProperty "returns the vector for negative indices" $ \v (Negative i) (Fn f) -> V.adjust i f v === v+ , testProperty "valid" $ \v i (Fn f) -> checkValid (V.adjust i f v) ] , testGroup "adjust'" [ testProperty "adjusts the element at the index" $ \v (NonNegative i) (Fn f) -> toList (V.adjust' i f v) === adjustList i f (toList v) , testProperty "returns the vector for negative indices" $ \v (Negative i) (Fn f) -> V.adjust' i f v === v+ , testProperty "valid" $ \v i (Fn f) -> checkValid (V.adjust' i f v) ] , testGroup "viewl" [ testProperty "works like uncons" $ \v -> fmap (\(x, xs) -> (x, toList xs)) (V.viewl v) === uncons (toList v) , testProperty "works for the empty vector" $ V.viewl V.empty === Nothing+ , testProperty "valid" $ \v -> fmap (checkValid . snd) (V.viewl v) ] , testGroup "viewr" [ testProperty "works like unsnoc" $ \v -> fmap (\(xs, x) -> (toList xs, x)) (V.viewr v) === unsnoc (toList v) , testProperty "works for the empty vector" $ V.viewr V.empty === Nothing+ , testProperty "valid" $ \v -> fmap (checkValid . fst) (V.viewr v) ] , testGroup "take" [ testProperty "takes n elements" $ \v (Positive n) -> toList (V.take n v) === take n (toList v) , testProperty "returns the empty vector for non-positive n" $ \v (NonPositive n) -> V.take n v === V.empty+ , testProperty "valid" $ \v n -> checkValid (V.take n v) ] , testGroup "drop" [ testProperty "drops n elements" $ \v (Positive n) -> toList (V.drop n v) === drop n (toList v) , testProperty "returns the vector for non-positive n" $ \v (NonPositive n) -> V.drop n v === v+ , testProperty "valid" $ \v n -> checkValid (V.drop v n) ] , testGroup "splitAt" [ testProperty "splits the vector" $ \v n -> let (v1, v2) = V.splitAt n v in (toList v1, toList v2) === splitAt n (toList v)+ , testProperty "valid" $ \v n -> let (v1, v2) = V.splitAt n v in checkValid v1 .&&. checkValid v2 ] , testGroup "insertAt" [ testProperty "inserts an element" $ \v i x -> toList (V.insertAt i x v) === insertAtList i x (toList v)@@ -130,6 +152,7 @@ , testProperty "appends for too large indices" $ \v x -> forAll (arbitrary `suchThat` (> length v)) $ \i -> V.insertAt i x v === v V.|> x , testProperty "satisfies `insertAt 0 x v = x <| v`" $ \v x -> V.insertAt 0 x v === x V.<| v , testProperty "satisfies `insertAt (length v) x v = v |> x`" $ \v x -> V.insertAt (length v) x v === v V.|> x+ , testProperty "valid" $ \v i x -> checkValid (V.insertAt i x v) ] , testGroup "deleteAt" [ testProperty "deletes an element" $ \v (NonNegative i) -> toList (V.deleteAt i v) === deleteAtList i (toList v)@@ -137,6 +160,7 @@ , testProperty "returns the vector for too large indices" $ \v -> forAll (arbitrary `suchThat` (>= length v)) $ \i -> V.deleteAt i v === v , testProperty "satisfies `deleteAt 0 v = drop 1 v`" $ \v -> V.deleteAt 0 v === V.drop 1 v , testProperty "satisfies `deleteAt (length v - 1) v = take (length v - 1) v`" $ \v -> V.deleteAt (length v - 1) v === V.take (length v - 1) v+ , testProperty "valid" $ \v i -> checkValid (V.deleteAt i v) ] , testGroup "findIndexL" [ testProperty "finds the first index" $ \v (Fn f) -> V.findIndexL f v === Seq.findIndexL f (Seq.fromList (toList v))@@ -156,16 +180,25 @@ ] , testGroup "reverse" [ testProperty "reverses the vector" $ \v -> toList (V.reverse v) === reverse (toList v)+ , testProperty "valid" $ \v -> checkValid (V.reverse v) ] , testGroup "zip" [ testProperty "zips two vectors" $ \v1 v2 -> toList (V.zip v1 v2) === zip (toList v1) (toList v2)+ , testProperty "valid" $ \v1 v2 -> checkValid (V.zip v1 v2) ] , testGroup "zipWith" [ testProperty "zips two vectors with a function" $ \v1 v2 -> toList (V.zipWith (+) v1 v2) === zipWith (+) (toList v1) (toList v2) , testProperty "satisfies `zipWith (,) v1 v2 = zip v1 v2`" $ \v1 v2 -> V.zipWith (,) v1 v2 === V.zip v1 v2+ , testProperty "valid" $ \v1 v2 (Fn2 f) -> checkValid (V.zipWith f v1 v2) ] , testGroup "unzip" [ testProperty "unzips the vector" $ \v -> (\(xs, ys) -> (toList xs, toList ys)) (V.unzip v) === unzip (toList v)+ , testProperty "valid" $ \v -> let (v1, v2) = V.unzip v in checkValid v1 .&&. checkValid v2+ ]+ , localOption (QuickCheckMaxSize 1000) $ testGroup "sorting"+ [ testProperty "sort" $ \v -> toList (V.sort v) === sort (toList v)+ , testProperty "sortBy" $ \v -> let cmp = comparing fst in toList (V.sortBy cmp v) === sortBy cmp (toList v)+ , testProperty "sortOn" $ \v -> let f = odd in toList (V.sortOn f v) === sortOn f (toList v) ] , instances , laws