diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,15 @@ # Revision history for nonempty-vector +## 1.0 + +* Add immutable and mutable unboxed non-empty vectors in + `Data.Vector.NonEmpty.Unboxed` and `Data.Vector.NonEmpty.Unboxed.Mutable`. + Constructors are available through `Data.Vector.NonEmpty.Unboxed.Internal`. +* Add property tests for the unboxed API +* Delegate boxed `Foldable` methods to the underlying vector and specialize + `Foldable1` operations, including strict folding and non-empty conversion. + +Thanks to Koz Ross (@kozross) for the unboxed API! ## 0.3 * Add `group` and `groupBy`, returning non-empty lists of non-empty vector slices. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -2,6 +2,18 @@ ![Build Status](https://github.com/emilypi/nonempty-vector/actions/workflows/haskell-ci.yml/badge.svg) [![Hackage](https://img.shields.io/hackage/v/nonempty-vector.svg)](https://hackage.haskell.org/package/nonempty-vector) -This package presents thin wrappers around mutable and immutable [Data.Vector](https://hackage.haskell.org/package/vector) types that enforce non-emptiness. The entire Vector API is supported for both sets of boxed vectors, with future plans to support unboxed, primitive, storable, and generic vectors. +This package provides thin wrappers around mutable and immutable +[vector](https://hackage.haskell.org/package/vector) types that enforce +non-emptiness, with APIs for both boxed and unboxed storage. -There are no external dependencies that are not already in `base`. +| Storage | Immutable | Mutable | +| --- | --- | --- | +| Boxed | `Data.Vector.NonEmpty` | `Data.Vector.NonEmpty.Mutable` | +| Unboxed | `Data.Vector.NonEmpty.Unboxed` | `Data.Vector.NonEmpty.Unboxed.Mutable` | + +The unboxed API requires `Unbox` instances for element types. Operations that can +produce an empty result return an ordinary vector or `Maybe`, as appropriate. +The `Internal` modules expose constructors for users who manage the non-emptiness +invariant themselves. + +Library dependencies are `base`, `deepseq`, `primitive`, and `vector`. diff --git a/nonempty-vector.cabal b/nonempty-vector.cabal --- a/nonempty-vector.cabal +++ b/nonempty-vector.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: nonempty-vector -version: 0.3 +version: 1.0 synopsis: Non-empty vectors description: Performant, non-empty mutable and immutable vectors homepage: https://github.com/emilypi/nonempty-vector @@ -31,8 +31,11 @@ library exposed-modules: Data.Vector.NonEmpty + Data.Vector.NonEmpty.Unboxed Data.Vector.NonEmpty.Internal Data.Vector.NonEmpty.Mutable + Data.Vector.NonEmpty.Unboxed.Mutable + Data.Vector.NonEmpty.Unboxed.Internal build-depends: base >=4.16 && <4.23 @@ -50,16 +53,27 @@ main-is: Main.hs other-modules: Test.Data.Vector.NonEmpty.Accessors + Test.Data.Vector.NonEmpty.AccessorsU Test.Data.Vector.NonEmpty.Construction + Test.Data.Vector.NonEmpty.ConstructionU Test.Data.Vector.NonEmpty.Conversion + Test.Data.Vector.NonEmpty.ConversionU Test.Data.Vector.NonEmpty.Elementwise + Test.Data.Vector.NonEmpty.ElementwiseU Test.Data.Vector.NonEmpty.Folds + Test.Data.Vector.NonEmpty.FoldsU Test.Data.Vector.NonEmpty.Grouping + Test.Data.Vector.NonEmpty.GroupingU Test.Data.Vector.NonEmpty.Instances + Test.Data.Vector.NonEmpty.InstancesU Test.Data.Vector.NonEmpty.Modification + Test.Data.Vector.NonEmpty.ModificationU Test.Data.Vector.NonEmpty.Mutable + Test.Data.Vector.NonEmpty.MutableU Test.Data.Vector.NonEmpty.Predicates + Test.Data.Vector.NonEmpty.PredicatesU Test.Data.Vector.NonEmpty.Scans + Test.Data.Vector.NonEmpty.ScansU Test.Data.Vector.NonEmpty.Util build-depends: diff --git a/src/Data/Vector/NonEmpty/Internal.hs b/src/Data/Vector/NonEmpty/Internal.hs --- a/src/Data/Vector/NonEmpty/Internal.hs +++ b/src/Data/Vector/NonEmpty/Internal.hs @@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} -- | @@ -37,6 +38,7 @@ import Data.Data (Data) import qualified Data.Foldable as Foldable +import Data.List.NonEmpty (NonEmpty((:|))) #if MIN_VERSION_base(4,18,0) import Data.Foldable1 (Foldable1) import qualified Data.Foldable1 as Foldable1 @@ -76,6 +78,7 @@ , Functor, Applicative, Monad , MonadZip , Semigroup + , Traversable ) instance Show a => Show (NonEmptyVector a) where @@ -93,28 +96,46 @@ instance Foldable NonEmptyVector where foldMap f = Foldable.foldMap f . _neVec + foldr f x = Foldable.foldr f x . _neVec + foldl f x = Foldable.foldl f x . _neVec + foldr1 f = Foldable.foldr1 f . _neVec + foldl1 f = Foldable.foldl1 f . _neVec + foldr' f x = Foldable.foldr' f x . _neVec + foldl' f x = Foldable.foldl' f x . _neVec + toList = Foldable.toList . _neVec + length = Foldable.length . _neVec + null = const False + elem x = Foldable.elem x . _neVec + maximum = Foldable.maximum . _neVec + minimum = Foldable.minimum . _neVec + sum = Foldable.sum . _neVec + product = Foldable.product . _neVec #if MIN_VERSION_base(4,18,0) instance Foldable1 NonEmptyVector where - foldMap1 f (NonEmptyVector v) = - let - h = V.unsafeHead v -- guaranteed head (nonemptiness) - t = V.unsafeTail v -- guaranteed possibly empty tail - in go (f h) t -- therefore this is a sound call - where - go x xs - -- when xs is empty, vector is exhausted, return x - | V.null xs = x - | otherwise = - -- if xs is not empty, then there are at least 2 elements in the list. Hence, h and t are sound calls to make. - let - h = V.unsafeHead xs - t = V.unsafeTail xs - in x <> go (f h) t + foldMap1 f (NonEmptyVector v) = + let + projected = fmap f v + h = V.unsafeHead projected -- guaranteed head (nonemptiness) + t = V.unsafeTail projected -- guaranteed possibly empty tail + -- Defer to `Vector`'s underlying folding mechanism. + -- Direction doesn't matter since we're associative anyway. + in V.foldl (<>) h t + foldMap1' f (NonEmptyVector v) = + let + projected = fmap f v + h = V.unsafeHead projected + t = V.unsafeTail projected + in V.foldl' (<>) h t + toNonEmpty (NonEmptyVector v) = + let h = V.unsafeHead v + t = V.unsafeTail v + in h :| V.toList t + maximum = V.maximum . _neVec + minimum = V.minimum . _neVec + head = V.unsafeHead . _neVec + last (NonEmptyVector v) = V.unsafeIndex v (V.length v - 1) #endif - -instance Traversable NonEmptyVector where - traverse f = fmap NonEmptyVector . traverse f . _neVec -- ---------------------------------------------------------------------- -- -- Non-empty mutable vectors diff --git a/src/Data/Vector/NonEmpty/Unboxed.hs b/src/Data/Vector/NonEmpty/Unboxed.hs new file mode 100644 --- /dev/null +++ b/src/Data/Vector/NonEmpty/Unboxed.hs @@ -0,0 +1,2768 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE CPP #-} +-- | +-- Module : Data.Vector.NonEmpty.Unboxed +-- Copyright : (c) 2019-2026 Emily Pillmore, Koz Ross +-- License : BSD-style +-- Maintainer : Emily Pillmore +-- Stability : Experimental +-- Portability : DataTypeable, CPP +-- +-- A library for non-empty unboxed vectors (that is, polymorphic arrays capable of +-- holding any value whose type has an 'V.Unbox' isntance). Non-empty vectors come in +-- two flavors: +-- +-- * mutable +-- +-- * immutable +-- +-- This library attempts to provide support for all standard 'Vector' operations +-- in the API, with some slight variation in types and implementation. For example, +-- since 'head' and 'foldr' are always guaranteed to be over a non-empty 'Vector', +-- it is safe to make use of the 'unsafe-*' 'Vector' operations and semigroupal +-- folds available in the API in lieu of the standard implementations. +-- +-- In contrast, some operations such as 'filter' may "break out" of a t'NonEmptyUVector' +-- due to the fact that there are no guarantees that may be made on the types of +-- 'Bool'-valued functions passed in, hence one could write the following: +-- +-- @ +-- filter (const false) v +-- @ +-- +-- which always produces an empty vector. Thus, some operations must return either +-- a 'Maybe' containing a t'NonEmptyUVector' or a 'Vector' whenever appropriate. Generally +-- The former is used in initialization and generation operations, and the latter +-- is used in iterative operations where the intent is not to create an instance +-- of t'NonEmptyUVector'. +-- +-- Credit to Roman Leshchinskiy for the original Vector library upon which this is based. +-- +module Data.Vector.NonEmpty.Unboxed +( -- * Boxed non-empty vectors + NonEmptyUVector + + -- * Accessors + + -- ** Length information +, length + + -- ** Indexing +, head, last, (!), (!?) +, unsafeIndex + + -- ** Monadic Indexing +, headM, lastM, indexM, unsafeIndexM + + -- ** Extracting subvectors (slicing) +, tail, slice, init, take, drop +, uncons, unsnoc, splitAt +, unsafeSlice, unsafeTake, unsafeDrop + + -- * Construction + + -- ** Initialization +, singleton +, replicate, replicate1 +, generate, generate1 +, iterateN, iterateN1 + + -- ** Monad Initialization +, replicateM, replicate1M +, generateM, generate1M +, iterateNM, iterateN1M +, create, unsafeCreate +, createT, unsafeCreateT + + -- ** Unfolding +, unfoldr, unfoldr1 +, unfoldrN, unfoldr1N +, unfoldrM, unfoldr1M +, unfoldrNM, unfoldr1NM +, constructN, constructrN + + -- ** Enumeration +, enumFromN, enumFromN1 +, enumFromStepN, enumFromStepN1 +, enumFromTo, enumFromThenTo + + -- ** Concatenation +, cons, consV, snoc, snocV, (++), concat, concat1 + + -- ** Restricting memory usage +, force + + -- * Conversion + + -- ** To/from non-empty lists +, toNonEmpty, fromNonEmpty +, fromNonEmptyN, fromNonEmptyN1 +, unsafeFromList + + -- ** To/from vector +, toVector, fromVector, unsafeFromVector + + -- ** To/from list +, toList, fromList, fromListN + + -- * Modifying non-empty vectors + + -- ** Bulk Updates +, (//), update, update_ +, unsafeUpd, unsafeUpdate, unsafeUpdate_ + + -- * Accumulations +, accum, accumulate, accumulate_ +, unsafeAccum, unsafeAccumulate, unsafeAccumulate_ + + -- * Permutations +, reverse, backpermute, unsafeBackpermute + + -- * Safe destructive updates +, modify + + -- * Elementwise operations + + -- ** Indexing +, indexed + + -- ** Mapping +, map, imap, concatMap + + -- ** Monadic mapping +, mapM, imapM, mapM_, imapM_ +, forM, forM_ + + -- ** Zipping +, zipWith, zipWith3, zipWith4, zipWith5, zipWith6 +, izipWith, izipWith3, izipWith4, izipWith5, izipWith6 +, zip, zip3, zip4, zip5, zip6 + + -- ** Monadic Zipping +, zipWithM, zipWithM_, izipWithM, izipWithM_ + + -- ** Unzipping +, unzip, unzip3, unzip4, unzip5, unzip6 + + -- * Working with predicates + + -- ** Filtering +, uniq, mapMaybe, imapMaybe +, filter, ifilter, filterM, ifilterM +, takeWhile, dropWhile + + -- * Partitioning +, partition, partitionWith, unstablePartition, span, break + + -- * Searching +, elem, notElem, find, findIndex, findIndices, elemIndex +, elemIndices + + -- * Folding +, foldl, foldl1, foldl', foldl1' +, foldr, foldr1, foldr', foldr1' +, ifoldl, ifoldl', ifoldr, ifoldr' + + -- * Specialized folds +, all, any, and, or, sum, product +, maximum, maximumBy, minimum, minimumBy +, maxIndex, maxIndexBy, minIndex, minIndexBy + + -- * Monadic Folds +, foldM, foldM', fold1M, fold1M', foldM_, foldM'_, fold1M_ +, fold1M'_, ifoldM, ifoldM', ifoldM_, ifoldM'_ + + -- * Prefix sums (scans) +, prescanl, prescanl', postscanl, postscanl' +, scanl, scanl', scanl1, scanl1', iscanl, iscanl' +, prescanr, prescanr', postscanr, postscanr' +, scanr, scanr', scanr1, scanr1', iscanr, iscanr' + + -- ** Transformations +, intersperse + + -- ** Grouping +, group +, groupBy + +) where + + +import Prelude ( Bool, Eq, Ord, Num, Enum + , (.), Ordering, max, uncurry, snd + , pure, (+), otherwise, (>=), (-), (*), ($), (<=) + , (==), not) + +import Control.Monad (Monad) +import Control.Monad.ST + +import qualified Data.Foldable as Foldable +import Data.Either (Either(..)) +#if MIN_VERSION_base(4,19,0) +-- This import will only execute if compiling with base >= 4.19.0.0 (GHC 9.8+) +import Data.Functor hiding (unzip) +#else +import Data.Functor +#endif +import Data.Int +import Data.List.NonEmpty (NonEmpty(..), (<|)) +import qualified Data.List.NonEmpty as NonEmpty +import Data.Kind (Type) +import Data.Maybe (Maybe(..)) +import Data.Semigroup (Semigroup(..), (<>)) +import Data.Traversable (Traversable) +import Data.Vector.Unboxed (Vector) +import qualified Data.Vector.Unboxed as V +import qualified Data.Vector.Generic as G +import Data.Vector.Unboxed.Mutable (MVector, unsafeWrite) +import Data.Vector.NonEmpty.Unboxed.Internal + + +-- $setup +-- >>> import Prelude (Int, String, ($), (.), (+), (<), const, return, Maybe(..), Either(..)) +-- >>> import Data.Bool +-- >>> import Data.Eq +-- >>> import qualified Prelude as P +-- >>> import qualified Data.Vector.Unboxed as V +-- >>> import Data.List.NonEmpty (NonEmpty(..)) +-- >>> import qualified Data.List.NonEmpty as NEL +-- >>> :set -XTypeApplications +-- >>> :set -XScopedTypeVariables + +-- ---------------------------------------------------------------------- -- +-- Accessors + Indexing + +-- | /O(1)/ Length. +-- +-- >>> length $ unsafeFromList [1..10] +-- 10 +-- +length :: V.Unbox a => NonEmptyUVector a -> Int +length = V.length . _neUvec +{-# INLINE length #-} + +-- | /O(1)/ First element. Since head is guaranteed, bounds checks +-- are bypassed by deferring to 'Data.Vector.unsafeHead'. +-- +-- +-- >>> head $ unsafeFromList [1..10] +-- 1 +-- +head :: V.Unbox a => NonEmptyUVector a -> a +head = V.unsafeHead . _neUvec +{-# INLINE head #-} + +-- | /O(1)/ Last element. Since a last element is guaranteed, bounds checks +-- are bypassed by deferring to 'Data.Vector.unsafeLast'. +-- +-- +-- >>> last $ unsafeFromList [1..10] +-- 10 +-- +last :: V.Unbox a => NonEmptyUVector a -> a +last = V.unsafeLast . _neUvec +{-# INLINE last #-} + +-- | /O(1)/ Indexing. +-- +-- +-- >>> (unsafeFromList [1..10]) ! 0 +-- 1 +-- +(!) :: V.Unbox a => NonEmptyUVector a -> Int -> a +(!) (NonEmptyUVector as) n = as V.! n +{-# INLINE (!) #-} + +-- | /O(1)/ Safe indexing. +-- +-- +-- >>> (unsafeFromList [1..10]) !? 0 +-- Just 1 +-- +-- >>> (unsafeFromList [1..10]) !? 11 +-- Nothing +-- +(!?) :: V.Unbox a => NonEmptyUVector a -> Int -> Maybe a +(NonEmptyUVector as) !? n = as V.!? n +{-# INLINE (!?) #-} + +-- | /O(1)/ Unsafe indexing without bounds checking +-- +unsafeIndex :: V.Unbox a => NonEmptyUVector a -> Int -> a +unsafeIndex (NonEmptyUVector as) n = V.unsafeIndex as n +{-# INLINE unsafeIndex #-} + +-- ---------------------------------------------------------------------- -- +-- Monadic Indexing + +-- | /O(1)/ Indexing in a monad. +-- +-- The monad allows operations to be strict in the non-empty vector when +-- necessary. +-- +-- See 'Data.Vector.indexM' for more details +-- +-- +-- >>> indexM @[] (unsafeFromList [1..10]) 3 +-- [4] +-- +indexM :: (Monad m, V.Unbox a) => NonEmptyUVector a -> Int -> m a +indexM (NonEmptyUVector v) n = V.indexM v n +{-# INLINE indexM #-} + +-- | /O(1)/ First element of a non-empty vector in a monad. +-- +-- See 'Data.Vector.indexM' for an explanation of why this is useful. +-- +-- Note that this function defers to 'Data.Vector.unsafeHeadM' since head is +-- guaranteed to be safe by construction. +-- +-- +-- >>> headM @[] (unsafeFromList [1..10]) +-- [1] +-- +headM :: (Monad m, V.Unbox a) => NonEmptyUVector a -> m a +headM (NonEmptyUVector v) = V.unsafeHeadM v +{-# INLINE headM #-} + +-- | /O(1)/ Last element of a non-empty vector in a monad. See 'Data.Vector.indexM' +-- for an explanation of why this is useful. +-- +-- Note that this function defers to 'Data.Vector.unsafeLastM' since a last element is +-- guaranteed. +-- +-- +-- >>> lastM @[] (unsafeFromList [1..10]) +-- [10] +-- +lastM :: (Monad m, V.Unbox a) => NonEmptyUVector a -> m a +lastM (NonEmptyUVector v) = V.unsafeLastM v +{-# INLINE lastM #-} + +-- | O(1) Indexing in a monad without bounds checks. See 'indexM' for an +-- explanation of why this is useful. +-- +unsafeIndexM :: (Monad m, V.Unbox a) => NonEmptyUVector a -> Int -> m a +unsafeIndexM (NonEmptyUVector v) n = V.unsafeIndexM v n +{-# INLINE unsafeIndexM #-} + +-- ---------------------------------------------------------------------- -- +-- Extracting subvectors (slicing) + +-- | /O(1)/ Yield all but the first element without copying. Since the +-- vector returned may be empty (i.e. input was a singleton), this function +-- returns a normal 'Vector' +-- +-- +-- >>> tail (unsafeFromList [1..10]) +-- [2,3,4,5,6,7,8,9,10] +-- +tail :: V.Unbox a => NonEmptyUVector a -> Vector a +tail = V.unsafeTail . _neUvec +{-# INLINE tail #-} + +-- | /O(1)/ Yield a slice of a non-empty vector without copying at +-- the @0@th and @1@st indices. +-- +-- +-- >>> uncons (unsafeFromList [1..10]) +-- (1,[2,3,4,5,6,7,8,9,10]) +-- +uncons :: V.Unbox a => NonEmptyUVector a -> (a, Vector a) +uncons v = (head v, tail v) +{-# INLINE uncons #-} + +-- | /O(1)/ Yield a slice of a non-empty vector without copying at +-- the @n-1@th and @nth@ indices +-- +-- +-- >>> unsnoc (unsafeFromList [1..10]) +-- ([1,2,3,4,5,6,7,8,9],10) +-- +unsnoc :: V.Unbox a => NonEmptyUVector a -> (Vector a, a) +unsnoc v = (init v, last v) +{-# INLINE unsnoc #-} + +-- | /O(1)/ Yield a slice of the non-empty vector without copying it. +-- The vector must contain at least i+n elements. Because this is not +-- guaranteed, this function returns a 'Vector' which could be empty +-- +-- +-- >>> slice 0 3 (unsafeFromList [1..10]) +-- [1,2,3] +-- +slice :: V.Unbox a => Int -> Int -> NonEmptyUVector a -> Vector a +slice i n = V.slice i n . _neUvec +{-# INLINE slice #-} + +-- | /O(1)/ Yield all but the last element without copying. Since the +-- vector returned may be empty (i.e. input was a singleton), this function +-- returns a normal 'Vector' +-- +-- +-- >>> init (unsafeFromList [1..3]) +-- [1,2] +-- +init :: V.Unbox a => NonEmptyUVector a -> Vector a +init = V.unsafeInit . _neUvec +{-# INLINE init #-} + +-- | /O(1)/ Yield at the first n elements without copying. The non-empty vector may +-- contain less than n elements in which case it is returned as a vector unchanged. +-- +-- +-- >>> take 2 (unsafeFromList [1..3]) +-- [1,2] +-- +take :: V.Unbox a => Int -> NonEmptyUVector a -> Vector a +take n = V.take n . _neUvec +{-# INLINE take #-} + +-- | /O(1)/ Yield all but the first n elements without copying. The non-empty vector +-- may contain less than n elements in which case an empty vector is returned. +-- +-- +-- >>> drop 2 (unsafeFromList [1..3]) +-- [3] +-- +drop :: V.Unbox a => Int -> NonEmptyUVector a -> Vector a +drop n = V.drop n . _neUvec +{-# INLINE drop #-} + +-- | /O(1)/ Yield the first n elements paired with the remainder without copying. +-- +-- This function returns a pair of vectors, as one may slice a (0, n+1). +-- +-- +-- >>> splitAt 2 (unsafeFromList [1..3]) +-- ([1,2],[3]) +-- +splitAt :: V.Unbox a => Int -> NonEmptyUVector a -> (Vector a, Vector a) +splitAt n = V.splitAt n . _neUvec +{-# INLINE splitAt #-} + +-- | /O(1)/ Yield a slice of the vector without copying. The vector must contain at +-- least i+n elements but this is not checked. +-- +unsafeSlice :: V.Unbox a => Int -> Int -> NonEmptyUVector a -> Vector a +unsafeSlice i n = V.unsafeSlice i n . _neUvec +{-# INLINE unsafeSlice #-} + +-- | /O(1)/ Yield the first n elements without copying. The vector must contain at +-- least n elements but this is not checked. +-- +unsafeTake :: V.Unbox a => Int -> NonEmptyUVector a -> Vector a +unsafeTake n = V.unsafeTake n . _neUvec +{-# INLINE unsafeTake #-} + +-- | /O(1)/ Yield all but the first n elements without copying. The vector must contain +-- at least n elements but this is not checked. +-- +unsafeDrop :: V.Unbox a => Int -> NonEmptyUVector a -> Vector a +unsafeDrop n = V.unsafeDrop n . _neUvec +{-# INLINE unsafeDrop #-} + +-- ---------------------------------------------------------------------- -- +-- Construction + +-- | /O(1)/ Non-empty vector with exactly one element +-- +-- +-- >>> singleton "a" +-- ["a"] +-- +singleton :: V.Unbox a => a -> NonEmptyUVector a +singleton = NonEmptyUVector . V.singleton +{-# INLINE singleton #-} + +-- | /O(n)/ Non-empty vector of the given length with the same value in +-- each position. +-- +-- When given a index n <= 0, then 'Nothing' is returned, otherwise 'Just'. +-- +-- +-- >>> replicate 3 "a" +-- Just ["a","a","a"] +-- +-- >>> replicate 0 "a" +-- Nothing +-- +replicate :: V.Unbox a => Int -> a -> Maybe (NonEmptyUVector a) +replicate n a = fromVector (V.replicate n a) +{-# INLINE replicate #-} + +-- | /O(n)/ Non-empty vector of the given length with the same value in +-- each position. +-- +-- This variant takes @max n 1@ for the supplied length parameter. +-- +-- +-- >>> replicate1 3 "a" +-- ["a","a","a"] +-- +-- >>> replicate1 0 "a" +-- ["a"] +-- +-- >>> replicate1 (-1) "a" +-- ["a"] +-- +replicate1 :: V.Unbox a => Int -> a -> NonEmptyUVector a +replicate1 n a = unsafeFromVector (V.replicate (max n 1) a) +{-# INLINE replicate1 #-} + +-- | /O(n)/ Construct a vector of the given length by applying the function to +-- each index. +-- +-- When given a index n <= 0, then 'Nothing' is returned, otherwise 'Just'. +-- +-- +-- >>> let f 0 = "a"; f _ = "k"; f :: Int -> String +-- +-- >>> generate 1 f +-- Just ["a"] +-- +-- >>> generate 0 f +-- Nothing +-- +-- >>> generate 2 f +-- Just ["a","k"] +-- +generate :: V.Unbox a => Int -> (Int -> a) -> Maybe (NonEmptyUVector a) +generate n f = fromVector (V.generate n f) +{-# INLINE generate #-} + +-- | /O(n)/ Construct a vector of the given length by applying the function to +-- each index. +-- +-- This variant takes @max n 1@ for the supplied length parameter. +-- +-- +-- >>> let f 0 = "a"; f _ = "k"; f :: Int -> String +-- +-- >>> generate1 2 f +-- ["a","k"] +-- +-- >>> generate1 0 f +-- ["a"] +-- +-- >>> generate1 (-1) f +-- ["a"] +-- +generate1 :: V.Unbox a => Int -> (Int -> a) -> NonEmptyUVector a +generate1 n f = unsafeFromVector (V.generate (max n 1) f) +{-# INLINE generate1 #-} + +-- | /O(n)/ Apply function n times to value. Zeroth element is original value. +-- +-- When given a index n <= 0, then 'Nothing' is returned, otherwise 'Just'. +-- +-- >>> iterateN 3 (+1) 0 +-- Just [0,1,2] +-- +-- >>> iterateN 0 (+1) 0 +-- Nothing +-- +-- >>> iterateN (-1) (+1) 0 +-- Nothing +-- +iterateN :: V.Unbox a => Int -> (a -> a) -> a -> Maybe (NonEmptyUVector a) +iterateN n f a = fromVector (V.iterateN n f a) +{-# INLINE iterateN #-} + +-- | /O(n)/ Apply function n times to value. Zeroth element is original value. +-- +-- This variant takes @max n 1@ for the supplied length parameter. +-- +-- +-- >>> iterateN1 3 (+1) 0 +-- [0,1,2] +-- +-- >>> iterateN1 0 (+1) 0 +-- [0] +-- +-- >>> iterateN1 (-1) (+1) 0 +-- [0] +-- +iterateN1 :: V.Unbox a => Int -> (a -> a) -> a -> NonEmptyUVector a +iterateN1 n f a = unsafeFromVector (V.iterateN (max n 1) f a) +{-# INLINE iterateN1 #-} + +-- ---------------------------------------------------------------------- -- +-- Monadic Initialization + +-- | /O(n)/ Execute the monadic action the given number of times and store +-- the results in a vector. +-- +-- When given a index n <= 0, then 'Nothing' is returned, otherwise 'Just'. +-- +-- +-- >>> replicateM @Maybe 3 (Just "a") +-- Just (Just ["a","a","a"]) +-- +-- >>> replicateM @Maybe 3 Nothing +-- Nothing +-- +-- >>> replicateM @Maybe 0 (Just "a") +-- Just Nothing +-- +-- >>> replicateM @Maybe (-1) (Just "a") +-- Just Nothing +-- +replicateM :: (Monad m, V.Unbox a) => Int -> m a -> m (Maybe (NonEmptyUVector a)) +replicateM n a = fmap fromVector (V.replicateM n a) +{-# INLINE replicateM #-} + +-- | /O(n)/ Execute the monadic action the given number of times and store +-- the results in a vector. +-- +-- This variant takes @max n 1@ for the supplied length parameter. +-- +-- +-- >>> replicate1M @Maybe 3 (Just "a") +-- Just ["a","a","a"] +-- +-- >>> replicate1M @Maybe 3 Nothing +-- Nothing +-- +-- >>> replicate1M @Maybe 0 (Just "a") +-- Just ["a"] +-- +-- >>> replicate1M @Maybe (-1) (Just "a") +-- Just ["a"] +-- +replicate1M :: (Monad m, V.Unbox a) => Int -> m a -> m (NonEmptyUVector a) +replicate1M n a = fmap unsafeFromVector (V.replicateM (max n 1) a) +{-# INLINE replicate1M #-} + +-- | /O(n)/ Construct a vector of the given length by applying the monadic +-- action to each index +-- +-- When given a index n <= 0, then 'Nothing' is returned, otherwise 'Just'. +-- +-- >>> generateM 3 (\i -> if i P.< 1 then ["a"] else ["b"]) +-- [Just ["a","b","b"]] +-- +-- >>> generateM @[] @Int 3 (const []) +-- [] +-- +-- >>> generateM @[] @Int 0 (const [1]) +-- [Nothing] +-- +-- >>> generateM @Maybe @Int (-1) (const Nothing) +-- Just Nothing +-- +generateM :: (Monad m, V.Unbox a) => Int -> (Int -> m a) -> m (Maybe (NonEmptyUVector a)) +generateM n f = fmap fromVector (V.generateM n f) +{-# INLINE generateM #-} + +-- | /O(n)/ Construct a vector of the given length by applying the monadic +-- action to each index +-- +-- This variant takes @max n 1@ for the supplied length parameter. +-- +-- >>> generate1M 3 (\i -> if i P.< 1 then Just "a" else Just "b") +-- Just ["a","b","b"] +-- +-- >>> generate1M 3 (const []) +-- [] +-- +-- >>> generate1M 0 (const $ Just 1) +-- Just [1] +-- +-- >>> generate1M (-1) (const Nothing) +-- Nothing +-- +generate1M :: (Monad m, V.Unbox a) => Int -> (Int -> m a) -> m (NonEmptyUVector a) +generate1M n f = fmap unsafeFromVector (V.generateM (max n 1) f) +{-# INLINE generate1M #-} + +-- | /O(n)/ Apply monadic function n times to value. Zeroth element is +-- original value. +-- +-- When given a index n <= 0, then 'Nothing' is returned, otherwise 'Just'. +-- +-- +-- >>> iterateNM @Maybe 3 return "a" +-- Just (Just ["a","a","a"]) +-- +-- >>> iterateNM @Maybe 3 (const Nothing) "a" +-- Nothing +-- +-- >>> iterateNM @Maybe 0 return "a" +-- Just Nothing +-- +iterateNM :: (Monad m, V.Unbox a) => Int -> (a -> m a) -> a -> m (Maybe (NonEmptyUVector a)) +iterateNM n f a = fmap fromVector (V.iterateNM n f a) +{-# INLINE iterateNM #-} + +-- | /O(n)/ Apply monadic function n times to value. Zeroth element is +-- original value. +-- +-- This variant takes @max n 1@ for the supplied length parameter. +-- +-- +-- >>> iterateN1M @Maybe 3 return "a" +-- Just ["a","a","a"] +-- +-- >>> iterateN1M @Maybe 3 (const Nothing) "a" +-- Nothing +-- +-- >>> iterateN1M @Maybe 0 return "a" +-- Just ["a"] +-- +-- >>> iterateN1M @Maybe (-1) return "a" +-- Just ["a"] +-- +iterateN1M :: (Monad m, V.Unbox a) => Int -> (a -> m a) -> a -> m (NonEmptyUVector a) +iterateN1M n f a = fmap unsafeFromVector (V.iterateNM (max n 1) f a) +{-# INLINE iterateN1M #-} + +-- | Execute the monadic action and freeze the resulting non-empty vector. +-- +create :: V.Unbox a => (forall s. ST s (MVector s a)) -> Maybe (NonEmptyUVector a) +create p = fromVector (G.create p) +{-# INLINE create #-} + +-- | Execute the monadic action and freeze the resulting non-empty vector, +-- bypassing emptiness checks. +-- +-- The onus is on the caller to guarantee the created vector is non-empty. +-- +unsafeCreate :: V.Unbox a => (forall s. ST s (MVector s a)) -> NonEmptyUVector a +unsafeCreate p = unsafeFromVector (G.create p) +{-# INLINE unsafeCreate #-} + +-- | Execute the monadic action and freeze the resulting non-empty vector. +-- +createT + :: (Traversable t, V.Unbox a) + => (forall s. ST s (t (MVector s a))) + -> t (Maybe (NonEmptyUVector a)) +createT p = fmap fromVector (G.createT p) +{-# INLINE createT #-} + +-- | Execute the monadic action and freeze the resulting non-empty vector. +-- +-- The onus is on the caller to guarantee the created vector is non-empty. +-- +unsafeCreateT + :: (Traversable t, V.Unbox a) + => (forall s. ST s (t (MVector s a))) + -> t (NonEmptyUVector a) +unsafeCreateT p = fmap unsafeFromVector (G.createT p) +{-# INLINE unsafeCreateT #-} + +-- ---------------------------------------------------------------------- -- +-- Unfolding + +-- | /O(n)/ Construct a non-empty vector by repeatedly applying the +-- generator function to a seed. The generator function yields 'Just' the +-- next element and the new seed or 'Nothing' if there are no more +-- elements. +-- +-- If an unfold does not create meaningful values, 'Nothing' is +-- returned. Otherwise, 'Just' containing a non-empty vector is returned. +-- +-- +-- >>> unfoldr (\b -> case b of "a" -> Just ("a", "b"); _ -> Nothing) "a" +-- Just ["a"] +-- +-- >>> unfoldr (const Nothing) "a" +-- Nothing +-- +unfoldr :: V.Unbox a => (b -> Maybe (a, b)) -> b -> Maybe (NonEmptyUVector a) +unfoldr f b = fromVector (V.unfoldr f b) +{-# INLINE unfoldr #-} + +-- | /O(n)/ Construct a non-empty vector by repeatedly applying the +-- generator function to a seed and a first element. +-- +-- This variant of 'unfoldr' guarantees the resulting vector is non- +-- empty by supplying an initial element @a@. +-- +-- +-- >>> unfoldr1 (\b -> case b of "a" -> Just ("a", "b"); _ -> Nothing) "first" "a" +-- ["first","a"] +-- +-- >>> unfoldr1 (const Nothing) "first" "a" +-- ["first"] +-- +unfoldr1 :: V.Unbox a => (b -> Maybe (a, b)) -> a -> b -> NonEmptyUVector a +unfoldr1 f a b = cons a (unsafeFromVector (V.unfoldr f b)) +{-# INLINE unfoldr1 #-} + +-- | /O(n)/ Construct a vector with at most n elements by repeatedly +-- applying the generator function to a seed. The generator function yields +-- 'Just' the next element and the new seed or 'Nothing' if there are no +-- more elements. +-- +-- If an unfold does not create meaningful values, 'Nothing' is +-- returned. Otherwise, 'Just' containing a non-empty vector is returned. +-- +-- +-- >>> unfoldrN 3 (\b -> Just (b+1, b+1)) 0 +-- Just [1,2,3] +-- +-- >>> unfoldrN 3 (const Nothing) 0 +-- Nothing +-- +-- >>> unfoldrN 0 (\b -> Just (b+1, b+1)) 0 +-- Nothing +-- +unfoldrN :: V.Unbox a => Int -> (b -> Maybe (a, b)) -> b -> Maybe (NonEmptyUVector a) +unfoldrN n f b = fromVector (V.unfoldrN n f b) +{-# INLINE unfoldrN #-} + +-- | /O(n)/ Construct a vector with at most n elements by repeatedly +-- applying the generator function to a seed. The generator function yields +-- 'Just' the next element and the new seed or 'Nothing' if there are no +-- more elements. +-- +-- This variant of 'unfoldrN' guarantees the resulting vector is non- +-- empty by supplying an initial element @a@. +-- +-- +-- >>> unfoldr1N 3 (\b -> Just (b+1, b+1)) 0 0 +-- [0,1,2,3] +-- +-- >>> unfoldr1N 3 (const Nothing) 0 0 +-- [0] +-- +-- >>> unfoldr1N 0 (\b -> Just (b+1, b+1)) 0 0 +-- [0] +-- +unfoldr1N + :: V.Unbox a + => Int + -> (b -> Maybe (a, b)) + -> a + -> b + -> NonEmptyUVector a +unfoldr1N n f a b = cons a (unsafeFromVector (V.unfoldrN n f b)) +{-# INLINE unfoldr1N #-} + +-- | /O(n)/ Construct a non-empty vector by repeatedly applying the monadic generator +-- function to a seed. The generator function yields Just the next element +-- and the new seed or Nothing if there are no more elements. +-- +-- If an unfold does not create meaningful values, 'Nothing' is +-- returned. Otherwise, 'Just' containing a non-empty vector is returned. +-- +unfoldrM + :: (V.Unbox a, Monad m) + => (b -> m (Maybe (a, b))) + -> b + -> m (Maybe (NonEmptyUVector a)) +unfoldrM f b = fmap fromVector (V.unfoldrM f b) +{-# INLINE unfoldrM #-} + +-- | /O(n)/ Construct a non-empty vector by repeatedly applying the monadic generator +-- function to a seed. The generator function yields Just the next element +-- and the new seed or Nothing if there are no more elements. +-- +-- This variant of 'unfoldrM' guarantees the resulting vector is non- +-- empty by supplying an initial element @a@. +-- +unfoldr1M + :: (Monad m, V.Unbox a) + => (b -> m (Maybe (a, b))) + -> a + -> b + -> m (NonEmptyUVector a) +unfoldr1M f a b = fmap (cons a . unsafeFromVector) (V.unfoldrM f b) +{-# INLINE unfoldr1M #-} + +-- | /O(n)/ Construct a non-empty vector by repeatedly applying the monadic generator +-- function to a seed. The generator function yields Just the next element and +-- the new seed or Nothing if there are no more elements. +-- +-- If an unfold does not create meaningful values, 'Nothing' is +-- returned. Otherwise, 'Just' containing a non-empty vector is returned. +-- +unfoldrNM + :: (V.Unbox a, Monad m) + => Int + -> (b -> m (Maybe (a, b))) + -> b + -> m (Maybe (NonEmptyUVector a)) +unfoldrNM n f b = fmap fromVector (V.unfoldrNM n f b) +{-# INLINE unfoldrNM #-} + +-- | /O(n)/ Construct a non-empty vector by repeatedly applying the monadic generator +-- function to a seed. The generator function yields Just the next element and +-- the new seed or Nothing if there are no more elements. +-- +-- This variant of 'unfoldrNM' guarantees the resulting vector is non- +-- empty by supplying an initial element @a@. +-- +unfoldr1NM + :: (V.Unbox a, Monad m) + => Int + -> (b -> m (Maybe (a, b))) + -> a + -> b + -> m (NonEmptyUVector a) +unfoldr1NM n f a b = fmap (cons a . unsafeFromVector) (V.unfoldrNM n f b) +{-# INLINE unfoldr1NM #-} + +-- | /O(n)/ Construct a non-empty vector with n elements by repeatedly applying the +-- generator function to the already constructed part of the vector. +-- +-- If 'constructN' does not create meaningful values, 'Nothing' is +-- returned. Otherwise, 'Just' containing a non-empty vector is returned. +-- +constructN :: V.Unbox a => Int -> (Vector a -> a) -> Maybe (NonEmptyUVector a) +constructN n f = fromVector (V.constructN n f) +{-# INLINE constructN #-} + +-- | /O(n)/ Construct a vector with n elements from right to left by repeatedly +-- applying the generator function to the already constructed part of the vector. +-- +-- If 'constructrN' does not create meaningful values, 'Nothing' is +-- returned. Otherwise, 'Just' containing a non-empty vector is returned. +-- +constructrN :: V.Unbox a => Int -> (Vector a -> a) -> Maybe (NonEmptyUVector a) +constructrN n f = fromVector (V.constructrN n f) +{-# INLINE constructrN #-} + +-- ---------------------------------------------------------------------- -- +-- Enumeration + +-- | /O(n)/ Yield a non-emptyvector of the given length containing the +-- values x, x+1 etc. This operation is usually more efficient than +-- 'enumFromTo'. +-- +-- If an enumeration does not use meaningful indices, 'Nothing' is returned, +-- otherwise, 'Just' containing a non-empty vector. +-- +enumFromN :: (V.Unbox a, Num a) => a -> Int -> Maybe (NonEmptyUVector a) +enumFromN a n = fromVector (V.enumFromN a n) +{-# INLINE enumFromN #-} + +-- | /O(n)/ Yield a non-emptyvector of length @max n 1@ containing the +-- values x, x+1 etc. This operation is usually more efficient than +-- 'enumFromTo'. +-- +enumFromN1 :: (V.Unbox a, Num a) => a -> Int -> NonEmptyUVector a +enumFromN1 a n = unsafeFromVector (V.enumFromN a (max n 1)) +{-# INLINE enumFromN1 #-} + +-- | /O(n)/ Yield a non-empty vector of the given length containing the +-- values x, x+y, x+y+y etc. This operations is usually more efficient than +-- 'enumFromThenTo'. +-- +-- If an enumeration does not use meaningful indices, 'Nothing' is returned, +-- otherwise, 'Just' containing a non-empty vector. +-- +enumFromStepN :: (V.Unbox a, Num a) => a -> a -> Int -> Maybe (NonEmptyUVector a) +enumFromStepN a0 a1 n = fromVector (V.enumFromStepN a0 a1 n) +{-# INLINE enumFromStepN #-} + +-- | /O(n)/ Yield a non-empty vector of length @max n 1@ containing the +-- values x, x+y, x+y+y etc. This operations is usually more efficient than +-- 'enumFromThenTo'. +-- +enumFromStepN1 :: (V.Unbox a, Num a) => a -> a -> Int -> NonEmptyUVector a +enumFromStepN1 a0 a1 n = unsafeFromVector (V.enumFromStepN a0 a1 (max n 1)) +{-# INLINE enumFromStepN1 #-} + +-- | /O(n)/ Enumerate values from x to y. +-- +-- If an enumeration does not use meaningful indices, 'Nothing' is returned, +-- otherwise, 'Just' containing a non-empty vector. +-- +-- /WARNING/: This operation can be very inefficient. If at all possible, +-- use 'enumFromN' instead. +-- +-- +enumFromTo :: (V.Unbox a, Enum a) => a -> a -> Maybe (NonEmptyUVector a) +enumFromTo a0 a1 = fromVector (V.enumFromTo a0 a1) +{-# INLINE enumFromTo #-} + +-- | /O(n)/ Enumerate values from x to y with a specific step z. +-- +-- If an enumeration does not use meaningful indices, 'Nothing' is returned, +-- otherwise, 'Just' containing a non-empty vector. +-- +-- /WARNING/: This operation can be very inefficient. If at all possible, +-- use 'enumFromStepN' instead. +enumFromThenTo :: (V.Unbox a, Enum a) => a -> a -> a -> Maybe (NonEmptyUVector a) +enumFromThenTo a0 a1 a2 = fromVector (V.enumFromThenTo a0 a1 a2) +{-# INLINE enumFromThenTo #-} + +-- ---------------------------------------------------------------------- -- +-- Concatenation + +-- | /O(n)/ Prepend an element +-- +-- >>> cons 1 (unsafeFromList [2,3]) +-- [1,2,3] +-- +cons :: V.Unbox a => a -> NonEmptyUVector a -> NonEmptyUVector a +cons a (NonEmptyUVector as) = consV a as +{-# INLINE cons #-} + +-- | /O(n)/ Prepend an element to a Vector +-- +-- >>> consV 1 (V.fromList [2,3]) +-- [1,2,3] +-- +consV :: V.Unbox a => a -> Vector a -> NonEmptyUVector a +consV a = NonEmptyUVector . V.cons a +{-# INLINE consV #-} + +-- | /O(n)/ Append an element +-- +-- >>> snoc (unsafeFromList [1,2]) 3 +-- [1,2,3] +-- +snoc :: V.Unbox a => NonEmptyUVector a -> a -> NonEmptyUVector a +snoc (NonEmptyUVector as) = snocV as +{-# INLINE snoc #-} + +-- | /O(n)/ Append an element to a Vector +-- +-- >>> snocV (V.fromList [1,2]) 3 +-- [1,2,3] +-- +snocV :: V.Unbox a => Vector a -> a -> NonEmptyUVector a +snocV as = NonEmptyUVector . V.snoc as +{-# INLINE snocV #-} + +-- | /O(m+n)/ Concatenate two non-empty vectors +-- +-- >>> (unsafeFromList [1..3]) ++ (unsafeFromList [4..6]) +-- [1,2,3,4,5,6] +-- +(++) :: V.Unbox a => NonEmptyUVector a -> NonEmptyUVector a -> NonEmptyUVector a +NonEmptyUVector v ++ NonEmptyUVector v' = NonEmptyUVector (v <> v') +{-# INLINE (++) #-} + +-- | /O(n)/ Concatenate all non-empty vectors in the list +-- +-- If list is empty, 'Nothing' is returned, otherwise 'Just' +-- containing the concatenated non-empty vectors +-- +-- >>> concat [(unsafeFromList [1..3]), (unsafeFromList [4..6])] +-- Just [1,2,3,4,5,6] +-- +concat :: V.Unbox a => [NonEmptyUVector a] -> Maybe (NonEmptyUVector a) +concat [] = Nothing +concat (a:as) = Just (concat1 (a :| as)) +{-# INLINE concat #-} + +-- | O(n) Concatenate all non-empty vectors in a non-empty list. +-- +-- >>> concat1 ((unsafeFromList [1..3]) :| [(unsafeFromList [4..6])]) +-- [1,2,3,4,5,6] +-- +concat1 :: V.Unbox a => NonEmpty (NonEmptyUVector a) -> NonEmptyUVector a +concat1 = NonEmptyUVector . Foldable.foldl' go V.empty + where + go v (NonEmptyUVector a) = v <> a +{-# INLINE concat1 #-} + +-- ---------------------------------------------------------------------- -- +-- Conversions + +-- | /O(n)/ Convert a non-empty vector to a non-empty list. +-- +-- >>> toNonEmpty (unsafeFromList [1..3]) +-- 1 :| [2,3] +-- +toNonEmpty :: V.Unbox a => NonEmptyUVector a -> NonEmpty a +toNonEmpty = NonEmpty.fromList . V.toList . _neUvec +{-# INLINE toNonEmpty #-} + +-- | O(n) Convert from a non-empty list to a non-empty vector. +-- +-- >>> fromNonEmpty (1 :| [2,3]) +-- [1,2,3] +-- +fromNonEmpty :: V.Unbox a => NonEmpty a -> NonEmptyUVector a +fromNonEmpty = NonEmptyUVector . V.fromList . Foldable.toList +{-# INLINE fromNonEmpty #-} + +-- | O(n) Convert from the first n-elements of a non-empty list to a +-- non-empty vector. +-- +-- Returns 'Nothing' if indices are <= 0, otherwise 'Just' containing +-- the non-empty vector. +-- +-- >>> fromNonEmptyN 3 (1 :| [2..5]) +-- Just [1,2,3] +-- +-- >>> fromNonEmptyN 0 (1 :| [2..5]) +-- Nothing +-- +fromNonEmptyN :: V.Unbox a => Int -> NonEmpty a -> Maybe (NonEmptyUVector a) +fromNonEmptyN n a = fromVector (V.fromListN n (Foldable.toList a)) +{-# INLINE fromNonEmptyN #-} + +-- | O(n) Convert from the first n-elements of a non-empty list to a +-- non-empty vector. This is a safe version of `fromNonEmptyN` which +-- takes @max n 1@ of the first n-elements of the non-empty list. +-- +-- +-- >>> fromNonEmptyN1 3 (1 :| [2..5]) +-- [1,2,3] +-- +-- >>> fromNonEmptyN1 0 (1 :| [2..5]) +-- [1] +-- +fromNonEmptyN1 :: V.Unbox a => Int -> NonEmpty a -> NonEmptyUVector a +fromNonEmptyN1 n = unsafeFromVector + . V.fromListN (max n 1) + . Foldable.toList +{-# INLINE fromNonEmptyN1 #-} + +-- | /O(1)/ Convert from a non-empty vector to a vector. +-- +-- +-- >>> let nev :: NonEmptyUVector Int = unsafeFromList [1..3] in toVector nev +-- [1,2,3] +-- +toVector :: V.Unbox a => NonEmptyUVector a -> Vector a +toVector = _neUvec +{-# INLINE toVector #-} + +-- | /O(1)/ Convert from a vector to a non-empty vector. +-- +-- If the vector is empty, then 'Nothing' is returned, +-- otherwise 'Just' containing the non-empty vector. +-- +-- >>> fromVector $ V.fromList [1..3] +-- Just [1,2,3] +-- +-- >>> fromVector $ V.fromList [] +-- Nothing +-- +fromVector :: V.Unbox a => Vector a -> Maybe (NonEmptyUVector a) +fromVector v = if V.null v then Nothing else Just (NonEmptyUVector v) +{-# INLINE fromVector #-} + +-- | /O(1)/ Convert from a vector to a non-empty vector without +-- checking bounds. +-- +-- /Warning/: the onus is on the user to ensure that their vector +-- is not empty, otherwise all bets are off! +-- +-- +-- >>> unsafeFromVector $ V.fromList [1..3] +-- [1,2,3] +-- +unsafeFromVector :: V.Unbox a => Vector a -> NonEmptyUVector a +unsafeFromVector = NonEmptyUVector +{-# INLINE unsafeFromVector #-} + +-- | /O(n)/ Convert from a non-empty vector to a list. +-- +-- +-- >>> let nev :: NonEmptyUVector Int = unsafeFromList [1..3] in toList nev +-- [1,2,3] +-- +toList :: V.Unbox a => NonEmptyUVector a -> [a] +toList = V.toList . _neUvec +{-# INLINE toList #-} + +-- | /O(n)/ Convert from a list to a non-empty vector. +-- +-- +-- >>> fromList [1..3] +-- Just [1,2,3] +-- +-- >>> fromList [] +-- Nothing +-- +fromList :: V.Unbox a => [a] -> Maybe (NonEmptyUVector a) +fromList = fromVector . V.fromList +{-# INLINE fromList #-} + +-- | /O(n)/ Convert from a list to a non-empty vector. +-- +-- /Warning/: the onus is on the user to ensure that their vector +-- is not empty, otherwise all bets are off! +-- +-- >>> unsafeFromList [1..3] +-- [1,2,3] +-- +unsafeFromList :: V.Unbox a => [a] -> NonEmptyUVector a +unsafeFromList = unsafeFromVector . V.fromList +{-# INLINE unsafeFromList #-} + +-- | /O(n)/ Convert the first n elements of a list to a non-empty vector. +-- +-- If the list is empty or <= 0 elements are chosen, 'Nothing' is +-- returned, otherwise 'Just' containing the non-empty vector +-- +-- >>> fromListN 3 [1..5] +-- Just [1,2,3] +-- +-- >>> fromListN 3 [] +-- Nothing +-- +-- >>> fromListN 0 [1..5] +-- Nothing +-- +fromListN :: V.Unbox a => Int -> [a] -> Maybe (NonEmptyUVector a) +fromListN n as = fromVector (V.fromListN n as) +{-# INLINE fromListN #-} + +-- ---------------------------------------------------------------------- -- +-- Restricting memory usage + +-- | /O(n)/ Yield the argument but force it not to retain any extra memory, +-- possibly by copying it. +-- +force :: V.Unbox a => NonEmptyUVector a -> NonEmptyUVector a +force (NonEmptyUVector a) = NonEmptyUVector (V.force a) +{-# INLINE force #-} + +-- ---------------------------------------------------------------------- -- +-- Bulk Updates + +-- | /O(m+n)/ For each pair (i,a) from the list, replace the non-empty vector +-- element at position i by a. +-- +-- >>> unsafeFromList [1..3] // [(2,4)] +-- [1,2,4] +-- +-- >>> unsafeFromList [1..3] // [] +-- [1,2,3] +-- +(//) :: V.Unbox a => NonEmptyUVector a -> [(Int, a)] -> NonEmptyUVector a +NonEmptyUVector v // us = NonEmptyUVector (v V.// us) +{-# INLINE (//) #-} + +-- | O(m+n) For each pair (i,a) from the vector of index/value pairs, +-- replace the vector element at position i by a. +-- +-- >>> unsafeFromList [1..3] `update` V.fromList [(2,4)] +-- [1,2,4] +-- +-- >>> unsafeFromList [1..3] `update` V.empty +-- [1,2,3] +-- +update :: V.Unbox a => NonEmptyUVector a -> Vector (Int, a) -> NonEmptyUVector a +update (NonEmptyUVector v) v' = NonEmptyUVector (V.update v v') +{-# INLINE update #-} + +-- | /O(m+min(n1,n2))/ For each index i from the index vector and the +-- corresponding value a from the value vector, replace the element of +-- the initial vector at position i by a. +-- +-- +-- >>> update_ (unsafeFromList [1..3]) (V.fromList [2]) (V.fromList [4]) +-- [1,2,4] +-- +-- >>> update_ (unsafeFromList [1..3]) V.empty V.empty +-- [1,2,3] +-- +update_ :: V.Unbox a => NonEmptyUVector a -> Vector Int -> Vector a -> NonEmptyUVector a +update_ (NonEmptyUVector v) is as = NonEmptyUVector (V.update_ v is as) +{-# INLINE update_ #-} + +-- | Same as '(//)' but without bounds checking. +-- +unsafeUpd :: V.Unbox a => NonEmptyUVector a -> [(Int, a)] -> NonEmptyUVector a +unsafeUpd (NonEmptyUVector v) us = NonEmptyUVector (V.unsafeUpd v us) +{-# INLINE unsafeUpd #-} + +-- | Same as 'update' but without bounds checking. +-- +unsafeUpdate :: V.Unbox a => NonEmptyUVector a -> Vector (Int, a) -> NonEmptyUVector a +unsafeUpdate (NonEmptyUVector v) us = NonEmptyUVector (V.unsafeUpdate v us) +{-# INLINE unsafeUpdate #-} + +-- | Same as 'update_' but without bounds checking. +-- +unsafeUpdate_ :: V.Unbox a => NonEmptyUVector a -> Vector Int -> Vector a -> NonEmptyUVector a +unsafeUpdate_ (NonEmptyUVector v) is as = NonEmptyUVector (V.unsafeUpdate_ v is as) +{-# INLINE unsafeUpdate_ #-} + +-- ---------------------------------------------------------------------- -- +-- Accumulation + +-- | /O(m+n)/ For each pair @(i,b)@ from the non-empty list, replace the +-- non-empty vector element @a@ at position @i@ by @f a b@. +-- +-- +-- >>> accum (+) (unsafeFromList [1..3]) [(2,10)] +-- [1,2,13] +-- +-- >>> accum (+) (unsafeFromList [1..3]) [] +-- [1,2,3] +-- +accum + :: (V.Unbox a, V.Unbox b) + => (a -> b -> a) + -- ^ accumulating function @f@ + -> NonEmptyUVector a + -- ^ initial non-empty vector (of length @m@) + -> [(Int, b)] + -- ^ list of index/value pairs (of length @n@) + -> NonEmptyUVector a +accum f (NonEmptyUVector v) u = NonEmptyUVector (V.accum f v u) +{-# INLINE accum #-} + +-- | /O(m+n)/ For each pair @(i,b)@ from the vector of pairs, replace the +-- non-empty vector element @a@ at position @i@ by @f a b@. +-- +-- >>> accumulate (+) (unsafeFromList [1..3]) (V.fromList [(2,10)]) +-- [1,2,13] +-- +-- >>> accumulate (+) (unsafeFromList [1..3]) V.empty +-- [1,2,3] +-- +accumulate + :: (V.Unbox a, V.Unbox b) + => (a -> b -> a) + -- ^ accumulating function @f@ + -> NonEmptyUVector a + -- ^ initial non-empty vector (of length @m@) + -> Vector (Int, b) + -- ^ vector of index/value pairs (of length @n@) + -> NonEmptyUVector a +accumulate f (NonEmptyUVector v) u = NonEmptyUVector (V.accumulate f v u) +{-# INLINE accumulate #-} + +-- | /O(m+min(n1,n2))/ For each index @i@ from the index vector and the +-- corresponding value @b@ from the the value vector, replace the element +-- of the initial non-empty vector at position @i@ by @f a b@. +-- +-- >>> accumulate_ (+) (unsafeFromList [1..3]) (V.fromList [2]) (V.fromList [10]) +-- [1,2,13] +-- +-- >>> accumulate_ (+) (unsafeFromList [1..3]) V.empty V.empty +-- [1,2,3] +-- +accumulate_ + :: (V.Unbox a, V.Unbox b) + => (a -> b -> a) + -- ^ accumulating function @f@ + -> NonEmptyUVector a + -- ^ initial non-empty vector (of length @m@) + -> Vector Int + -- ^ vector of indices (of length @n1@) + -> Vector b + -- ^ vector of values (of length @n2@) + -> NonEmptyUVector a +accumulate_ f (NonEmptyUVector v) i b = NonEmptyUVector (V.accumulate_ f v i b) +{-# INLINE accumulate_ #-} + +-- | Same as 'accum' but without bounds checking. +-- +unsafeAccum + :: (V.Unbox a, V.Unbox b) + => (a -> b -> a) + -- ^ accumulating function @f@ + -> NonEmptyUVector a + -- ^ initial non-empty vector (of length @m@) + -> [(Int, b)] + -- ^ list of index/value pairs (of length @n@) + -> NonEmptyUVector a +unsafeAccum f (NonEmptyUVector v) u = NonEmptyUVector (V.unsafeAccum f v u) +{-# INLINE unsafeAccum #-} + +-- | Same as 'accumulate' but without bounds checking. +-- +unsafeAccumulate + :: (V.Unbox a, V.Unbox b) + => (a -> b -> a) + -- ^ accumulating function @f@ + -> NonEmptyUVector a + -- ^ initial non-empty vector (of length @m@) + -> Vector (Int, b) + -- ^ vector of index/value pairs (of length @n@) + -> NonEmptyUVector a +unsafeAccumulate f v u = NonEmptyUVector (V.unsafeAccumulate f v' u) + where + v' = _neUvec v +{-# INLINE unsafeAccumulate #-} + +-- | Same as 'accumulate_' but without bounds checking. +-- +unsafeAccumulate_ + :: (V.Unbox a, V.Unbox b) + => (a -> b -> a) + -- ^ accumulating function @f@ + -> NonEmptyUVector a + -- ^ initial non-empty vector (of length @m@) + -> Vector Int + -- ^ vector of indices of length @n1@ + -> Vector b + -- ^ vector of values (of length @n2@) + -> NonEmptyUVector a +unsafeAccumulate_ f v i b = NonEmptyUVector (V.unsafeAccumulate_ f v' i b) + where + v' = _neUvec v +{-# INLINE unsafeAccumulate_ #-} + +-- ---------------------------------------------------------------------- -- +-- Permutations + +-- | /O(n)/ Reverse a non-empty vector +-- +-- >>> reverse $ unsafeFromList [1..3] +-- [3,2,1] +-- +reverse :: V.Unbox a => NonEmptyUVector a -> NonEmptyUVector a +reverse = NonEmptyUVector . V.reverse . _neUvec +{-# INLINE reverse #-} + +-- | /O(n)/ Yield the non-empty vector obtained by replacing each element +-- @i@ of the non-empty index vector by @xs'!'i@. This is equivalent to +-- @'map' (xs'!') is@ but is often much more efficient. +-- +-- >>> backpermute (unsafeFromList [1..3]) (unsafeFromList [2,0]) +-- [3,1] +-- +backpermute :: V.Unbox a => NonEmptyUVector a -> NonEmptyUVector Int -> NonEmptyUVector a +backpermute (NonEmptyUVector v) (NonEmptyUVector i) + = NonEmptyUVector (V.backpermute v i) +{-# INLINE backpermute #-} + +-- | Same as 'backpermute' but without bounds checking. +-- +unsafeBackpermute + :: V.Unbox a + => NonEmptyUVector a + -> NonEmptyUVector Int + -> NonEmptyUVector a +unsafeBackpermute (NonEmptyUVector v) (NonEmptyUVector i) + = NonEmptyUVector (V.unsafeBackpermute v i) +{-# INLINE unsafeBackpermute #-} + +-- ---------------------------------------------------------------------- -- +-- Safe destructive updates + +-- | Apply a destructive operation to a non-empty vector. The operation +-- will be performed in place if it is safe to do so and will modify a +-- copy of the non-empty vector otherwise. +-- +modify + :: V.Unbox a + => (forall s. MVector s a -> ST s ()) + -> NonEmptyUVector a + -> NonEmptyUVector a +modify p (NonEmptyUVector v) = NonEmptyUVector (V.modify p v) +{-# INLINE modify #-} + +-- ---------------------------------------------------------------------- -- +-- Indexing + +-- | /O(n)/ Pair each element in a vector with its index. +-- +-- >>> indexed $ unsafeFromList ["a","b","c"] +-- [(0,"a"),(1,"b"),(2,"c")] +-- +indexed :: (V.Unbox a) => NonEmptyUVector a -> NonEmptyUVector (Int, a) +indexed = NonEmptyUVector . V.indexed . _neUvec +{-# INLINE indexed #-} + +-- ---------------------------------------------------------------------- -- +-- Mapping + +-- | /O(n)/ Map a function over a non-empty vector. +-- +-- >>> map (+1) $ unsafeFromList [1..3] +-- [2,3,4] +-- +map :: (V.Unbox a, V.Unbox b) => (a -> b) -> NonEmptyUVector a -> NonEmptyUVector b +map f = NonEmptyUVector . V.map f . _neUvec +{-# INLINE map #-} + +-- | /O(n)/ Apply a function to every element of a non-empty vector and +-- its index. +-- +-- >>> imap (\i a -> if i == 2 then a+1 else a+0) $ unsafeFromList [1..3] +-- [1,2,4] +-- +imap :: (V.Unbox a, V.Unbox b) => (Int -> a -> b) -> NonEmptyUVector a -> NonEmptyUVector b +imap f = NonEmptyUVector . V.imap f . _neUvec +{-# INLINE imap #-} + +-- | Map a function over a vector and concatenate the results. +-- +-- >>> concatMap (\a -> unsafeFromList [a,a]) (unsafeFromList [1,2,3]) +-- [1,1,2,2,3,3] +-- +concatMap + :: (V.Unbox a, V.Unbox b) + => (a -> NonEmptyUVector b) + -> NonEmptyUVector a + -> NonEmptyUVector b +concatMap f = NonEmptyUVector . V.concatMap (_neUvec . f) . _neUvec +{-# INLINE concatMap #-} + +-- ---------------------------------------------------------------------- -- +-- Monadic Mapping + +-- | /O(n)/ Apply the monadic action to all elements of the non-empty +-- vector, yielding non-empty vector of results. +-- +-- >>> mapM Just (unsafeFromList [1..3]) +-- Just [1,2,3] +-- +-- >>> mapM (const Nothing) (unsafeFromList [1..3]) +-- Nothing +-- +mapM :: (V.Unbox a, V.Unbox b, Monad m) => (a -> m b) -> NonEmptyUVector a -> m (NonEmptyUVector b) +mapM f = fmap NonEmptyUVector . V.mapM f . _neUvec +{-# INLINE mapM #-} + +-- | /O(n)/ Apply the monadic action to every element of a non-empty +-- vector and its index, yielding a non-empty vector of results. +-- +-- >>> imapM (\i a -> if i == 1 then Just a else Just 0) (unsafeFromList [1..3]) +-- Just [0,2,0] +-- +-- >>> imapM (\_ _ -> Nothing) (unsafeFromList [1..3]) +-- Nothing +-- +imapM + :: (V.Unbox a, V.Unbox b, Monad m) + => (Int -> a -> m b) + -> NonEmptyUVector a + -> m (NonEmptyUVector b) +imapM f = fmap NonEmptyUVector . V.imapM f . _neUvec +{-# INLINE imapM #-} + +-- | /O(n)/ Apply the monadic action to all elements of a non-empty vector +-- and ignore the results. +-- +-- >>> mapM_ (const $ Just ()) (unsafeFromList [1..3]) +-- Just () +-- +-- >>> mapM_ (const Nothing) (unsafeFromList [1..3]) +-- Nothing +-- +mapM_ :: (V.Unbox a, Monad m) => (a -> m b) -> NonEmptyUVector a -> m () +mapM_ f = V.mapM_ f . _neUvec +{-# INLINE mapM_ #-} + +-- | /O(n)/ Apply the monadic action to every element of a non-emptpy +-- vector and its index, ignoring the results +-- +-- >>> imapM_ (\i a -> if i == 1 then P.print a else P.putStrLn "0") (unsafeFromList [1..3]) +-- 0 +-- 2 +-- 0 +-- +-- >>> imapM_ (\_ _ -> Nothing) (unsafeFromList [1..3]) +-- Nothing +-- +imapM_ :: (V.Unbox a, Monad m) => (Int -> a -> m b) -> NonEmptyUVector a -> m () +imapM_ f = V.imapM_ f . _neUvec +{-# INLINE imapM_ #-} + +-- | /O(n)/ Apply the monadic action to all elements of the non-empty +-- vector, yielding a non0empty vector of results. +-- +-- Equivalent to @flip 'mapM'@. +-- +forM :: (V.Unbox a, V.Unbox b, Monad m) => NonEmptyUVector a -> (a -> m b) -> m (NonEmptyUVector b) +forM (NonEmptyUVector v) f = fmap NonEmptyUVector (V.forM v f) +{-# INLINE forM #-} + +-- | /O(n)/ Apply the monadic action to all elements of a non-empty +-- vector and ignore the results. +-- +-- Equivalent to @flip 'mapM_'@. +-- +forM_ :: (V.Unbox a, Monad m) => NonEmptyUVector a -> (a -> m b) -> m () +forM_ (NonEmptyUVector v) f = V.forM_ v f +{-# INLINE forM_ #-} + +-- ---------------------------------------------------------------------- -- +-- Zipping + +-- | /O(min(m,n))/ Zip two non-empty vectors with the given function. +-- +-- >>> zipWith (+) (unsafeFromList [1..3]) (unsafeFromList [1..3]) +-- [2,4,6] +-- +zipWith + :: (V.Unbox a, V.Unbox b, V.Unbox c) + => (a -> b -> c) + -> NonEmptyUVector a + -> NonEmptyUVector b + -> NonEmptyUVector c +zipWith f a b = NonEmptyUVector (V.zipWith f a' b') + where + a' = _neUvec a + b' = _neUvec b +{-# INLINE zipWith #-} + +-- | Zip three non-empty vectors with the given function. +-- +-- +zipWith3 + :: (V.Unbox a, V.Unbox b, V.Unbox c, V.Unbox d) + => (a -> b -> c -> d) + -> NonEmptyUVector a + -> NonEmptyUVector b + -> NonEmptyUVector c + -> NonEmptyUVector d +zipWith3 f a b c = NonEmptyUVector (V.zipWith3 f a' b' c') + where + a' = _neUvec a + b' = _neUvec b + c' = _neUvec c +{-# INLINE zipWith3 #-} + +-- | Zip four non-empty vectors with the given function. +-- +zipWith4 + :: (V.Unbox a, V.Unbox b, V.Unbox c, V.Unbox d, V.Unbox e) + => (a -> b -> c -> d -> e) + -> NonEmptyUVector a + -> NonEmptyUVector b + -> NonEmptyUVector c + -> NonEmptyUVector d + -> NonEmptyUVector e +zipWith4 f a b c d = NonEmptyUVector (V.zipWith4 f a' b' c' d') + where + a' = _neUvec a + b' = _neUvec b + c' = _neUvec c + d' = _neUvec d +{-# INLINE zipWith4 #-} + +-- | Zip five non-empty vectors with the given function. +-- +zipWith5 + :: (V.Unbox a, V.Unbox b, V.Unbox c, V.Unbox d, V.Unbox e, V.Unbox f) + => (a -> b -> c -> d -> e -> f) + -> NonEmptyUVector a + -> NonEmptyUVector b + -> NonEmptyUVector c + -> NonEmptyUVector d + -> NonEmptyUVector e + -> NonEmptyUVector f +zipWith5 f a b c d e = NonEmptyUVector (V.zipWith5 f a' b' c' d' e') + where + a' = _neUvec a + b' = _neUvec b + c' = _neUvec c + d' = _neUvec d + e' = _neUvec e +{-# INLINE zipWith5 #-} + +-- | Zip six non-empty vectors with the given function. +-- +zipWith6 + :: (V.Unbox a, V.Unbox b, V.Unbox c, V.Unbox d, V.Unbox e, V.Unbox f, V.Unbox g) + => (a -> b -> c -> d -> e -> f -> g) + -> NonEmptyUVector a + -> NonEmptyUVector b + -> NonEmptyUVector c + -> NonEmptyUVector d + -> NonEmptyUVector e + -> NonEmptyUVector f + -> NonEmptyUVector g +zipWith6 k a b c d e f = NonEmptyUVector (V.zipWith6 k a' b' c' d' e' f') + where + a' = _neUvec a + b' = _neUvec b + c' = _neUvec c + d' = _neUvec d + e' = _neUvec e + f' = _neUvec f +{-# INLINE zipWith6 #-} + + +-- | /O(min(m,n))/ Zip two non-empty vectors with a function that also +-- takes the elements' indices. +-- +izipWith + :: (V.Unbox a, V.Unbox b, V.Unbox c) + => (Int -> a -> b -> c) + -> NonEmptyUVector a + -> NonEmptyUVector b + -> NonEmptyUVector c +izipWith f a b = NonEmptyUVector (V.izipWith f a' b') + where + a' = _neUvec a + b' = _neUvec b +{-# INLINE izipWith #-} + +-- | Zip three non-empty vectors and their indices with the given function. +-- +izipWith3 + :: (V.Unbox a, V.Unbox b, V.Unbox c, V.Unbox d) + => (Int -> a -> b -> c -> d) + -> NonEmptyUVector a + -> NonEmptyUVector b + -> NonEmptyUVector c + -> NonEmptyUVector d +izipWith3 f a b c = NonEmptyUVector (V.izipWith3 f a' b' c') + where + a' = _neUvec a + b' = _neUvec b + c' = _neUvec c +{-# INLINE izipWith3 #-} + +-- | Zip four non-empty vectors and their indices with the given function. +-- +izipWith4 + :: (V.Unbox a, V.Unbox b, V.Unbox c, V.Unbox d, V.Unbox e) + => (Int -> a -> b -> c -> d -> e) + -> NonEmptyUVector a + -> NonEmptyUVector b + -> NonEmptyUVector c + -> NonEmptyUVector d + -> NonEmptyUVector e +izipWith4 f a b c d = NonEmptyUVector (V.izipWith4 f a' b' c' d') + where + a' = _neUvec a + b' = _neUvec b + c' = _neUvec c + d' = _neUvec d +{-# INLINE izipWith4 #-} + +-- | Zip five non-empty vectors and their indices with the given function. +-- +izipWith5 + :: (V.Unbox a, V.Unbox b, V.Unbox c, V.Unbox d, V.Unbox e, V.Unbox f) + => (Int -> a -> b -> c -> d -> e -> f) + -> NonEmptyUVector a + -> NonEmptyUVector b + -> NonEmptyUVector c + -> NonEmptyUVector d + -> NonEmptyUVector e + -> NonEmptyUVector f +izipWith5 f a b c d e = NonEmptyUVector (V.izipWith5 f a' b' c' d' e') + where + a' = _neUvec a + b' = _neUvec b + c' = _neUvec c + d' = _neUvec d + e' = _neUvec e +{-# INLINE izipWith5 #-} + +-- | Zip six non-empty vectors and their indices with the given function. +-- +izipWith6 + :: (V.Unbox a, V.Unbox b, V.Unbox c, V.Unbox d, V.Unbox e, V.Unbox f, V.Unbox g) + => (Int -> a -> b -> c -> d -> e -> f -> g) + -> NonEmptyUVector a + -> NonEmptyUVector b + -> NonEmptyUVector c + -> NonEmptyUVector d + -> NonEmptyUVector e + -> NonEmptyUVector f + -> NonEmptyUVector g +izipWith6 k a b c d e f = NonEmptyUVector (V.izipWith6 k a' b' c' d' e' f') + where + a' = _neUvec a + b' = _neUvec b + c' = _neUvec c + d' = _neUvec d + e' = _neUvec e + f' = _neUvec f +{-# INLINE izipWith6 #-} + +-- | /O(min(n,m))/ Elementwise pairing of non-empty vector elements. This is a special case +-- of 'zipWith' where the function argument is @(,)@ +-- +zip :: (V.Unbox a, V.Unbox b) => NonEmptyUVector a -> NonEmptyUVector b -> NonEmptyUVector (a, b) +zip a b = NonEmptyUVector (V.zip a' b') + where + a' = _neUvec a + b' = _neUvec b +{-# INLINE zip #-} + +-- | Zip together three non-empty vectors. +-- +zip3 + :: (V.Unbox a, V.Unbox b, V.Unbox c) + => NonEmptyUVector a + -> NonEmptyUVector b + -> NonEmptyUVector c + -> NonEmptyUVector (a, b, c) +zip3 a b c = NonEmptyUVector (V.zip3 a' b' c') + where + a' = _neUvec a + b' = _neUvec b + c' = _neUvec c +{-# INLINE zip3 #-} + +-- | Zip together four non-empty vectors. +-- +zip4 + :: (V.Unbox a, V.Unbox b, V.Unbox c, V.Unbox d) + => NonEmptyUVector a + -> NonEmptyUVector b + -> NonEmptyUVector c + -> NonEmptyUVector d + -> NonEmptyUVector (a, b, c, d) +zip4 a b c d = NonEmptyUVector (V.zip4 a' b' c' d') + where + a' = _neUvec a + b' = _neUvec b + c' = _neUvec c + d' = _neUvec d +{-# INLINE zip4 #-} + +-- | Zip together five non-empty vectors. +-- +zip5 + :: (V.Unbox a, V.Unbox b, V.Unbox c, V.Unbox d, V.Unbox e) + => NonEmptyUVector a + -> NonEmptyUVector b + -> NonEmptyUVector c + -> NonEmptyUVector d + -> NonEmptyUVector e + -> NonEmptyUVector (a, b, c, d, e) +zip5 a b c d e = NonEmptyUVector (V.zip5 a' b' c' d' e') + where + a' = _neUvec a + b' = _neUvec b + c' = _neUvec c + d' = _neUvec d + e' = _neUvec e +{-# INLINE zip5 #-} + +-- | Zip together six non-empty vectors. +-- +zip6 + :: (V.Unbox a, V.Unbox b, V.Unbox c, V.Unbox d, V.Unbox e, V.Unbox f) + => NonEmptyUVector a + -> NonEmptyUVector b + -> NonEmptyUVector c + -> NonEmptyUVector d + -> NonEmptyUVector e + -> NonEmptyUVector f + -> NonEmptyUVector (a, b, c, d, e, f) +zip6 a b c d e f = NonEmptyUVector (V.zip6 a' b' c' d' e' f') + where + a' = _neUvec a + b' = _neUvec b + c' = _neUvec c + d' = _neUvec d + e' = _neUvec e + f' = _neUvec f +{-# INLINE zip6 #-} + +-- ---------------------------------------------------------------------- -- +-- Monadic Zipping + +-- | /O(min(m,n))/ Zip the two non-empty vectors with the monadic action +-- and yield a non-empty vector of results. +-- +zipWithM + :: (V.Unbox a, V.Unbox b, V.Unbox c, Monad m) + => (a -> b -> m c) + -> NonEmptyUVector a + -> NonEmptyUVector b + -> m (NonEmptyUVector c) +zipWithM f a b = fmap NonEmptyUVector (V.zipWithM f a' b') + where + a' = _neUvec a + b' = _neUvec b +{-# INLINE zipWithM #-} + +-- | /O(min(m,n))/ Zip the two non-empty vectors with a monadic action +-- that also takes the element index and yield a vector of results. +-- +izipWithM + :: (V.Unbox a, V.Unbox b, V.Unbox c, Monad m) + => (Int -> a -> b -> m c) + -> NonEmptyUVector a + -> NonEmptyUVector b + -> m (NonEmptyUVector c) +izipWithM f a b = fmap NonEmptyUVector (V.izipWithM f a' b') + where + a' = _neUvec a + b' = _neUvec b +{-# INLINE izipWithM #-} + +-- | /O(min(m,n))/ Zip the two non-empty vectors with the monadic action +-- and ignore the results. +-- +zipWithM_ + :: (V.Unbox a, V.Unbox b, Monad m) + => (a -> b -> m c) + -> NonEmptyUVector a + -> NonEmptyUVector b + -> m () +zipWithM_ f a b = V.zipWithM_ f (_neUvec a) (_neUvec b) +{-# INLINE zipWithM_ #-} + +-- | /O(min(m,n))/ Zip the two non-empty vectors with a monadic action +-- that also takes the element index and ignore the results. +-- +izipWithM_ + :: (V.Unbox a, V.Unbox b, Monad m) + => (Int -> a -> b -> m c) + -> NonEmptyUVector a + -> NonEmptyUVector b + -> m () +izipWithM_ f a b = V.izipWithM_ f (_neUvec a) (_neUvec b) +{-# INLINE izipWithM_ #-} + +-- ---------------------------------------------------------------------- -- +-- Unzipping + +-- | /O(min(m,n))/ Unzip a non-empty vector of pairs. +-- +unzip :: (V.Unbox a, V.Unbox b) => NonEmptyUVector (a, b) -> (NonEmptyUVector a, NonEmptyUVector b) +unzip (NonEmptyUVector v) = case V.unzip v of + ~(a,b) -> (NonEmptyUVector a, NonEmptyUVector b) +{-# INLINE unzip #-} + +-- | Unzip a non-empty vector of triples. +-- +unzip3 + :: (V.Unbox a, V.Unbox b, V.Unbox c) + => NonEmptyUVector (a, b, c) + -> (NonEmptyUVector a, NonEmptyUVector b, NonEmptyUVector c) +unzip3 (NonEmptyUVector v) = case V.unzip3 v of + ~(a,b,c) -> + ( NonEmptyUVector a + , NonEmptyUVector b + , NonEmptyUVector c + ) +{-# INLINE unzip3 #-} + +-- | Unzip a non-empty vector of quadruples. +-- +unzip4 + :: (V.Unbox a, V.Unbox b, V.Unbox c, V.Unbox d) + => NonEmptyUVector (a, b, c, d) + -> ( NonEmptyUVector a + , NonEmptyUVector b + , NonEmptyUVector c + , NonEmptyUVector d + ) +unzip4 (NonEmptyUVector v) = case V.unzip4 v of + ~(a,b,c,d) -> + ( NonEmptyUVector a + , NonEmptyUVector b + , NonEmptyUVector c + , NonEmptyUVector d + ) +{-# INLINE unzip4 #-} + +-- | Unzip a non-empty vector of quintuples. +-- +unzip5 + :: (V.Unbox a, V.Unbox b, V.Unbox c, V.Unbox d, V.Unbox e) + => NonEmptyUVector (a, b, c, d, e) + -> ( NonEmptyUVector a + , NonEmptyUVector b + , NonEmptyUVector c + , NonEmptyUVector d + , NonEmptyUVector e + ) +unzip5 (NonEmptyUVector v) = case V.unzip5 v of + ~(a,b,c,d,e) -> + ( NonEmptyUVector a + , NonEmptyUVector b + , NonEmptyUVector c + , NonEmptyUVector d + , NonEmptyUVector e + ) +{-# INLINE unzip5 #-} + +-- | Unzip a non-empty vector of sextuples. +-- +unzip6 + :: (V.Unbox a, V.Unbox b, V.Unbox c, V.Unbox d, V.Unbox e, V.Unbox f) + => NonEmptyUVector (a, b, c, d, e, f) + -> ( NonEmptyUVector a + , NonEmptyUVector b + , NonEmptyUVector c + , NonEmptyUVector d + , NonEmptyUVector e + , NonEmptyUVector f + ) +unzip6 (NonEmptyUVector v) = case V.unzip6 v of + ~(a,b,c,d,e,f) -> + ( NonEmptyUVector a + , NonEmptyUVector b + , NonEmptyUVector c + , NonEmptyUVector d + , NonEmptyUVector e + , NonEmptyUVector f + ) +{-# INLINE unzip6 #-} + +-- ---------------------------------------------------------------------- -- +-- Filtering + +-- | /O(n)/ Drop elements that do not satisfy the predicate. +-- +-- If no elements satisfy the predicate, the resulting vector may be empty. +-- +-- >>> filter (\a -> if a == 2 then False else True) (unsafeFromList [1..3]) +-- [1,3] +-- +-- >>> filter (const False) (unsafeFromList [1..3]) +-- [] +-- +filter :: V.Unbox a => (a -> Bool) -> NonEmptyUVector a -> Vector a +filter f = V.filter f . _neUvec +{-# INLINE filter #-} + +-- | /O(n)/ Drop elements that do not satisfy the predicate which is +-- applied to values and their indices. +-- +-- If no elements satisfy the predicate, the resulting vector may be empty. +-- +-- >>> ifilter (\i a -> if a == 2 || i == 0 then False else True) (unsafeFromList [1..3]) +-- [3] +-- +-- >>> ifilter (\_ _ -> False) (unsafeFromList [1..3]) +-- [] +-- +ifilter + :: V.Unbox a + => (Int -> a -> Bool) + -> NonEmptyUVector a + -> Vector a +ifilter f = V.ifilter f . _neUvec +{-# INLINE ifilter #-} + +-- | /O(n)/ Drop elements that do not satisfy the monadic predicate. +-- +-- If no elements satisfy the predicate, the resulting vector may be empty. +-- +-- >>> filterM (\a -> if a == 2 then Just False else Just True) (unsafeFromList [1..3]) +-- Just [1,3] +-- +-- >>> filterM (\a -> if a == 2 then Nothing else Just True) (unsafeFromList [1..3]) +-- Nothing +-- +-- >>> filterM (const $ Just False) (unsafeFromList [1..3]) +-- Just [] +-- +filterM + :: (V.Unbox a, Monad m) + => (a -> m Bool) + -> NonEmptyUVector a + -> m (Vector a) +filterM f = V.filterM f . _neUvec +{-# INLINE filterM #-} + +-- | /O(n)/ Drop elements that do not satisfy the monadic predicate that is +-- a function of index and value. +-- +-- If no elements satisfy the predicate, the resulting vector may be empty. +-- +-- TODO: this should be a more efficient function in @vector@. +-- +-- >>> ifilterM (\i a -> if a == 2 || i == 0 then Just False else Just True) (unsafeFromList [1..3]) +-- Just [3] +-- +-- >>> ifilterM (\i a -> if a == 2 || i == 0 then Nothing else Just True) (unsafeFromList [1..3]) +-- Nothing +-- +-- >>> ifilterM (\_ _ -> Just False) (unsafeFromList [1..3]) +-- Just [] +-- +ifilterM + :: (V.Unbox a, Monad m) + => (Int -> a -> m Bool) + -> NonEmptyUVector a + -> m (Vector a) +ifilterM f = fmap (V.map snd) + . V.filterM (uncurry f) + . V.indexed + . _neUvec +{-# INLINE ifilterM #-} + +-- | /O(n)/ Drop repeated adjacent elements. +-- +-- >>> uniq $ unsafeFromList [1,1,2,2,3,3,1] +-- [1,2,3,1] +-- +uniq :: (V.Unbox a, Eq a) => NonEmptyUVector a -> NonEmptyUVector a +uniq = NonEmptyUVector . V.uniq . _neUvec +{-# INLINE uniq #-} + +-- | /O(n)/ Drop elements when predicate returns Nothing +-- +-- If no elements satisfy the predicate, the resulting vector may be empty. +-- +-- >>> mapMaybe (\a -> if a == 2 then Nothing else Just a) (unsafeFromList [1..3]) +-- [1,3] +-- +mapMaybe + :: (V.Unbox a, V.Unbox b) + => (a -> Maybe b) + -> NonEmptyUVector a + -> Vector b +mapMaybe f = V.mapMaybe f . _neUvec +{-# INLINE mapMaybe #-} + +-- | /O(n)/ Drop elements when predicate, applied to index and value, returns Nothing +-- +-- If no elements satisfy the predicate, the resulting vector may be empty. +-- +-- >>> imapMaybe (\i a -> if a == 2 || i == 2 then Nothing else Just a) (unsafeFromList [1..3]) +-- [1] +-- +imapMaybe + :: (V.Unbox a, V.Unbox b) + => (Int -> a -> Maybe b) + -> NonEmptyUVector a + -> Vector b +imapMaybe f = V.imapMaybe f . _neUvec +{-# INLINE imapMaybe #-} + +-- | /O(n)/ Yield the longest prefix of elements satisfying the predicate +-- without copying. +-- +-- If no elements satisfy the predicate, the resulting vector may be empty. +-- +-- >>> takeWhile (/= 3) (unsafeFromList [1..3]) +-- [1,2] +-- +takeWhile :: V.Unbox a => (a -> Bool) -> NonEmptyUVector a -> Vector a +takeWhile f = V.takeWhile f . _neUvec +{-# INLINE takeWhile #-} + +-- | /O(n)/ Drop the longest prefix of elements that satisfy the predicate +-- without copying. +-- +-- If all elements satisfy the predicate, the resulting vector may be empty. +-- +-- >>> dropWhile (/= 3) (unsafeFromList [1..3]) +-- [3] +-- +dropWhile :: V.Unbox a => (a -> Bool) -> NonEmptyUVector a -> Vector a +dropWhile f = V.dropWhile f . _neUvec +{-# INLINE dropWhile #-} + +-- ---------------------------------------------------------------------- -- +-- Partitioning + +-- | /O(n)/ Split the non-empty vector in two parts, the first one +-- containing those elements that satisfy the predicate and the second +-- one those that don't. The relative order of the elements is preserved +-- at the cost of a sometimes reduced performance compared to +-- 'unstablePartition'. +-- +-- If all or no elements satisfy the predicate, one of the resulting vectors +-- may be empty. +-- +-- >>> partition (< 3) (unsafeFromList [1..5]) +-- ([1,2],[3,4,5]) +-- +partition :: V.Unbox a => (a -> Bool) -> NonEmptyUVector a -> (Vector a, Vector a) +partition f = V.partition f . _neUvec +{-# INLINE partition #-} + +-- | /O(n)/ Split the non-empty vector in two parts, the first one +-- containing the Left elements and the second containing the +-- Right elements. The relative order of the elements is preserved. +-- +-- If all elements produce a Left (or Right), one of the +-- resulting vectors may be empty. +-- +-- >>> partitionWith (\a -> if a < 3 then Left a else Right (P.show a)) (unsafeFromList [1..5]) +-- ([1,2],["3","4","5"]) +-- +partitionWith :: (V.Unbox a, V.Unbox b, V.Unbox c) => + (a -> Either b c) -> NonEmptyUVector a -> (Vector b, Vector c) +partitionWith f = V.partitionWith f . _neUvec +{-# INLINE partitionWith #-} + +-- | /O(n)/ Split the non-empty vector in two parts, the first one +-- containing those elements that satisfy the predicate and the second +-- one those that don't. The order of the elements is not preserved but +-- the operation is often faster than 'partition'. +-- +-- If all or no elements satisfy the predicate, one of the resulting vectors +-- may be empty. +-- +unstablePartition + :: V.Unbox a + => (a -> Bool) + -> NonEmptyUVector a + -> (Vector a, Vector a) +unstablePartition f = V.unstablePartition f . _neUvec +{-# INLINE unstablePartition #-} + +-- | /O(n)/ Split the non-empty vector into the longest prefix of elements +-- that satisfy the predicate and the rest without copying. +-- +-- If all or no elements satisfy the predicate, one of the resulting vectors +-- may be empty. +-- +-- >>> span (== 1) (unsafeFromList [1,1,2,3,1]) +-- ([1,1],[2,3,1]) +-- +span :: V.Unbox a => (a -> Bool) -> NonEmptyUVector a -> (Vector a, Vector a) +span f = V.span f . _neUvec +{-# INLINE span #-} + +-- | /O(n)/ Split the vector into the longest prefix of elements that do not +-- satisfy the predicate and the rest without copying. +-- +-- If all or no elements satisfy the predicate, one of the resulting vectors +-- may be empty. +-- +-- >>> break (== 2) (unsafeFromList [1,1,2,3,1]) +-- ([1,1],[2,3,1]) +-- +break :: V.Unbox a => (a -> Bool) -> NonEmptyUVector a -> (Vector a, Vector a) +break f = V.break f . _neUvec +{-# INLINE break #-} + +-- ---------------------------------------------------------------------- -- +-- Searching + +-- | /O(n)/ Check if the non-empty vector contains an element +-- +-- >>> elem 1 $ unsafeFromList [1..3] +-- True +-- >>> elem 4 $ unsafeFromList [1..3] +-- False +-- +elem :: (V.Unbox a, Eq a) => a -> NonEmptyUVector a -> Bool +elem a = V.elem a . _neUvec +{-# INLINE elem #-} + +-- | /O(n)/ Check if the non-empty vector does not contain an element +-- (inverse of 'elem') +-- +-- >>> notElem 1 $ unsafeFromList [1..3] +-- False +-- +-- >>> notElem 4 $ unsafeFromList [1..3] +-- True +-- +notElem :: (V.Unbox a, Eq a) => a -> NonEmptyUVector a -> Bool +notElem a = V.notElem a . _neUvec +{-# INLINE notElem #-} + +-- | /O(n)/ Yield 'Just' the first element matching the predicate or +-- 'Nothing' if no such element exists. +-- +-- >>> find (< 2) $ unsafeFromList [1..3] +-- Just 1 +-- +-- >>> find (< 0) $ unsafeFromList [1..3] +-- Nothing +-- +find :: V.Unbox a => (a -> Bool) -> NonEmptyUVector a -> Maybe a +find f = V.find f . _neUvec +{-# INLINE find #-} + +-- | /O(n)/ Yield 'Just' the index of the first element matching the +-- predicate or 'Nothing' if no such element exists. +-- +-- >>> findIndex (< 2) $ unsafeFromList [1..3] +-- Just 0 +-- +-- >>> findIndex (< 0) $ unsafeFromList [1..3] +-- Nothing +-- +findIndex :: V.Unbox a => (a -> Bool) -> NonEmptyUVector a -> Maybe Int +findIndex f = V.findIndex f . _neUvec +{-# INLINE findIndex #-} + +-- | /O(n)/ Yield the indices of elements satisfying the predicate in +-- ascending order. +-- +-- >>> findIndices (< 3) $ unsafeFromList [1..3] +-- [0,1] +-- +-- >>> findIndices (< 0) $ unsafeFromList [1..3] +-- [] +-- +findIndices :: V.Unbox a => (a -> Bool) -> NonEmptyUVector a -> Vector Int +findIndices f = V.findIndices f . _neUvec +{-# INLINE findIndices #-} + +-- | /O(n)/ Yield 'Just' the index of the first occurence of the given +-- element or 'Nothing' if the non-empty vector does not contain the +-- element. This is a specialised version of 'findIndex'. +-- +-- >>> elemIndex 1 $ unsafeFromList [1..3] +-- Just 0 +-- +-- >>> elemIndex 0 $ unsafeFromList [1..3] +-- Nothing +-- +elemIndex :: (V.Unbox a, Eq a) => a -> NonEmptyUVector a -> Maybe Int +elemIndex a = V.elemIndex a . _neUvec +{-# INLINE elemIndex #-} + +-- | /O(n)/ Yield the indices of all occurences of the given element in +-- ascending order. This is a specialised version of 'findIndices'. +-- +-- >>> elemIndices 1 $ unsafeFromList [1,2,3,1] +-- [0,3] +-- +-- >>> elemIndices 0 $ unsafeFromList [1..3] +-- [] +-- +elemIndices :: (V.Unbox a, Eq a) => a -> NonEmptyUVector a -> Vector Int +elemIndices a = V.elemIndices a . _neUvec +{-# INLINE elemIndices #-} + +-- ---------------------------------------------------------------------- -- +-- Folding + +-- | /O(n)/ Left monoidal fold +-- +foldl :: V.Unbox b => (a -> b -> a) -> a -> NonEmptyUVector b -> a +foldl f a = V.foldl f a . _neUvec +{-# INLINE foldl #-} + +-- | /O(n)/ Left semigroupal fold +-- +foldl1 :: V.Unbox a => (a -> a -> a) -> NonEmptyUVector a -> a +foldl1 f = V.foldl1 f . _neUvec +{-# INLINE foldl1 #-} + +-- | /O(n)/ Strict Left monoidal fold +-- +foldl' :: V.Unbox b => (a -> b -> a) -> a -> NonEmptyUVector b -> a +foldl' f a = V.foldl' f a . _neUvec +{-# INLINE foldl' #-} + +-- | /O(n)/ Strict Left semigroupal fold +-- +foldl1' :: V.Unbox a => (a -> a -> a) -> NonEmptyUVector a -> a +foldl1' f = V.foldl1' f . _neUvec +{-# INLINE foldl1' #-} + +-- | /O(n)/ Right monoidal fold +-- +foldr :: V.Unbox a => (a -> b -> b) -> b -> NonEmptyUVector a -> b +foldr f b = V.foldr f b . _neUvec +{-# INLINE foldr #-} + +-- | /O(n)/ Right semigroupal fold +-- +foldr1 :: V.Unbox a => (a -> a -> a) -> NonEmptyUVector a -> a +foldr1 f = V.foldr1 f . _neUvec +{-# INLINE foldr1 #-} + +-- | /O(n)/ Strict right monoidal fold +-- +foldr' :: V.Unbox a => (a -> b -> b) -> b -> NonEmptyUVector a -> b +foldr' f b = V.foldr' f b. _neUvec +{-# INLINE foldr' #-} + +-- | /O(n)/ Strict right semigroupal fold +-- +foldr1' :: V.Unbox a => (a -> a -> a) -> NonEmptyUVector a -> a +foldr1' f = V.foldr1' f . _neUvec +{-# INLINE foldr1' #-} + +-- | /O(n)/ Left monoidal fold with function applied to each element +-- and its index +-- +ifoldl :: V.Unbox b => (a -> Int -> b -> a) -> a -> NonEmptyUVector b -> a +ifoldl f a = V.ifoldl f a . _neUvec +{-# INLINE ifoldl #-} + +-- | /O(n)/ Strict left monoidal fold with function applied to each element +-- and its index +-- +ifoldl' :: V.Unbox b => (a -> Int -> b -> a) -> a -> NonEmptyUVector b -> a +ifoldl' f a = V.ifoldl' f a . _neUvec +{-# INLINE ifoldl' #-} + +-- | /O(n)/ Right monoidal fold with function applied to each element +-- and its index +-- +ifoldr :: V.Unbox a => (Int -> a -> b -> b) -> b -> NonEmptyUVector a -> b +ifoldr f b = V.ifoldr f b . _neUvec +{-# INLINE ifoldr #-} + +-- | /O(n)/ strict right monoidal fold with function applied to each element +-- and its index +-- +ifoldr' :: V.Unbox a => (Int -> a -> b -> b) -> b -> NonEmptyUVector a -> b +ifoldr' f b = V.ifoldr' f b . _neUvec +{-# INLINE ifoldr' #-} + +-- ---------------------------------------------------------------------- -- +-- Specialised folds + +-- | /O(n)/ Check if all elements satisfy the predicate. +-- +all :: V.Unbox a => (a -> Bool) -> NonEmptyUVector a -> Bool +all f = V.all f . _neUvec +{-# INLINE all #-} + +-- | /O(n)/ Check if any element satisfies the predicate. +-- +any :: V.Unbox a => (a -> Bool) -> NonEmptyUVector a -> Bool +any f = V.any f . _neUvec +{-# INLINE any #-} + +-- | /O(n)/ Check if all elements are @True@. +-- +and :: NonEmptyUVector Bool -> Bool +and = V.and . _neUvec +{-# INLINE and #-} + +-- | /O(n)/ Check if any element is @True@ +-- +or :: NonEmptyUVector Bool -> Bool +or = V.or . _neUvec +{-# INLINE or #-} + +-- | /O(n)/ Compute the sum of the elements +-- +sum :: (Num a, V.Unbox a) => NonEmptyUVector a -> a +sum = V.sum . _neUvec +{-# INLINE sum #-} + +-- | /O(n)/ Compute the produce of the elements +-- +product :: (Num a, V.Unbox a) => NonEmptyUVector a -> a +product = V.product . _neUvec +{-# INLINE product #-} + +-- | /O(n)/ Yield the maximum element of the non-empty vector. +-- +maximum :: (V.Unbox a, Ord a) => NonEmptyUVector a -> a +maximum = V.maximum . _neUvec +{-# INLINE maximum #-} + +-- | /O(n)/ Yield the maximum element of a non-empty vector +-- according to the given comparison function. +-- +maximumBy :: V.Unbox a => (a -> a -> Ordering) -> NonEmptyUVector a -> a +maximumBy f = V.maximumBy f . _neUvec +{-# INLINE maximumBy #-} + +-- | /O(n)/ Yield the minimum element of the non-empty vector. +-- +minimum :: (V.Unbox a, Ord a) => NonEmptyUVector a -> a +minimum = V.minimum . _neUvec +{-# INLINE minimum #-} + +-- | /O(n)/ Yield the minimum element of the non-empty vector +-- according to the given comparison function. +-- +minimumBy :: V.Unbox a => (a -> a -> Ordering) -> NonEmptyUVector a -> a +minimumBy f = V.minimumBy f . _neUvec +{-# INLINE minimumBy #-} + +-- | /O(n)/ Yield the index of the minimum element of the +-- non-empty vector. +-- +minIndex :: (V.Unbox a, Ord a) => NonEmptyUVector a -> Int +minIndex = V.minIndex . _neUvec +{-# INLINE minIndex #-} + +-- | /O(n)/ Yield the index of the minimum element of the vector +-- according to the given comparison function. +-- +minIndexBy :: V.Unbox a => (a -> a -> Ordering) -> NonEmptyUVector a -> Int +minIndexBy f = V.minIndexBy f . _neUvec +{-# INLINE minIndexBy #-} + +-- | /O(n)/ Yield the index of the maximum element of the +-- non-empty vector. +-- +maxIndex :: (V.Unbox a, Ord a) => NonEmptyUVector a -> Int +maxIndex = V.maxIndex . _neUvec +{-# INLINE maxIndex #-} + +-- | /O(n)/ Yield the index of the maximum element of the vector +-- according to the given comparison function. +-- +maxIndexBy :: V.Unbox a => (a -> a -> Ordering) -> NonEmptyUVector a -> Int +maxIndexBy f = V.maxIndexBy f . _neUvec +{-# INLINE maxIndexBy #-} + +-- ---------------------------------------------------------------------- -- +-- Monadic folds + +-- | /O(n)/ Monadic fold +-- +foldM :: (V.Unbox b, Monad m) => (a -> b -> m a) -> a -> NonEmptyUVector b -> m a +foldM f a = V.foldM f a . _neUvec +{-# INLINE foldM #-} + +-- | /O(n)/ Monadic fold (action applied to each element and its index) +-- +ifoldM :: (V.Unbox b, Monad m) => (a -> Int -> b -> m a) -> a -> NonEmptyUVector b -> m a +ifoldM f a = V.ifoldM f a . _neUvec +{-# INLINE ifoldM #-} + +-- | /O(n)/ Strict monadic fold +-- +foldM' :: (V.Unbox b, Monad m) => (a -> b -> m a) -> a -> NonEmptyUVector b -> m a +foldM' f a = V.foldM' f a . _neUvec +{-# INLINE foldM' #-} + +-- | /O(n)/ Strict monadic fold (action applied to each element and its index) +-- +ifoldM' :: (V.Unbox b, Monad m) => (a -> Int -> b -> m a) -> a -> NonEmptyUVector b -> m a +ifoldM' f a = V.ifoldM' f a . _neUvec +{-# INLINE ifoldM' #-} + +-- | /O(n)/ Monadic semigroupal fold +-- +fold1M :: (V.Unbox a, Monad m) => (a -> a -> m a) -> NonEmptyUVector a -> m a +fold1M f = V.fold1M f . _neUvec +{-# INLINE fold1M #-} + +-- | /O(n)/ Strict monadic semigroupal fold +-- +fold1M' :: (V.Unbox a, Monad m) => (a -> a -> m a) -> NonEmptyUVector a -> m a +fold1M' f = V.fold1M' f . _neUvec +{-# INLINE fold1M' #-} + +-- | /O(n)/ Monadic fold that discards the result +-- +foldM_ :: (V.Unbox b, Monad m) => (a -> b -> m a) -> a -> NonEmptyUVector b -> m () +foldM_ f a = V.foldM_ f a . _neUvec +{-# INLINE foldM_ #-} + +-- | /O(n)/ Monadic fold that discards the result (action applied to each +-- element and its index) +-- +ifoldM_ :: (V.Unbox b, Monad m) => (a -> Int -> b -> m a) -> a -> NonEmptyUVector b -> m () +ifoldM_ f a = V.ifoldM_ f a . _neUvec +{-# INLINE ifoldM_ #-} + +-- | /O(n)/ Strict monadic fold that discards the result +-- +foldM'_ :: (V.Unbox b, Monad m) => (a -> b -> m a) -> a -> NonEmptyUVector b -> m () +foldM'_ f a = V.foldM'_ f a . _neUvec +{-# INLINE foldM'_ #-} + +-- | /O(n)/ Strict monadic fold that discards the result (action applied to each +-- element and its index) +-- +ifoldM'_ :: (V.Unbox b, Monad m) => (a -> Int -> b -> m a) -> a -> NonEmptyUVector b -> m () +ifoldM'_ f a = V.ifoldM'_ f a . _neUvec +{-# INLINE ifoldM'_ #-} + +-- | /O(n)/ Monadic semigroupal fold that discards the result +-- +fold1M_ :: (V.Unbox a, Monad m) => (a -> a -> m a) -> NonEmptyUVector a -> m () +fold1M_ f = V.fold1M_ f . _neUvec +{-# INLINE fold1M_ #-} + +-- | /O(n)/ Strict monadic semigroupal fold that discards the result +-- +fold1M'_ :: (V.Unbox a, Monad m) => (a -> a -> m a) -> NonEmptyUVector a -> m () +fold1M'_ f = V.fold1M'_ f . _neUvec +{-# INLINE fold1M'_ #-} + +-- ---------------------------------------------------------------------- -- +-- Prefix sums (scans) + +-- | /O(n)/ Prescan +-- +prescanl :: (V.Unbox a, V.Unbox b) => (a -> b -> a) -> a -> NonEmptyUVector b -> NonEmptyUVector a +prescanl f a = NonEmptyUVector . V.prescanl f a . _neUvec +{-# INLINE prescanl #-} + +-- | /O(n)/ Prescan with strict accumulator +-- +prescanl' :: (V.Unbox a, V.Unbox b) => (a -> b -> a) -> a -> NonEmptyUVector b -> NonEmptyUVector a +prescanl' f a = NonEmptyUVector . V.prescanl' f a . _neUvec +{-# INLINE prescanl' #-} + +-- | /O(n)/ Scan +-- +postscanl :: (V.Unbox a, V.Unbox b) => (a -> b -> a) -> a -> NonEmptyUVector b -> NonEmptyUVector a +postscanl f a = NonEmptyUVector . V.postscanl f a . _neUvec +{-# INLINE postscanl #-} + +-- | /O(n)/ Scan with a strict accumulator +-- +postscanl' :: (V.Unbox a, V.Unbox b) => (a -> b -> a) -> a -> NonEmptyUVector b -> NonEmptyUVector a +postscanl' f a = NonEmptyUVector . V.postscanl' f a . _neUvec +{-# INLINE postscanl' #-} + +-- | /O(n)/ Haskell-style scan +-- +scanl :: (V.Unbox a, V.Unbox b) => (a -> b -> a) -> a -> NonEmptyUVector b -> NonEmptyUVector a +scanl f a = NonEmptyUVector . V.scanl f a . _neUvec +{-# INLINE scanl #-} + +-- | /O(n)/ Haskell-style scan with strict accumulator +-- +scanl' :: (V.Unbox a, V.Unbox b) => (a -> b -> a) -> a -> NonEmptyUVector b -> NonEmptyUVector a +scanl' f a = NonEmptyUVector . V.scanl' f a . _neUvec +{-# INLINE scanl' #-} + +-- | /O(n)/ Semigroupal left scan +-- +scanl1 :: V.Unbox a => (a -> a -> a) -> NonEmptyUVector a -> NonEmptyUVector a +scanl1 f = NonEmptyUVector . V.scanl1 f . _neUvec +{-# INLINE scanl1 #-} + +-- | /O(n)/ Strict semigroupal scan +-- +scanl1' :: V.Unbox a => (a -> a -> a) -> NonEmptyUVector a -> NonEmptyUVector a +scanl1' f = NonEmptyUVector . V.scanl1' f . _neUvec +{-# INLINE scanl1' #-} + +-- | /O(n)/ Scan over a vector with its index +-- +iscanl :: (V.Unbox a, V.Unbox b) => (Int -> a -> b -> a) -> a -> NonEmptyUVector b -> NonEmptyUVector a +iscanl f a = NonEmptyUVector . V.iscanl f a . _neUvec +{-# INLINE iscanl #-} + +-- | /O(n)/ Scan over a vector with its index with strict accumulator +-- +iscanl' :: (V.Unbox a, V.Unbox b) => (Int -> a -> b -> a) -> a -> NonEmptyUVector b -> NonEmptyUVector a +iscanl' f a = NonEmptyUVector . V.iscanl' f a . _neUvec +{-# INLINE iscanl' #-} + +-- | /O(n)/ Right-to-left prescan +-- +prescanr :: (V.Unbox a, V.Unbox b) => (a -> b -> b) -> b -> NonEmptyUVector a -> NonEmptyUVector b +prescanr f b = NonEmptyUVector . V.prescanr f b . _neUvec +{-# INLINE prescanr #-} + +-- | /O(n)/ Right-to-left prescan with strict accumulator +-- +prescanr' :: (V.Unbox a, V.Unbox b) => (a -> b -> b) -> b -> NonEmptyUVector a -> NonEmptyUVector b +prescanr' f b = NonEmptyUVector . V.prescanr' f b . _neUvec +{-# INLINE prescanr' #-} + +-- | /O(n)/ Right-to-left scan +-- +postscanr :: (V.Unbox a, V.Unbox b) => (a -> b -> b) -> b -> NonEmptyUVector a -> NonEmptyUVector b +postscanr f b = NonEmptyUVector . V.postscanr f b . _neUvec +{-# INLINE postscanr #-} + +-- | /O(n)/ Right-to-left scan with strict accumulator +-- +postscanr' :: (V.Unbox a, V.Unbox b) => (a -> b -> b) -> b -> NonEmptyUVector a -> NonEmptyUVector b +postscanr' f b = NonEmptyUVector . V.postscanr' f b . _neUvec +{-# INLINE postscanr' #-} + +-- | /O(n)/ Right-to-left Haskell-style scan +-- +scanr :: (V.Unbox a, V.Unbox b) => (a -> b -> b) -> b -> NonEmptyUVector a -> NonEmptyUVector b +scanr f b = NonEmptyUVector . V.scanr f b . _neUvec +{-# INLINE scanr #-} + +-- | /O(n)/ Right-to-left Haskell-style scan with strict accumulator +-- +scanr' :: (V.Unbox a, V.Unbox b) => (a -> b -> b) -> b -> NonEmptyUVector a -> NonEmptyUVector b +scanr' f b = NonEmptyUVector . V.scanr' f b . _neUvec +{-# INLINE scanr' #-} + +-- | /O(n)/ Right-to-left Haskell-style semigroupal scan +-- +scanr1 :: V.Unbox a => (a -> a -> a) -> NonEmptyUVector a -> NonEmptyUVector a +scanr1 f = NonEmptyUVector . V.scanr1 f . _neUvec +{-# INLINE scanr1 #-} + +-- | /O(n)/ Right-to-left Haskell-style semigroupal scan with strict accumulator +-- +scanr1' :: V.Unbox a => (a -> a -> a) -> NonEmptyUVector a -> NonEmptyUVector a +scanr1' f = NonEmptyUVector . V.scanr1' f . _neUvec +{-# INLINE scanr1' #-} + +-- | /O(n)/ Right-to-left scan over a vector with its index +-- +iscanr :: (V.Unbox a, V.Unbox b) => (Int -> a -> b -> b) -> b -> NonEmptyUVector a -> NonEmptyUVector b +iscanr f b = NonEmptyUVector . V.iscanr f b . _neUvec +{-# INLINE iscanr #-} + +-- | /O(n)/ Right-to-left scan over a vector with its index and a strict +-- accumulator +-- +iscanr' :: (V.Unbox a, V.Unbox b) => (Int -> a -> b -> b) -> b -> NonEmptyUVector a -> NonEmptyUVector b +iscanr' f b = NonEmptyUVector . V.iscanr' f b . _neUvec +{-# INLINE iscanr' #-} + +-- | /O(n)/ The 'intersperse' function takes an element and a 'NonEmptyUVector' +-- and "intersperses" that element between the elements of the 'NonEmptyUVector'. +-- +-- >>> intersperse 0 (unsafeFromList [1,2,3]) +-- [1,0,2,0,3] +-- +-- >>> intersperse 0 (singleton 1) +-- [1] +-- +intersperse :: forall (a :: Type) . V.Unbox a => a -> NonEmptyUVector a -> NonEmptyUVector a +intersperse sep nev@(NonEmptyUVector v) + | V.length v <= 1 = nev + | otherwise = unsafeCreate $ do + let n = V.length v + let newLen = 2*n - 1 + mv <- V.unsafeThaw $ V.replicate newLen (V.unsafeHead v) -- Create mutable vector + + -- Fill the first element + unsafeWrite mv 0 (V.unsafeIndex v 0) + + -- Fill remaining elements with separators + let go i j + | j >= n = pure () + | otherwise = do + unsafeWrite mv i sep + unsafeWrite mv (i+1) (V.unsafeIndex v j) + go (i+2) (j+1) + + go 1 1 + pure mv +{-# INLINE intersperse #-} + +-- | /O(n)/ Split a vector into a list of slices of the input vector. +-- +-- The concatenation of this list of slices is equal to the argument vector, +-- and each slice contains only equal elements. Returns nothing if no equal +-- elements are found. +-- +-- This is the equivalent of 'groupBy (==)'. +-- +-- >>> import qualified Data.NonEmptyUVector as NEV +-- >>> NEV.group (NEV.unsafeFromList "Mississippi") +-- "M" :| ["i","ss","i","ss","i","pp","i"] +-- +-- See also 'Data.Vector.group'. +-- +-- @since 1.0 +-- +group :: (V.Unbox a, Eq a) => NonEmptyUVector a -> NonEmpty (NonEmptyUVector a) +group = groupBy (==) + +-- | /O(n)/ Split a vector into a list of slices. +-- +-- +-- The concatenation of this list of slices is equal to the argument vector, +-- and each slice contains only equal elements, as determined by the equality +-- predicate function. +-- + +-- >>> import qualified Data.NonEmptyUVector as NEV +-- >>> import Data.Char (isUpper) +-- >>> NEV.groupBy (\a b -> isUpper a == isUpper b) (NEV.unsafeFromList "Mississippi River") +-- "M" :| ["ississippi ","R","iver"] +-- +-- See also 'Data.Vector.groupBy'. +-- +-- @since 1.0 +-- +groupBy + :: (Eq a, V.Unbox a) + => (a -> a -> Bool) + -> NonEmptyUVector a + -> NonEmpty (NonEmptyUVector a) +groupBy f = go + where + go v = + let + h = head v + t = NonEmptyUVector $ tail v + in case findIndex (not . f h) t of + Nothing -> v :| [] + Just n -> + let + z = NonEmptyUVector $ unsafeTake (n+1) v + x = NonEmptyUVector $ unsafeDrop (n+1) v + in z <| go x diff --git a/src/Data/Vector/NonEmpty/Unboxed/Internal.hs b/src/Data/Vector/NonEmpty/Unboxed/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Data/Vector/NonEmpty/Unboxed/Internal.hs @@ -0,0 +1,110 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE StandaloneDeriving #-} +-- | +-- Module : Data.Vector.NonEmpty.Unboxed.Internal +-- Copyright : (c) 2019-2026 Emily Pillmore, Koz Ross +-- License : BSD-style +-- +-- Maintainer : Emily Pillmore +-- Stability : experimental +-- Portability : non-portable +-- +-- Internal module exposing the constructors for +-- t'NonEmptyUVector' and t'NonEmptyMUVector'. +-- +-- /Warning/: Since the constructors are exposed here, by using this +-- module, you take on the risks that you break the non-emptiness +-- invariants of the main modules. Use at your own risk. +-- +-- @since 1.0 +-- +module Data.Vector.NonEmpty.Unboxed.Internal +( -- * Immutable unboxed vectors + NonEmptyUVector(..) + -- * Mutable unboxed vectors +, NonEmptyMUVector(..) + -- ** Mutable unboxed vector aliases +, NonEmptyIOUVector +, NonEmptySTUVector +) where + + +import Control.DeepSeq (NFData) +import Control.Monad.ST + +import Data.Data (Data) +import qualified Data.Vector.Unboxed as V +#if __GLASGOW_HASKELL__ < 912 +import Data.Typeable (Typeable) +#endif +import Data.Vector.Unboxed.Mutable (MVector) + +import qualified Text.Read as Read + + +-- ---------------------------------------------------------------------- -- +-- Non-empty immutable unboxed vectors + +-- | t'NonEmptyUVector' is a thin wrapper around 'Data.Vector.Unboxed.Vector' that +-- witnesses an API requiring non-empty construction, +-- initialization, and generation of non-empty vectors by design. +-- +-- A newtype wrapper was chosen so that no new pointer indirection +-- is introduced when working with 'Data.Vector.Unboxed.Vector's, and all performance +-- characteristics inherited from the "Data.Unboxed.Vector" API still apply. +-- +-- @since 1.0 +-- +newtype NonEmptyUVector a = NonEmptyUVector + { _neUvec :: V.Vector a + } deriving + ( Eq, Ord + , Data, NFData + , Semigroup +#if __GLASGOW_HASKELL__ < 912 + , Typeable +#endif + ) + +deriving via (V.Vector a) instance (Show a, V.Unbox a) => + Show (NonEmptyUVector a) + +instance (V.Unbox a, Read a) => Read (NonEmptyUVector a) where + readPrec = Read.readPrec >>= \case + [] -> Read.pfail + as -> return (NonEmptyUVector $ V.fromList as) + +-- ---------------------------------------------------------------------- -- +-- Non-empty unboxed mutable vectors + +-- | t'NonEmptyMUVector' is a thin wrapper around 'MVector' that +-- witnesses an API requiring non-empty construction, +-- initialization, and generation of non-empty vectors by design. +-- +-- A newtype wrapper was chosen so that no new pointer indirection +-- is introduced when working with 'MVector's, and all performance +-- characteristics inherited from the 'MVector' API still apply. +-- +-- @since 1.0 +-- +newtype NonEmptyMUVector s a = NonEmptyMUVector + { _nemUvec :: MVector s a } +#if __GLASGOW_HASKELL__ < 912 + deriving (Typeable) +#endif + +-- | t'NonEmptyMUVector' parametrized by 'Control.Monad.Primitive.PrimState' 'IO'. +-- +-- @since 1.0 +-- +type NonEmptyIOUVector = NonEmptyMUVector RealWorld + +-- | t'NonEmptyMUVector' parametrized by @t'Control.Monad.Primitive.PrimState' ('ST' s)@. +-- +-- @since 1.0 +-- +type NonEmptySTUVector s = NonEmptyMUVector s diff --git a/src/Data/Vector/NonEmpty/Unboxed/Mutable.hs b/src/Data/Vector/NonEmpty/Unboxed/Mutable.hs new file mode 100644 --- /dev/null +++ b/src/Data/Vector/NonEmpty/Unboxed/Mutable.hs @@ -0,0 +1,452 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE NoImplicitPrelude #-} +-- | +-- Module : Data.Vector.NonEmpty.Unboxed.Mutable +-- Copyright : (c) 2019-2026 Emily Pillmore, Koz Ross +-- License : BSD-style +-- +-- Maintainer : Emily Pillmore +-- Stability : experimental +-- Portability : non-portable +-- +-- Non-empty mutable unboxed vectors. +-- +module Data.Vector.NonEmpty.Unboxed.Mutable +( -- * Mutable boxed vectors + NonEmptyMUVector +, NonEmptyIOUVector +, NonEmptySTUVector + + -- * Accessors + -- ** Length information +, length + + -- ** Extracting subvectors +, slice, init, tail, take, drop, splitAt +, unsafeSlice, unsafeTake, unsafeDrop + + -- ** Overlapping +, overlaps + + -- ** Conversions +, fromMVector, toMVector, unsafeFromMVector + + -- ** Initialisation +, new, new1, unsafeNew +, replicate, replicate1 +, replicateM, replicate1M +, clone + + -- ** Growing +, grow, unsafeGrow + + -- ** Restricting memory usage +, clear + + -- * Accessing individual elements +, read, write, modify, swap +, unsafeRead, unsafeWrite, unsafeModify, unsafeSwap + + -- * Modifying vectors +, nextPermutation + + -- ** Filling and copying +, set, copy, move, unsafeCopy, unsafeMove +) where + + +import Prelude (Bool, Int, Ord, (.), max) + +import Control.Monad.Primitive + +import Data.Functor +import Data.Maybe (Maybe(..)) +import Data.Vector.Unboxed.Mutable (MVector) +import qualified Data.Vector.Unboxed.Mutable as M +import Data.Vector.NonEmpty.Unboxed.Internal + + +-- ---------------------------------------------------------------------- -- +-- Length information + +-- | Length of the mutable vector. +length :: M.Unbox a => NonEmptyMUVector s a -> Int +length = M.length . _nemUvec +{-# INLINE length #-} + +-- ---------------------------------------------------------------------- -- +-- Extracting subvectors + +-- | Yield a part of the mutable vector without copying. +-- +slice :: M.Unbox a => Int -> Int -> NonEmptyMUVector s a -> MVector s a +slice n m = M.slice n m . _nemUvec +{-# INLINE slice #-} + +-- | Yield at the first n elements without copying. +-- +take :: M.Unbox a => Int -> NonEmptyMUVector s a -> MVector s a +take n = M.take n . _nemUvec +{-# INLINE take #-} + +-- | Yield all but the first n elements without copying. +-- +drop :: M.Unbox a => Int -> NonEmptyMUVector s a -> MVector s a +drop n = M.drop n . _nemUvec +{-# INLINE drop #-} + +-- | Yield the first n elements paired with the remainder without copying. +-- +splitAt :: M.Unbox a => Int -> NonEmptyMUVector s a -> (MVector s a, MVector s a) +splitAt n = M.splitAt n . _nemUvec +{-# INLINE splitAt #-} + +-- | Yield all but the last element without copying. +-- +init :: M.Unbox a => NonEmptyMUVector s a -> MVector s a +init = M.unsafeInit . _nemUvec +{-# INLINE init #-} + +-- | Yield all but the first element without copying. +-- +tail :: M.Unbox a => NonEmptyMUVector s a -> MVector s a +tail = M.unsafeTail . _nemUvec +{-# INLINE tail #-} + +-- | Yield a part of the mutable vector without copying it. No bounds checks +-- are performed. +-- +unsafeSlice + :: M.Unbox a + => Int + -- ^ starting index + -> Int + -- ^ length of the slice + -> NonEmptyMUVector s a + -> MVector s a +unsafeSlice n m = M.unsafeSlice n m . _nemUvec +{-# INLINE unsafeSlice #-} + +-- | Yield the first n elements without copying. The vector must contain at +-- least n elements but this is not checked. +-- +unsafeTake :: M.Unbox a => Int -> NonEmptyMUVector s a -> MVector s a +unsafeTake n = M.unsafeTake n . _nemUvec +{-# INLINE unsafeTake #-} + +-- | Yield all but the first n elements without copying. The vector must +-- contain at least n elements but this is not checked. +-- +unsafeDrop :: M.Unbox a => Int -> NonEmptyMUVector s a -> MVector s a +unsafeDrop n = M.unsafeDrop n . _nemUvec +{-# INLINE unsafeDrop #-} + +-- ---------------------------------------------------------------------- -- +-- Overlapping + +-- | Check whether two vectors overlap. +-- +overlaps :: M.Unbox a => NonEmptyMUVector s a -> NonEmptyMUVector s a -> Bool +overlaps (NonEmptyMUVector v) (NonEmptyMUVector u) = M.overlaps v u +{-# INLINE overlaps #-} + +-- ---------------------------------------------------------------------- -- +-- Conversion + +-- | Convert a mutable vector to a non-empty mutable vector +-- +fromMVector :: M.Unbox a => MVector s a -> Maybe (NonEmptyMUVector s a) +fromMVector v = if M.null v then Nothing else Just (NonEmptyMUVector v) + +-- | Convert a non-empty mutable vector to a mutable vector +-- +toMVector :: M.Unbox a => NonEmptyMUVector s a -> MVector s a +toMVector = _nemUvec + +-- | Convert a mutable vector to a non-empty mutable vector +-- +-- /Warning:/ this function is unsafe and can result in empty non-empty +-- mutable vectors. If you call this function, the onus is on you to +-- make sure the mutable vector being converted is not empty. +-- +unsafeFromMVector :: M.Unbox a => MVector s a -> NonEmptyMUVector s a +unsafeFromMVector = NonEmptyMUVector +{-# INLINE unsafeFromMVector #-} + +-- ---------------------------------------------------------------------- -- +-- Initialisation + +-- | Create a mutable vector of the given length. +-- +new + :: (PrimMonad m, M.Unbox a) + => Int + -> m (Maybe (NonEmptyMUVector (PrimState m) a)) +new = fmap fromMVector . M.new +{-# INLINE new #-} + +-- | Create a mutable vector of the given length which is +-- @max n 1@. +-- +new1 + :: (PrimMonad m, M.Unbox a) + => Int + -> m (NonEmptyMUVector (PrimState m) a) +new1 n = fmap unsafeFromMVector (M.new (max n 1)) +{-# INLINE new1 #-} + +-- | Create a mutable vector of the given length. The memory is not initialized. +-- +unsafeNew + :: (PrimMonad m, M.Unbox a) + => Int + -> m (Maybe (NonEmptyMUVector (PrimState m) a)) +unsafeNew = fmap fromMVector . M.unsafeNew +{-# INLINE unsafeNew #-} + +-- | Create a mutable vector of the given length (0 if the length is negative) +-- and fill it with an initial value. +-- +replicate + :: (PrimMonad m, M.Unbox a) + => Int + -> a + -> m (Maybe (NonEmptyMUVector (PrimState m) a)) +replicate n a = fmap fromMVector (M.replicate n a) +{-# INLINE replicate #-} + +-- | Create a mutable vector of the length @max n 1@ for a given length, +-- and fill it with an initial value. +-- +replicate1 + :: (PrimMonad m, M.Unbox a) + => Int + -> a + -> m (NonEmptyMUVector (PrimState m) a) +replicate1 n a = fmap unsafeFromMVector (M.replicate (max n 1) a) +{-# INLINE replicate1 #-} + +-- | Create a mutable vector of the given length (0 if the length is negative) +-- and fill it with values produced by repeatedly executing the monadic action. +-- +replicateM + :: (PrimMonad m, M.Unbox a) + => Int + -> m a + -> m (Maybe (NonEmptyMUVector (PrimState m) a)) +replicateM n a = fmap fromMVector (M.replicateM n a) +{-# INLINE replicateM #-} + +-- | Create a mutable vector of the length @max n 1@ for a given length, +-- and fill it with values produced by repeatedly executing the monadic action. +-- +replicate1M + :: (PrimMonad m, M.Unbox a) + => Int + -> m a + -> m (Maybe (NonEmptyMUVector (PrimState m) a)) +replicate1M n a = fmap fromMVector (M.replicateM (max n 1) a) +{-# INLINE replicate1M #-} + +-- | Create a copy of a mutable vector. +-- +clone + :: (PrimMonad m, M.Unbox a) + => NonEmptyMUVector (PrimState m) a + -> m (NonEmptyMUVector (PrimState m) a) +clone (NonEmptyMUVector v) = fmap NonEmptyMUVector (M.clone v) +{-# INLINE clone #-} + +-- ---------------------------------------------------------------------- -- +-- Growing + +-- | Grow a vector by the given number of elements. The number must be +-- positive. +-- +grow + :: (PrimMonad m, M.Unbox a) + => NonEmptyMUVector (PrimState m) a + -> Int + -> m (NonEmptyMUVector (PrimState m) a) +grow (NonEmptyMUVector v) n = fmap NonEmptyMUVector (M.grow v n) +{-# INLINE grow #-} + +-- | Grow a vector by the given number of elements. The number must be +-- positive but this is not checked. +unsafeGrow + :: (PrimMonad m, M.Unbox a) + => NonEmptyMUVector (PrimState m) a + -> Int + -> m (NonEmptyMUVector (PrimState m) a) +unsafeGrow (NonEmptyMUVector v) n = fmap NonEmptyMUVector (M.unsafeGrow v n) +{-# INLINE unsafeGrow #-} + +-- ---------------------------------------------------------------------- -- +-- Restricting memory usage + +-- | Reset all elements of the vector to some undefined value, clearing all +-- references to external objects. This is usually a noop for unboxed vectors. +clear :: (PrimMonad m, M.Unbox a) => NonEmptyMUVector (PrimState m) a -> m () +clear = M.clear . _nemUvec +{-# INLINE clear #-} + +-- ---------------------------------------------------------------------- -- +-- Accessing individual elements + +-- | Yield the element at the given position. +-- +read + :: (PrimMonad m, M.Unbox a) + => NonEmptyMUVector (PrimState m) a + -> Int + -> m a +read (NonEmptyMUVector v) n = M.read v n +{-# INLINE read #-} + +-- | Replace the element at the given position. +-- +write + :: (PrimMonad m, M.Unbox a) + => NonEmptyMUVector (PrimState m) a + -> Int + -> a + -> m () +write (NonEmptyMUVector v) n a = M.write v n a +{-# INLINE write #-} + +-- | Modify the element at the given position. +-- +modify + :: (PrimMonad m, M.Unbox a) + => NonEmptyMUVector (PrimState m) a + -> (a -> a) + -> Int + -> m () +modify (NonEmptyMUVector v) f n = M.modify v f n +{-# INLINE modify #-} + +-- | Swap the elements at the given positions. +-- +swap + :: (PrimMonad m, M.Unbox a) + => NonEmptyMUVector (PrimState m) a + -> Int + -> Int + -> m () +swap (NonEmptyMUVector v) n m = M.swap v n m +{-# INLINE swap #-} + +-- | Yield the element at the given position. No bounds checks are performed. +-- +unsafeRead + :: (PrimMonad m, M.Unbox a) + => NonEmptyMUVector (PrimState m) a + -> Int + -> m a +unsafeRead (NonEmptyMUVector v) n = M.unsafeRead v n +{-# INLINE unsafeRead #-} + +-- | Replace the element at the given position. No bounds checks are performed. +-- +unsafeWrite + :: (PrimMonad m, M.Unbox a) + => NonEmptyMUVector (PrimState m) a + -> Int + -> a + -> m () +unsafeWrite (NonEmptyMUVector v) n a = M.unsafeWrite v n a +{-# INLINE unsafeWrite #-} + +-- | Modify the element at the given position. No bounds checks are performed. +-- +unsafeModify + :: (PrimMonad m, M.Unbox a) + => NonEmptyMUVector (PrimState m) a + -> (a -> a) + -> Int + -> m () +unsafeModify (NonEmptyMUVector v) f n = M.unsafeModify v f n +{-# INLINE unsafeModify #-} + +-- | Swap the elements at the given positions. No bounds checks are performed. +-- +unsafeSwap :: (PrimMonad m, M.Unbox a) => NonEmptyMUVector (PrimState m) a -> Int -> Int -> m () +unsafeSwap (NonEmptyMUVector v) n m = M.unsafeSwap v n m +{-# INLINE unsafeSwap #-} + +-- ---------------------------------------------------------------------- -- +-- Filling and copying + +-- | Set all elements of the vector to the given value. +-- +set :: (PrimMonad m, M.Unbox a) => NonEmptyMUVector (PrimState m) a -> a -> m () +set (NonEmptyMUVector v) a = M.set v a +{-# INLINE set #-} + +-- | Copy a vector. The two vectors must have the same length and may not +-- overlap. +-- +copy + :: (PrimMonad m, M.Unbox a) + => NonEmptyMUVector (PrimState m) a + -> NonEmptyMUVector (PrimState m) a + -> m () +copy (NonEmptyMUVector v) (NonEmptyMUVector v') = M.copy v v' +{-# INLINE copy #-} + +-- | Copy a vector. The two vectors must have the same length and may not +-- overlap. This is not checked. +-- +unsafeCopy + :: (PrimMonad m, M.Unbox a) + => NonEmptyMUVector (PrimState m) a + -- ^ target + -> NonEmptyMUVector (PrimState m) a + -- ^ source + -> m () +unsafeCopy (NonEmptyMUVector v) (NonEmptyMUVector v') = M.unsafeCopy v v' +{-# INLINE unsafeCopy #-} + +-- | Move the contents of a vector. The two vectors must have the same +-- length. +-- +-- If the vectors do not overlap, then this is equivalent to 'copy'. +-- Otherwise, the copying is performed as if the source vector were +-- copied to a temporary vector and then the temporary vector was copied +-- to the target vector. +-- +move + :: (PrimMonad m, M.Unbox a) + => NonEmptyMUVector (PrimState m) a + -> NonEmptyMUVector (PrimState m) a -> m () +move (NonEmptyMUVector v) (NonEmptyMUVector v') = M.move v v' +{-# INLINE move #-} + +-- | Move the contents of a vector. The two vectors must have the same +-- length, but this is not checked. +-- +-- If the vectors do not overlap, then this is equivalent to 'unsafeCopy'. +-- Otherwise, the copying is performed as if the source vector were +-- copied to a temporary vector and then the temporary vector was copied +-- to the target vector. +-- +unsafeMove + :: (PrimMonad m, M.Unbox a) + => NonEmptyMUVector (PrimState m) a + -- ^ target + -> NonEmptyMUVector (PrimState m) a + -- ^ source + -> m () +unsafeMove (NonEmptyMUVector v) (NonEmptyMUVector v') = M.unsafeMove v v' +{-# INLINE unsafeMove #-} + +-- | Compute the next (lexicographically) permutation of given vector in-place. +-- Returns False when input is the last permtuation +-- +nextPermutation + :: (PrimMonad m,Ord e, M.Unbox e) + => NonEmptyMUVector (PrimState m) e + -> m Bool +nextPermutation = M.nextPermutation . _nemUvec +{-# INLINE nextPermutation #-} diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -1,6 +1,6 @@ -- | -- Module : Main (tests) --- Copyright : (c) 2019-2026 Emily Pillmore +-- Copyright : (c) 2019-2026 Emily Pillmore, Koz Ross -- License : BSD -- Maintainer : Emily Pillmore -- Stability : Experimental @@ -12,16 +12,27 @@ import qualified Test.Data.Vector.NonEmpty.Accessors as Accessors +import qualified Test.Data.Vector.NonEmpty.AccessorsU as AccessorsU import qualified Test.Data.Vector.NonEmpty.Construction as Construction +import qualified Test.Data.Vector.NonEmpty.ConstructionU as ConstructionU import qualified Test.Data.Vector.NonEmpty.Conversion as Conversion +import qualified Test.Data.Vector.NonEmpty.ConversionU as ConversionU import qualified Test.Data.Vector.NonEmpty.Elementwise as Elementwise +import qualified Test.Data.Vector.NonEmpty.ElementwiseU as ElementwiseU import qualified Test.Data.Vector.NonEmpty.Folds as Folds +import qualified Test.Data.Vector.NonEmpty.FoldsU as FoldsU import qualified Test.Data.Vector.NonEmpty.Grouping as Grouping +import qualified Test.Data.Vector.NonEmpty.GroupingU as GroupingU import qualified Test.Data.Vector.NonEmpty.Instances as Instances +import qualified Test.Data.Vector.NonEmpty.InstancesU as InstancesU import qualified Test.Data.Vector.NonEmpty.Modification as Modification +import qualified Test.Data.Vector.NonEmpty.ModificationU as ModificationU import qualified Test.Data.Vector.NonEmpty.Mutable as Mutable +import qualified Test.Data.Vector.NonEmpty.MutableU as MutableU import qualified Test.Data.Vector.NonEmpty.Predicates as Predicates +import qualified Test.Data.Vector.NonEmpty.PredicatesU as PredicatesU import qualified Test.Data.Vector.NonEmpty.Scans as Scans +import qualified Test.Data.Vector.NonEmpty.ScansU as ScansU import Test.Tasty @@ -29,14 +40,25 @@ main :: IO () main = defaultMain $ testGroup "NonEmptyVector tests" [ Accessors.tests + , AccessorsU.tests , Construction.tests + , ConstructionU.tests , Conversion.tests + , ConversionU.tests , Modification.tests + , ModificationU.tests , Elementwise.tests + , ElementwiseU.tests , Predicates.tests + , PredicatesU.tests , Grouping.tests + , GroupingU.tests , Folds.tests + , FoldsU.tests , Scans.tests + , ScansU.tests , Instances.tests + , InstancesU.tests , Mutable.tests + , MutableU.tests ] diff --git a/test/Test/Data/Vector/NonEmpty/AccessorsU.hs b/test/Test/Data/Vector/NonEmpty/AccessorsU.hs new file mode 100644 --- /dev/null +++ b/test/Test/Data/Vector/NonEmpty/AccessorsU.hs @@ -0,0 +1,181 @@ +-- | +-- Module : Test.Data.Vector.NonEmpty.AccessorsU +-- Copyright : (c) 2019-2026 Emily Pillmore, Koz Ross +-- License : BSD-style +-- +-- Maintainer : Emily Pillmore +-- Stability : experimental +-- Portability : non-portable +-- +-- Properties for length information, indexing, and slicing. +-- +module Test.Data.Vector.NonEmpty.AccessorsU +( tests +) where + + +import Data.Functor.Identity (Identity(..)) +import qualified Data.List as List +import qualified Data.Vector.Unboxed as V +import Data.Vector.NonEmpty.Unboxed (NonEmptyUVector) +import qualified Data.Vector.NonEmpty.Unboxed as NEV + +import Test.Data.Vector.NonEmpty.Util +import Test.QuickCheck +import Test.Tasty +import Test.Tasty.QuickCheck + + +tests :: TestTree +tests = testGroup "Accessors (unboxed)" + [ testGroup "Length information" + [ testProperty "prop_length" prop_length + ] + , testGroup "Indexing" + [ testProperty "prop_head" prop_head + , testProperty "prop_last" prop_last + , testProperty "prop_index" prop_index + , testProperty "prop_index_out_of_bounds" prop_index_out_of_bounds + , testProperty "prop_index_maybe" prop_index_maybe + , testProperty "prop_unsafeIndex" prop_unsafeIndex + ] + , testGroup "Monadic indexing" + [ testProperty "prop_headM" prop_headM + , testProperty "prop_lastM" prop_lastM + , testProperty "prop_indexM" prop_indexM + , testProperty "prop_indexM_out_of_bounds" prop_indexM_out_of_bounds + , testProperty "prop_unsafeIndexM" prop_unsafeIndexM + ] + , testGroup "Slicing" + [ testProperty "prop_tail" prop_tail + , testProperty "prop_init" prop_init + , testProperty "prop_uncons" prop_uncons + , testProperty "prop_unsnoc" prop_unsnoc + , testProperty "prop_slice" prop_slice + , testProperty "prop_slice_out_of_bounds" prop_slice_out_of_bounds + , testProperty "prop_take" prop_take + , testProperty "prop_drop" prop_drop + , testProperty "prop_splitAt" prop_splitAt + , testProperty "prop_unsafeSlice" prop_unsafeSlice + , testProperty "prop_unsafeTake" prop_unsafeTake + , testProperty "prop_unsafeDrop" prop_unsafeDrop + ] + ] + +-- ---------------------------------------------------------------------- -- +-- Length information + +prop_length :: NonEmptyUVector Int -> Property +prop_length v = NEV.length v === List.length (elemsU v) + +-- ---------------------------------------------------------------------- -- +-- Indexing + +prop_head :: NonEmptyUVector Int -> Property +prop_head v = [NEV.head v] === List.take 1 (elemsU v) + +prop_last :: NonEmptyUVector Int -> Property +prop_last v = [NEV.last v] === List.take 1 (List.reverse (elemsU v)) + +prop_index :: NonEmptyUVector Int -> Property +prop_index v = forAll (genIndexU v) $ \i -> + Just (v NEV.! i) === lookupList i (elemsU v) + +prop_index_out_of_bounds :: NonEmptyUVector Int -> Property +prop_index_out_of_bounds v = forAll (genOutOfBoundsU v) $ \i -> + throws (v NEV.! i) + +prop_index_maybe :: NonEmptyUVector Int -> Int -> Property +prop_index_maybe v i = v NEV.!? i === lookupList i (elemsU v) + +prop_unsafeIndex :: NonEmptyUVector Int -> Property +prop_unsafeIndex v = forAll (genIndexU v) $ \i -> + Just (NEV.unsafeIndex v i) === lookupList i (elemsU v) + +-- ---------------------------------------------------------------------- -- +-- Monadic indexing + +prop_headM :: NonEmptyUVector Int -> Property +prop_headM v = [runIdentity (NEV.headM v)] === List.take 1 (elemsU v) + +prop_lastM :: NonEmptyUVector Int -> Property +prop_lastM v = + [runIdentity (NEV.lastM v)] === List.take 1 (List.reverse (elemsU v)) + +prop_indexM :: NonEmptyUVector Int -> Property +prop_indexM v = forAll (genIndexU v) $ \i -> + Just (runIdentity (NEV.indexM v i)) === lookupList i (elemsU v) + +prop_indexM_out_of_bounds :: NonEmptyUVector Int -> Property +prop_indexM_out_of_bounds v = forAll (genOutOfBoundsU v) $ \i -> + throws (runIdentity (NEV.indexM v i)) + +prop_unsafeIndexM :: NonEmptyUVector Int -> Property +prop_unsafeIndexM v = forAll (genIndexU v) $ \i -> + Just (runIdentity (NEV.unsafeIndexM v i)) === lookupList i (elemsU v) + +-- ---------------------------------------------------------------------- -- +-- Slicing + +prop_tail :: NonEmptyUVector Int -> Property +prop_tail v = V.toList (NEV.tail v) === List.drop 1 (elemsU v) + +prop_init :: NonEmptyUVector Int -> Property +prop_init v = + V.toList (NEV.init v) === List.take (List.length as - 1) as + where + as = elemsU v + +prop_uncons :: NonEmptyUVector Int -> Property +prop_uncons v = ([a], V.toList as) === List.splitAt 1 (elemsU v) + where + (a, as) = NEV.uncons v + +prop_unsnoc :: NonEmptyUVector Int -> Property +prop_unsnoc v = + (V.toList as, [a]) === List.splitAt (List.length (elemsU v) - 1) (elemsU v) + where + (as, a) = NEV.unsnoc v + +prop_slice :: NonEmptyUVector Int -> Property +prop_slice v = forAll (genSliceU v) $ \(i, m) -> + V.toList (NEV.slice i m v) === List.take m (List.drop i (elemsU v)) + +prop_slice_out_of_bounds :: NonEmptyUVector Int -> Property +prop_slice_out_of_bounds v = forAll genBadSlice $ \(i, m) -> + throws (V.toList (NEV.slice i m v)) + where + n = NEV.length v + + genBadSlice = oneof + [ (,) <$> choose (-10, -1) <*> choose (0, n) + , (,) <$> choose (0, n) <*> choose (-10, -1) + , do + i <- choose (0, n) + m <- choose (n - i + 1, n - i + 10) + pure (i, m) + ] + +prop_take :: Int -> NonEmptyUVector Int -> Property +prop_take n v = V.toList (NEV.take n v) === List.take n (elemsU v) + +prop_drop :: Int -> NonEmptyUVector Int -> Property +prop_drop n v = V.toList (NEV.drop n v) === List.drop n (elemsU v) + +prop_splitAt :: Int -> NonEmptyUVector Int -> Property +prop_splitAt n v = + (V.toList as, V.toList bs) === List.splitAt n (elemsU v) + where + (as, bs) = NEV.splitAt n v + +prop_unsafeSlice :: NonEmptyUVector Int -> Property +prop_unsafeSlice v = forAll (genSliceU v) $ \(i, m) -> + V.toList (NEV.unsafeSlice i m v) === List.take m (List.drop i (elemsU v)) + +prop_unsafeTake :: NonEmptyUVector Int -> Property +prop_unsafeTake v = forAll (choose (0, NEV.length v)) $ \n -> + V.toList (NEV.unsafeTake n v) === List.take n (elemsU v) + +prop_unsafeDrop :: NonEmptyUVector Int -> Property +prop_unsafeDrop v = forAll (choose (0, NEV.length v)) $ \n -> + V.toList (NEV.unsafeDrop n v) === List.drop n (elemsU v) diff --git a/test/Test/Data/Vector/NonEmpty/ConstructionU.hs b/test/Test/Data/Vector/NonEmpty/ConstructionU.hs new file mode 100644 --- /dev/null +++ b/test/Test/Data/Vector/NonEmpty/ConstructionU.hs @@ -0,0 +1,316 @@ +-- | +-- Module : Test.Data.Vector.NonEmpty.Construction +-- Copyright : (c) 2019-2026 Emily Pillmore, Koz Ross +-- License : BSD-style +-- +-- Maintainer : Emily Pillmore +-- Stability : experimental +-- Portability : non-portable +-- +-- Properties for initialization, unfolding, enumeration, and +-- concatenation. +-- +-- The 'Maybe'-valued constructors must yield 'Nothing' exactly when the +-- result would be empty, and the @*1@ variants must clamp their size to at +-- least one. +-- +module Test.Data.Vector.NonEmpty.ConstructionU +( tests +) where + + +import qualified Data.List as List +import Data.List.NonEmpty (NonEmpty(..)) +import qualified Data.Vector.Unboxed as V +import qualified Data.Vector.NonEmpty.Unboxed as NEV +import Data.Vector.NonEmpty.Unboxed.Internal (NonEmptyUVector(..)) + +import Test.Data.Vector.NonEmpty.Util +import Test.QuickCheck +import Test.Tasty +import Test.Tasty.QuickCheck + + +tests :: TestTree +tests = testGroup "Construction (unboxed)" + [ testGroup "Initialization" + [ testProperty "prop_singleton" prop_singleton + , testProperty "prop_replicate" prop_replicate + , testProperty "prop_replicate1" prop_replicate1 + , testProperty "prop_generate" prop_generate + , testProperty "prop_generate1" prop_generate1 + , testProperty "prop_iterateN" prop_iterateN + , testProperty "prop_iterateN1" prop_iterateN1 + ] + , testGroup "Monadic initialization" + [ testProperty "prop_replicateM" prop_replicateM + , testProperty "prop_replicate1M" prop_replicate1M + , testProperty "prop_generateM" prop_generateM + , testProperty "prop_generate1M" prop_generate1M + , testProperty "prop_iterateNM" prop_iterateNM + , testProperty "prop_iterateN1M" prop_iterateN1M + , testProperty "prop_create" prop_create + , testProperty "prop_unsafeCreate" prop_unsafeCreate + , testProperty "prop_createT" prop_createT + , testProperty "prop_unsafeCreateT" prop_unsafeCreateT + ] + , testGroup "Unfolding" + [ testProperty "prop_unfoldr" prop_unfoldr + , testProperty "prop_unfoldr1" prop_unfoldr1 + , testProperty "prop_unfoldrN" prop_unfoldrN + , testProperty "prop_unfoldr1N" prop_unfoldr1N + , testProperty "prop_unfoldrM" prop_unfoldrM + , testProperty "prop_unfoldr1M" prop_unfoldr1M + , testProperty "prop_unfoldrNM" prop_unfoldrNM + , testProperty "prop_unfoldr1NM" prop_unfoldr1NM + , testProperty "prop_constructN" prop_constructN + , testProperty "prop_constructrN" prop_constructrN + ] + , testGroup "Enumeration" + [ testProperty "prop_enumFromN" prop_enumFromN + , testProperty "prop_enumFromN1" prop_enumFromN1 + , testProperty "prop_enumFromStepN" prop_enumFromStepN + , testProperty "prop_enumFromStepN1" prop_enumFromStepN1 + , testProperty "prop_enumFromTo" prop_enumFromTo + , testProperty "prop_enumFromThenTo" prop_enumFromThenTo + ] + , testGroup "Concatenation" + [ testProperty "prop_cons" prop_cons + , testProperty "prop_consV" prop_consV + , testProperty "prop_snoc" prop_snoc + , testProperty "prop_snocV" prop_snocV + , testProperty "prop_append" prop_append + , testProperty "prop_concat" prop_concat + , testProperty "prop_concat1" prop_concat1 + ] + , testGroup "Restricting memory usage" + [ testProperty "prop_force" prop_force + ] + ] + +-- ---------------------------------------------------------------------- -- +-- Initialization + +prop_singleton :: Int -> Property +prop_singleton a = elemsU (NEV.singleton a) === [a] + +prop_replicate :: Int -> Int -> Property +prop_replicate n a = + fmap elemsU (NEV.replicate n a) === whenNonEmpty (List.replicate n a) + +prop_replicate1 :: Int -> Int -> Property +prop_replicate1 n a = + elemsU (NEV.replicate1 n a) === List.replicate (max n 1) a + +prop_generate :: Int -> Fun Int Int -> Property +prop_generate n (Fn f) = + fmap elemsU (NEV.generate n f) === whenNonEmpty (fmap f [0 .. n - 1]) + +prop_generate1 :: Int -> Fun Int Int -> Property +prop_generate1 n (Fn f) = + elemsU (NEV.generate1 n f) === fmap f [0 .. max n 1 - 1] + +prop_iterateN :: Int -> Fun Int Int -> Int -> Property +prop_iterateN n (Fn f) a = + fmap elemsU (NEV.iterateN n f a) + === whenNonEmpty (List.take n (List.iterate f a)) + +prop_iterateN1 :: Int -> Fun Int Int -> Int -> Property +prop_iterateN1 n (Fn f) a = + elemsU (NEV.iterateN1 n f a) === List.take (max n 1) (List.iterate f a) + +-- ---------------------------------------------------------------------- -- +-- Monadic initialization + +prop_replicateM :: Int -> Int -> Property +prop_replicateM n a = + fmap (fmap elemsU) (NEV.replicateM n (logged () a)) + === (List.replicate n (), whenNonEmpty (List.replicate n a)) + +prop_replicate1M :: Int -> Int -> Property +prop_replicate1M n a = + fmap elemsU (NEV.replicate1M n (logged () a)) + === (List.replicate n' (), List.replicate n' a) + where + n' = max n 1 + +prop_generateM :: Int -> Fun Int Int -> Property +prop_generateM n (Fn f) = + fmap (fmap elemsU) (NEV.generateM n (\i -> logged i (f i))) + === (is, whenNonEmpty (fmap f is)) + where + is = [0 .. n - 1] + +prop_generate1M :: Int -> Fun Int Int -> Property +prop_generate1M n (Fn f) = + fmap elemsU (NEV.generate1M n (\i -> logged i (f i))) + === (is, fmap f is) + where + is = [0 .. max n 1 - 1] + +-- The step function runs once per element after the seed. +prop_iterateNM :: Int -> Fun Int Int -> Int -> Property +prop_iterateNM n (Fn f) a = + fmap (fmap elemsU) (NEV.iterateNM n (\b -> logged b (f b)) a) + === (List.take (n - 1) as, whenNonEmpty (List.take n as)) + where + as = List.iterate f a + +prop_iterateN1M :: Int -> Fun Int Int -> Int -> Property +prop_iterateN1M n (Fn f) a = + fmap elemsU (NEV.iterateN1M n (\b -> logged b (f b)) a) + === (List.take (n' - 1) as, List.take n' as) + where + n' = max n 1 + as = List.iterate f a + +prop_create :: [Int] -> Property +prop_create as = + fmap elemsU (NEV.create (V.thaw (V.fromList as))) === whenNonEmpty as + +prop_unsafeCreate :: NonEmptyUVector Int -> Property +prop_unsafeCreate v = + elemsU (NEV.unsafeCreate (V.thaw (V.fromList (elemsU v)))) === elemsU v + +prop_createT :: [[Int]] -> Property +prop_createT ass = + fmap (fmap elemsU) (NEV.createT (traverse (V.thaw . V.fromList) ass)) + === fmap whenNonEmpty ass + +prop_unsafeCreateT :: [NonEmptyUVector Int] -> Property +prop_unsafeCreateT vs = + fmap elemsU (NEV.unsafeCreateT (traverse (V.thaw . V.fromList . elemsU) vs)) + === fmap elemsU vs + +-- ---------------------------------------------------------------------- -- +-- Unfolding + +prop_unfoldr :: Fun Int Int -> Int -> Property +prop_unfoldr (Fn f) b = + fmap elemsU (NEV.unfoldr (unfoldStep f) b) + === whenNonEmpty (List.unfoldr (unfoldStep f) b) + +prop_unfoldr1 :: Fun Int Int -> Int -> Int -> Property +prop_unfoldr1 (Fn f) a b = + elemsU (NEV.unfoldr1 (unfoldStep f) a b) + === a : List.unfoldr (unfoldStep f) b + +prop_unfoldrN :: Int -> Fun Int Int -> Int -> Property +prop_unfoldrN n (Fn f) b = + fmap elemsU (NEV.unfoldrN n (unfoldStep f) b) + === whenNonEmpty (List.take n (List.unfoldr (unfoldStep f) b)) + +-- The initial element is supplied in addition to at most @n@ unfolded ones. +prop_unfoldr1N :: Int -> Fun Int Int -> Int -> Int -> Property +prop_unfoldr1N n (Fn f) a b = + elemsU (NEV.unfoldr1N n (unfoldStep f) a b) + === a : List.take n (List.unfoldr (unfoldStep f) b) + +prop_unfoldrM :: Fun Int Int -> Int -> Property +prop_unfoldrM (Fn f) b = + fmap (fmap elemsU) (NEV.unfoldrM step b) + === fmap whenNonEmpty (unfoldrMList step b) + where + step s = logged s (unfoldStep f s) + +prop_unfoldr1M :: Fun Int Int -> Int -> Int -> Property +prop_unfoldr1M (Fn f) a b = + fmap elemsU (NEV.unfoldr1M step a b) === fmap (a :) (unfoldrMList step b) + where + step s = logged s (unfoldStep f s) + +prop_unfoldrNM :: Int -> Fun Int Int -> Int -> Property +prop_unfoldrNM n (Fn f) b = + fmap (fmap elemsU) (NEV.unfoldrNM n step b) + === fmap whenNonEmpty (unfoldrNMList n step b) + where + step s = logged s (unfoldStep f s) + +prop_unfoldr1NM :: Int -> Fun Int Int -> Int -> Int -> Property +prop_unfoldr1NM n (Fn f) a b = + fmap elemsU (NEV.unfoldr1NM n step a b) + === fmap (a :) (unfoldrNMList n step b) + where + step s = logged s (unfoldStep f s) + +-- Each element is generated from the prefix constructed so far. +prop_constructN :: Fun [Int] Int -> Property +prop_constructN (Fn f) = forAll (choose (0, 30)) $ \n -> + fmap elemsU (NEV.constructN n (f . V.toList)) + === whenNonEmpty (construct n []) + where + construct n acc + | List.length acc >= n = acc + | otherwise = construct n (acc ++ [f acc]) + +-- Each element is generated from the suffix constructed so far. +prop_constructrN :: Fun [Int] Int -> Property +prop_constructrN (Fn f) = forAll (choose (0, 30)) $ \n -> + fmap elemsU (NEV.constructrN n (f . V.toList)) + === whenNonEmpty (construct n []) + where + construct n acc + | List.length acc >= n = acc + | otherwise = construct n (f acc : acc) + +-- ---------------------------------------------------------------------- -- +-- Enumeration + +prop_enumFromN :: Int -> Int -> Property +prop_enumFromN a n = + fmap elemsU (NEV.enumFromN a n) === whenNonEmpty (fmap (a +) [0 .. n - 1]) + +prop_enumFromN1 :: Int -> Int -> Property +prop_enumFromN1 a n = + elemsU (NEV.enumFromN1 a n) === fmap (a +) [0 .. max n 1 - 1] + +prop_enumFromStepN :: Int -> Int -> Int -> Property +prop_enumFromStepN a s n = + fmap elemsU (NEV.enumFromStepN a s n) + === whenNonEmpty [ a + s * i | i <- [0 .. n - 1] ] + +prop_enumFromStepN1 :: Int -> Int -> Int -> Property +prop_enumFromStepN1 a s n = + elemsU (NEV.enumFromStepN1 a s n) === [ a + s * i | i <- [0 .. max n 1 - 1] ] + +prop_enumFromTo :: Int -> Int -> Property +prop_enumFromTo a b = fmap elemsU (NEV.enumFromTo a b) === whenNonEmpty [a .. b] + +-- A zero step would enumerate forever. +prop_enumFromThenTo :: Int -> Int -> Int -> Property +prop_enumFromThenTo a b c = a /= b ==> + fmap elemsU (NEV.enumFromThenTo a b c) === whenNonEmpty [a, b .. c] + +-- ---------------------------------------------------------------------- -- +-- Concatenation + +prop_cons :: Int -> NonEmptyUVector Int -> Property +prop_cons a v = elemsU (NEV.cons a v) === a : elemsU v + +prop_consV :: Int -> [Int] -> Property +prop_consV a as = elemsU (NEV.consV a (V.fromList as)) === a : as + +prop_snoc :: NonEmptyUVector Int -> Int -> Property +prop_snoc v a = elemsU (NEV.snoc v a) === elemsU v ++ [a] + +prop_snocV :: [Int] -> Int -> Property +prop_snocV as a = elemsU (NEV.snocV (V.fromList as) a) === as ++ [a] + +prop_append :: NonEmptyUVector Int -> NonEmptyUVector Int -> Property +prop_append v w = elemsU (v NEV.++ w) === elemsU v ++ elemsU w + +prop_concat :: [NonEmptyUVector Int] -> Property +prop_concat vs = + fmap elemsU (NEV.concat vs) === whenNonEmpty (List.concatMap elemsU vs) + +prop_concat1 :: NonEmptyUVector Int -> [NonEmptyUVector Int] -> Property +prop_concat1 v vs = + elemsU (NEV.concat1 (v :| vs)) === List.concatMap elemsU (v : vs) + +-- ---------------------------------------------------------------------- -- +-- Restricting memory usage + +prop_force :: NonEmptyUVector Int -> Property +prop_force v = forAll (genSliceU v) $ \(i, m) -> m > 0 ==> + let w = NonEmptyUVector (V.slice i m (_neUvec v)) + in elemsU (NEV.force w) === List.take m (List.drop i (elemsU v)) diff --git a/test/Test/Data/Vector/NonEmpty/ConversionU.hs b/test/Test/Data/Vector/NonEmpty/ConversionU.hs new file mode 100644 --- /dev/null +++ b/test/Test/Data/Vector/NonEmpty/ConversionU.hs @@ -0,0 +1,115 @@ +-- | +-- Module : Test.Data.Vector.NonEmpty.ConversionU +-- Copyright : (c) 2019-2026 Emily Pillmore, Koz Ross +-- License : BSD-style +-- +-- Maintainer : Emily Pillmore +-- Stability : experimental +-- Portability : non-portable +-- +-- Properties for conversions to and from non-empty lists, vectors, and +-- lists. +-- +module Test.Data.Vector.NonEmpty.ConversionU +( tests +) where + + +import qualified Data.List as List +import Data.List.NonEmpty (NonEmpty(..)) +import qualified Data.Vector.Unboxed as V +import Data.Vector.NonEmpty.Unboxed (NonEmptyUVector) +import qualified Data.Vector.NonEmpty.Unboxed as NEV + +import Test.Data.Vector.NonEmpty.Util +import Test.QuickCheck +import Test.Tasty +import Test.Tasty.QuickCheck + + +tests :: TestTree +tests = testGroup "Conversion" + [ testGroup "To/from non-empty lists" + [ testProperty "prop_toNonEmpty" prop_toNonEmpty + , testProperty "prop_fromNonEmpty" prop_fromNonEmpty + , testProperty "prop_from_to_nonempty" prop_from_to_nonempty + , testProperty "prop_fromNonEmptyN" prop_fromNonEmptyN + , testProperty "prop_fromNonEmptyN1" prop_fromNonEmptyN1 + , testProperty "prop_unsafeFromList" prop_unsafeFromList + ] + , testGroup "To/from vector" + [ testProperty "prop_toVector" prop_toVector + , testProperty "prop_fromVector" prop_fromVector + , testProperty "prop_unsafeFromVector" prop_unsafeFromVector + , testProperty "prop_from_to_vec" prop_from_to_vec + ] + , testGroup "To/from list" + [ testProperty "prop_toList" prop_toList + , testProperty "prop_fromList" prop_fromList + , testProperty "prop_fromListN" prop_fromListN + , testProperty "prop_from_to_list" prop_from_to_list + ] + ] + +-- ---------------------------------------------------------------------- -- +-- To/from non-empty lists + +prop_toNonEmpty :: NonEmptyUVector Int -> Property +prop_toNonEmpty v = NEV.toNonEmpty v === elems1U v + +prop_fromNonEmpty :: Int -> [Int] -> Property +prop_fromNonEmpty a as = elemsU (NEV.fromNonEmpty (a :| as)) === a : as + +prop_from_to_nonempty :: NonEmptyUVector Int -> Property +prop_from_to_nonempty v = NEV.fromNonEmpty (NEV.toNonEmpty v) === v + +prop_fromNonEmptyN :: Int -> Int -> [Int] -> Property +prop_fromNonEmptyN n a as = + fmap elemsU (NEV.fromNonEmptyN n (a :| as)) + === whenNonEmpty (List.take n (a : as)) + +prop_fromNonEmptyN1 :: Int -> Int -> [Int] -> Property +prop_fromNonEmptyN1 n a as = + elemsU (NEV.fromNonEmptyN1 n (a :| as)) === List.take (max n 1) (a : as) + +prop_unsafeFromList :: NonEmptyList Int -> Property +prop_unsafeFromList (NonEmpty as) = elemsU (NEV.unsafeFromList as) === as + +-- ---------------------------------------------------------------------- -- +-- To/from vector + +prop_toVector :: NonEmptyUVector Int -> Property +prop_toVector v = V.toList (NEV.toVector v) === elemsU v + +prop_fromVector :: [Int] -> Property +prop_fromVector as = + fmap elemsU (NEV.fromVector (V.fromList as)) === whenNonEmpty as + +prop_unsafeFromVector :: NonEmptyList Int -> Property +prop_unsafeFromVector (NonEmpty as) = + elemsU (NEV.unsafeFromVector (V.fromList as)) === as + +prop_from_to_vec :: NonEmptyUVector Int -> NonEmptyList Int -> Property +prop_from_to_vec t (NonEmpty as) = + NEV.fromVector (NEV.toVector t) === Just t + .&&. (NEV.toVector <$> NEV.fromVector u) === Just u + where + u = V.fromList as + +-- ---------------------------------------------------------------------- -- +-- To/from list + +prop_toList :: NonEmptyUVector Int -> Property +prop_toList v = NEV.toList v === elemsU v + +prop_fromList :: [Int] -> Property +prop_fromList as = fmap elemsU (NEV.fromList as) === whenNonEmpty as + +prop_fromListN :: Int -> [Int] -> Property +prop_fromListN n as = + fmap elemsU (NEV.fromListN n as) === whenNonEmpty (List.take n as) + +prop_from_to_list :: NonEmptyUVector Int -> NonEmptyList Int -> Property +prop_from_to_list t (NonEmpty u) = + NEV.fromList (NEV.toList t) === Just t + .&&. fmap NEV.toList (NEV.fromList u) === Just u diff --git a/test/Test/Data/Vector/NonEmpty/ElementwiseU.hs b/test/Test/Data/Vector/NonEmpty/ElementwiseU.hs new file mode 100644 --- /dev/null +++ b/test/Test/Data/Vector/NonEmpty/ElementwiseU.hs @@ -0,0 +1,288 @@ +-- | +-- Module : Test.Data.Vector.NonEmpty.ElementwiseU +-- Copyright : (c) 2019-2026 Emily Pillmore, Koz Ross +-- License : BSD-style +-- +-- Maintainer : Emily Pillmore +-- Stability : experimental +-- Portability : non-portable +-- +-- Properties for indexing, mapping, zipping, and unzipping. +-- +-- Monadic operations run in a writer-style @([w], -)@ monad so that the +-- order and number of effects are observable. +-- +module Test.Data.Vector.NonEmpty.ElementwiseU +( tests +) where + + +import qualified Data.List as List +import Data.Vector.NonEmpty.Unboxed (NonEmptyUVector) +import qualified Data.Vector.NonEmpty.Unboxed as NEV + +import Test.Data.Vector.NonEmpty.Util +import Test.QuickCheck +import Test.Tasty +import Test.Tasty.QuickCheck + + +tests :: TestTree +tests = testGroup "Elementwise" + [ testGroup "Indexing" + [ testProperty "prop_indexed" prop_indexed + ] + , testGroup "Mapping" + [ testProperty "prop_map" prop_map + , testProperty "prop_imap" prop_imap + , testProperty "prop_concatMap" prop_concatMap + ] + , testGroup "Monadic mapping" + [ testProperty "prop_mapM" prop_mapM + , testProperty "prop_imapM" prop_imapM + , testProperty "prop_mapM_" prop_mapM_ + , testProperty "prop_imapM_" prop_imapM_ + , testProperty "prop_forM" prop_forM + , testProperty "prop_forM_" prop_forM_ + ] + , testGroup "Zipping" + [ testProperty "prop_zipWith" prop_zipWith + , testProperty "prop_zipWith3" prop_zipWith3 + {- + , testProperty "prop_zipWith4" prop_zipWith4 + , testProperty "prop_zipWith5" prop_zipWith5 + , testProperty "prop_zipWith6" prop_zipWith6 + , testProperty "prop_izipWith" prop_izipWith + , testProperty "prop_izipWith3" prop_izipWith3 + , testProperty "prop_izipWith4" prop_izipWith4 + , testProperty "prop_izipWith5" prop_izipWith5 + , testProperty "prop_izipWith6" prop_izipWith6 + -} + , testProperty "prop_zip" prop_zip + , testProperty "prop_zip3" prop_zip3 + , testProperty "prop_zip4" prop_zip4 + , testProperty "prop_zip5" prop_zip5 + , testProperty "prop_zip6" prop_zip6 + ] + , testGroup "Monadic zipping" + [ testProperty "prop_zipWithM" prop_zipWithM + , testProperty "prop_zipWithM_" prop_zipWithM_ + , testProperty "prop_izipWithM" prop_izipWithM + , testProperty "prop_izipWithM_" prop_izipWithM_ + ] + , testGroup "Unzipping" + [ testProperty "prop_unzip" prop_unzip + , testProperty "prop_unzip3" prop_unzip3 + , testProperty "prop_unzip4" prop_unzip4 + , testProperty "prop_unzip5" prop_unzip5 + , testProperty "prop_unzip6" prop_unzip6 + ] + ] + +type V = NonEmptyUVector Int + +-- ---------------------------------------------------------------------- -- +-- Indexing + +prop_indexed :: V -> Property +prop_indexed v = elemsU (NEV.indexed v) === List.zip [0 ..] (elemsU v) + +-- ---------------------------------------------------------------------- -- +-- Mapping + +prop_map :: Fun Int Int -> V -> Property +prop_map (Fn f) v = elemsU (NEV.map f v) === List.map f (elemsU v) + +prop_imap :: Fun (Int, Int) Int -> V -> Property +prop_imap (Fn2 f) v = elemsU (NEV.imap f v) === List.zipWith f [0 ..] (elemsU v) + +prop_concatMap :: Fun Int V -> V -> Property +prop_concatMap (Fn f) v = + elemsU (NEV.concatMap f v) === List.concatMap (elemsU . f) (elemsU v) + +-- ---------------------------------------------------------------------- -- +-- Monadic mapping + +prop_mapM :: Fun Int Int -> V -> Property +prop_mapM (Fn f) v = + fmap elemsU (NEV.mapM (\a -> logged a (f a)) v) + === (elemsU v, List.map f (elemsU v)) + +prop_imapM :: Fun (Int, Int) Int -> V -> Property +prop_imapM (Fn2 f) v = + fmap elemsU (NEV.imapM (\i a -> logged i (f i a)) v) + === (is, List.zipWith f is (elemsU v)) + where + is = [0 .. NEV.length v - 1] + +prop_mapM_ :: V -> Property +prop_mapM_ v = NEV.mapM_ (\a -> logged a a) v === (elemsU v, ()) + +prop_imapM_ :: V -> Property +prop_imapM_ v = + NEV.imapM_ (\i a -> logged (i, a) a) v + === (List.zip [0 ..] (elemsU v), ()) + +prop_forM :: Fun Int Int -> V -> Property +prop_forM (Fn f) v = + fmap elemsU (NEV.forM v (\a -> logged a (f a))) + === (elemsU v, List.map f (elemsU v)) + +prop_forM_ :: V -> Property +prop_forM_ v = NEV.forM_ v (\a -> logged a a) === (elemsU v, ()) + +-- ---------------------------------------------------------------------- -- +-- Zipping +-- +-- The higher arities collect their arguments in order, so the models +-- detect both truncation to the shortest input and argument order. + +prop_zipWith :: Fun (Int, Int) Int -> V -> V -> Property +prop_zipWith (Fn2 f) a b = + elemsU (NEV.zipWith f a b) === List.zipWith f (elemsU a) (elemsU b) + +prop_zipWith3 :: Fun (Int, Int, Int) Int -> V -> V -> V -> Property +prop_zipWith3 (Fn3 f) a b c = + elemsU (NEV.zipWith3 f a b c) + === List.zipWith3 f (elemsU a) (elemsU b) (elemsU c) + +{- +prop_zipWith4 :: V -> V -> V -> V -> Property +prop_zipWith4 a b c d = + elemsU (NEV.zipWith4 k a b c d) + === List.zipWith4 k (elemsU a) (elemsU b) (elemsU c) (elemsU d) + where + k p q r s = [p, q, r, s] + +prop_zipWith5 :: V -> V -> V -> V -> V -> Property +prop_zipWith5 a b c d e = + elemsU (NEV.zipWith5 k a b c d e) + === List.zipWith5 k (elemsU a) (elemsU b) (elemsU c) (elemsU d) (elemsU e) + where + k p q r s t = [p, q, r, s, t] + +prop_zipWith6 :: V -> V -> V -> V -> V -> V -> Property +prop_zipWith6 a b c d e f = + elemsU (NEV.zipWith6 k a b c d e f) + === List.zipWith6 k + (elemsU a) (elemsU b) (elemsU c) (elemsU d) (elemsU e) (elemsU f) + where + k p q r s t u = [p, q, r, s, t, u] + +prop_izipWith :: V -> V -> Property +prop_izipWith a b = + elemsU (NEV.izipWith k a b) === List.zipWith3 k [0 ..] (elemsU a) (elemsU b) + where + k i p q = [i, p, q] + +prop_izipWith3 :: V -> V -> V -> Property +prop_izipWith3 a b c = + elemsU (NEV.izipWith3 k a b c) + === List.zipWith4 k [0 ..] (elemsU a) (elemsU b) (elemsU c) + where + k i p q r = [i, p, q, r] + +prop_izipWith4 :: V -> V -> V -> V -> Property +prop_izipWith4 a b c d = + elemsU (NEV.izipWith4 k a b c d) + === List.zipWith5 k [0 ..] (elemsU a) (elemsU b) (elemsU c) (elemsU d) + where + k i p q r s = [i, p, q, r, s] + +prop_izipWith5 :: V -> V -> V -> V -> V -> Property +prop_izipWith5 a b c d e = + elemsU (NEV.izipWith5 k a b c d e) + === List.zipWith6 k [0 ..] + (elemsU a) (elemsU b) (elemsU c) (elemsU d) (elemsU e) + where + k i p q r s t = [i, p, q, r, s, t] + +prop_izipWith6 :: V -> V -> V -> V -> V -> V -> Property +prop_izipWith6 a b c d e f = + elemsU (NEV.izipWith6 k a b c d e f) + === List.zipWith7 k [0 ..] + (elemsU a) (elemsU b) (elemsU c) (elemsU d) (elemsU e) (elemsU f) + where + k i p q r s t u = [i, p, q, r, s, t, u] +-} + +prop_zip :: V -> V -> Property +prop_zip a b = elemsU (NEV.zip a b) === List.zip (elemsU a) (elemsU b) + +prop_zip3 :: V -> V -> V -> Property +prop_zip3 a b c = + elemsU (NEV.zip3 a b c) === List.zip3 (elemsU a) (elemsU b) (elemsU c) + +prop_zip4 :: V -> V -> V -> V -> Property +prop_zip4 a b c d = + elemsU (NEV.zip4 a b c d) + === List.zip4 (elemsU a) (elemsU b) (elemsU c) (elemsU d) + +prop_zip5 :: V -> V -> V -> V -> V -> Property +prop_zip5 a b c d e = + elemsU (NEV.zip5 a b c d e) + === List.zip5 (elemsU a) (elemsU b) (elemsU c) (elemsU d) (elemsU e) + +prop_zip6 :: V -> V -> V -> V -> V -> V -> Property +prop_zip6 a b c d e f = + elemsU (NEV.zip6 a b c d e f) + === List.zip6 (elemsU a) (elemsU b) (elemsU c) (elemsU d) (elemsU e) (elemsU f) + +-- ---------------------------------------------------------------------- -- +-- Monadic zipping + +prop_zipWithM :: Fun (Int, Int) Int -> V -> V -> Property +prop_zipWithM (Fn2 f) a b = + fmap elemsU (NEV.zipWithM (\p q -> logged (p, q) (f p q)) a b) + === (ps, List.map (uncurry f) ps) + where + ps = List.zip (elemsU a) (elemsU b) + +prop_zipWithM_ :: V -> V -> Property +prop_zipWithM_ a b = + NEV.zipWithM_ (\p q -> logged (p, q) p) a b + === (List.zip (elemsU a) (elemsU b), ()) + +prop_izipWithM :: Fun (Int, Int, Int) Int -> V -> V -> Property +prop_izipWithM (Fn3 f) a b = + fmap elemsU (NEV.izipWithM (\i p q -> logged i (f i p q)) a b) + === (List.map fst ips, List.map (\(i, (p, q)) -> f i p q) ips) + where + ips = List.zip [0 ..] (List.zip (elemsU a) (elemsU b)) + +prop_izipWithM_ :: V -> V -> Property +prop_izipWithM_ a b = + NEV.izipWithM_ (\i p q -> logged (i, p, q) p) a b + === (List.zip3 [0 ..] (elemsU a) (elemsU b), ()) + +-- ---------------------------------------------------------------------- -- +-- Unzipping + +prop_unzip :: NonEmptyUVector (Int, Int) -> Property +prop_unzip v = (elemsU a, elemsU b) === List.unzip (elemsU v) + where + (a, b) = NEV.unzip v + +prop_unzip3 :: NonEmptyUVector (Int, Int, Int) -> Property +prop_unzip3 v = (elemsU a, elemsU b, elemsU c) === List.unzip3 (elemsU v) + where + (a, b, c) = NEV.unzip3 v + +prop_unzip4 :: NonEmptyUVector (Int, Int, Int, Int) -> Property +prop_unzip4 v = + (elemsU a, elemsU b, elemsU c, elemsU d) === List.unzip4 (elemsU v) + where + (a, b, c, d) = NEV.unzip4 v + +prop_unzip5 :: NonEmptyUVector (Int, Int, Int, Int, Int) -> Property +prop_unzip5 v = + (elemsU a, elemsU b, elemsU c, elemsU d, elemsU e) === List.unzip5 (elemsU v) + where + (a, b, c, d, e) = NEV.unzip5 v + +prop_unzip6 :: NonEmptyUVector (Int, Int, Int, Int, Int, Int) -> Property +prop_unzip6 v = + (elemsU a, elemsU b, elemsU c, elemsU d, elemsU e, elemsU f) + === List.unzip6 (elemsU v) + where + (a, b, c, d, e, f) = NEV.unzip6 v diff --git a/test/Test/Data/Vector/NonEmpty/FoldsU.hs b/test/Test/Data/Vector/NonEmpty/FoldsU.hs new file mode 100644 --- /dev/null +++ b/test/Test/Data/Vector/NonEmpty/FoldsU.hs @@ -0,0 +1,285 @@ +-- | +-- Module : Test.Data.Vector.NonEmpty.FoldsU +-- Copyright : (c) 2019-2026 Emily Pillmore, Koz Ross +-- License : BSD-style +-- +-- Maintainer : Emily Pillmore +-- Stability : experimental +-- Portability : non-portable +-- +-- Properties for folds, specialized folds, monadic folds, and sequencing. +-- +-- Fold functions are arbitrary, hence neither associative nor commutative, +-- so the models pin down fold direction and argument order. Monadic folds +-- run in a writer-style @([w], -)@ monad to expose effect order. +-- +module Test.Data.Vector.NonEmpty.FoldsU +( tests +) where + + +import qualified Control.Monad as Monad +import qualified Data.List as List +import Data.List.NonEmpty (NonEmpty(..)) +import Data.Ord (comparing) +import Data.Vector.NonEmpty.Unboxed (NonEmptyUVector) +import qualified Data.Vector.NonEmpty.Unboxed as NEV + +import Test.Data.Vector.NonEmpty.Util +import Test.QuickCheck +import Test.Tasty +import Test.Tasty.QuickCheck + + +tests :: TestTree +tests = testGroup "Folds (unboxed)" + [ testGroup "Folding" + [ testProperty "prop_foldl" prop_foldl + , testProperty "prop_foldl1" prop_foldl1 + , testProperty "prop_foldl'" prop_foldl' + , testProperty "prop_foldl1'" prop_foldl1' + , testProperty "prop_foldr" prop_foldr + , testProperty "prop_foldr1" prop_foldr1 + , testProperty "prop_foldr'" prop_foldr' + , testProperty "prop_foldr1'" prop_foldr1' + , testProperty "prop_ifoldl" prop_ifoldl + , testProperty "prop_ifoldl'" prop_ifoldl' + , testProperty "prop_ifoldr" prop_ifoldr + , testProperty "prop_ifoldr'" prop_ifoldr' + ] + , testGroup "Specialized folds" + [ testProperty "prop_all" prop_all + , testProperty "prop_any" prop_any + , testProperty "prop_and" prop_and + , testProperty "prop_or" prop_or + , testProperty "prop_sum" prop_sum + , testProperty "prop_product" prop_product + , testProperty "prop_maximum" prop_maximum + , testProperty "prop_maximumBy" prop_maximumBy + , testProperty "prop_minimum" prop_minimum + , testProperty "prop_minimumBy" prop_minimumBy + , testProperty "prop_maxIndex" prop_maxIndex + , testProperty "prop_maxIndexBy" prop_maxIndexBy + , testProperty "prop_minIndex" prop_minIndex + , testProperty "prop_minIndexBy" prop_minIndexBy + ] + , testGroup "Monadic folds" + [ testProperty "prop_foldM" prop_foldM + , testProperty "prop_foldM'" prop_foldM' + , testProperty "prop_fold1M" prop_fold1M + , testProperty "prop_fold1M'" prop_fold1M' + , testProperty "prop_foldM_" prop_foldM_ + , testProperty "prop_foldM'_" prop_foldM'_ + , testProperty "prop_fold1M_" prop_fold1M_ + , testProperty "prop_fold1M'_" prop_fold1M'_ + , testProperty "prop_ifoldM" prop_ifoldM + , testProperty "prop_ifoldM'" prop_ifoldM' + , testProperty "prop_ifoldM_" prop_ifoldM_ + , testProperty "prop_ifoldM'_" prop_ifoldM'_ + ] + ] + +type V = NonEmptyUVector Int + +-- ---------------------------------------------------------------------- -- +-- Models + +indexedList :: V -> [(Int, Int)] +indexedList = List.zip [0 ..] . elemsU + +-- | Ties resolve to the first occurrence, matching @vector@. +-- +firstBy :: (a -> a -> Bool) -> [(Int, a)] -> (Int, a) +firstBy better = List.foldl1 (\x y -> if better (snd y) (snd x) then y else x) + +-- | A comparison with many ties, so that tie-breaking is exercised. +-- +coarse :: Int -> Int -> Ordering +coarse = comparing (`mod` 3) + +-- | A writer-style step that logs the accumulator and element it consumes, +-- exposing how the accumulator is threaded even when the result is +-- discarded. +-- +step :: (Int -> Int -> Int) -> Int -> Int -> ([(Int, Int)], Int) +step f acc a = logged (acc, a) (f acc a) + +-- | A writer-style indexed step that logs the accumulator and index it +-- consumes. +-- +istep + :: (Int -> Int -> Int -> Int) + -> Int + -> Int + -> Int + -> ([(Int, Int)], Int) +istep f acc i a = logged (acc, i) (f acc i a) + +-- ---------------------------------------------------------------------- -- +-- Folding + +prop_foldl :: Fun (Int, Int) Int -> Int -> V -> Property +prop_foldl (Fn2 f) z v = NEV.foldl f z v === List.foldl f z (elemsU v) + +prop_foldl1 :: Fun (Int, Int) Int -> V -> Property +prop_foldl1 (Fn2 f) v = NEV.foldl1 f v === foldl1 f (elems1U v) + +prop_foldl' :: Fun (Int, Int) Int -> Int -> V -> Property +prop_foldl' (Fn2 f) z v = NEV.foldl' f z v === List.foldl f z (elemsU v) + +prop_foldl1' :: Fun (Int, Int) Int -> V -> Property +prop_foldl1' (Fn2 f) v = NEV.foldl1' f v === foldl1 f (elems1U v) + +prop_foldr :: Fun (Int, Int) Int -> Int -> V -> Property +prop_foldr (Fn2 f) z v = NEV.foldr f z v === List.foldr f z (elemsU v) + +prop_foldr1 :: Fun (Int, Int) Int -> V -> Property +prop_foldr1 (Fn2 f) v = NEV.foldr1 f v === foldr1 f (elems1U v) + +prop_foldr' :: Fun (Int, Int) Int -> Int -> V -> Property +prop_foldr' (Fn2 f) z v = NEV.foldr' f z v === List.foldr f z (elemsU v) + +prop_foldr1' :: Fun (Int, Int) Int -> V -> Property +prop_foldr1' (Fn2 f) v = NEV.foldr1' f v === foldr1 f (elems1U v) + +prop_ifoldl :: Fun (Int, Int, Int) Int -> Int -> V -> Property +prop_ifoldl (Fn3 f) z v = + NEV.ifoldl f z v + === List.foldl (\acc (i, a) -> f acc i a) z (indexedList v) + +prop_ifoldl' :: Fun (Int, Int, Int) Int -> Int -> V -> Property +prop_ifoldl' (Fn3 f) z v = + NEV.ifoldl' f z v + === List.foldl (\acc (i, a) -> f acc i a) z (indexedList v) + +prop_ifoldr :: Fun (Int, Int, Int) Int -> Int -> V -> Property +prop_ifoldr (Fn3 f) z v = + NEV.ifoldr f z v + === List.foldr (\(i, a) acc -> f i a acc) z (indexedList v) + +prop_ifoldr' :: Fun (Int, Int, Int) Int -> Int -> V -> Property +prop_ifoldr' (Fn3 f) z v = + NEV.ifoldr' f z v + === List.foldr (\(i, a) acc -> f i a acc) z (indexedList v) + +-- ---------------------------------------------------------------------- -- +-- Specialized folds + +prop_all :: Fun Int Bool -> V -> Property +prop_all (Fn p) v = NEV.all p v === List.all p (elemsU v) + +prop_any :: Fun Int Bool -> V -> Property +prop_any (Fn p) v = NEV.any p v === List.any p (elemsU v) + +prop_and :: NonEmptyUVector Bool -> Property +prop_and v = NEV.and v === List.and (elemsU v) + +prop_or :: NonEmptyUVector Bool -> Property +prop_or v = NEV.or v === List.or (elemsU v) + +prop_sum :: V -> Property +prop_sum v = NEV.sum v === List.sum (elemsU v) + +prop_product :: V -> Property +prop_product v = NEV.product v === List.product (elemsU v) + +prop_maximum :: V -> Property +prop_maximum v = NEV.maximum v === maximum (elems1U v) + +prop_maximumBy :: V -> Property +prop_maximumBy v = + NEV.maximumBy coarse v + === snd (firstBy (\a b -> coarse a b == GT) (indexedList v)) + +prop_minimum :: V -> Property +prop_minimum v = NEV.minimum v === minimum (elems1U v) + +prop_minimumBy :: V -> Property +prop_minimumBy v = + NEV.minimumBy coarse v + === snd (firstBy (\a b -> coarse a b == LT) (indexedList v)) + +prop_maxIndex :: V -> Property +prop_maxIndex v = + NEV.maxIndex w === fst (firstBy (>) (indexedList w)) + where + w = vecU (List.map (`mod` 4) (elemsU v)) + +prop_maxIndexBy :: V -> Property +prop_maxIndexBy v = + NEV.maxIndexBy coarse v + === fst (firstBy (\a b -> coarse a b == GT) (indexedList v)) + +prop_minIndex :: V -> Property +prop_minIndex v = + NEV.minIndex w === fst (firstBy (<) (indexedList w)) + where + w = vecU (List.map (`mod` 4) (elemsU v)) + +prop_minIndexBy :: V -> Property +prop_minIndexBy v = + NEV.minIndexBy coarse v + === fst (firstBy (\a b -> coarse a b == LT) (indexedList v)) + +-- ---------------------------------------------------------------------- -- +-- Monadic folds + +prop_foldM :: Fun (Int, Int) Int -> Int -> V -> Property +prop_foldM (Fn2 f) z v = + NEV.foldM (step f) z v === Monad.foldM (step f) z (elemsU v) + +prop_foldM' :: Fun (Int, Int) Int -> Int -> V -> Property +prop_foldM' (Fn2 f) z v = + NEV.foldM' (step f) z v === Monad.foldM (step f) z (elemsU v) + +prop_fold1M :: Fun (Int, Int) Int -> V -> Property +prop_fold1M (Fn2 f) v = + NEV.fold1M (step f) v === Monad.foldM (step f) a as + where + a :| as = elems1U v + +prop_fold1M' :: Fun (Int, Int) Int -> V -> Property +prop_fold1M' (Fn2 f) v = + NEV.fold1M' (step f) v === Monad.foldM (step f) a as + where + a :| as = elems1U v + +prop_foldM_ :: Fun (Int, Int) Int -> Int -> V -> Property +prop_foldM_ (Fn2 f) z v = + NEV.foldM_ (step f) z v === Monad.foldM_ (step f) z (elemsU v) + +prop_foldM'_ :: Fun (Int, Int) Int -> Int -> V -> Property +prop_foldM'_ (Fn2 f) z v = + NEV.foldM'_ (step f) z v === Monad.foldM_ (step f) z (elemsU v) + +prop_fold1M_ :: Fun (Int, Int) Int -> V -> Property +prop_fold1M_ (Fn2 f) v = + NEV.fold1M_ (step f) v === Monad.foldM_ (step f) a as + where + a :| as = elems1U v + +prop_fold1M'_ :: Fun (Int, Int) Int -> V -> Property +prop_fold1M'_ (Fn2 f) v = + NEV.fold1M'_ (step f) v === Monad.foldM_ (step f) a as + where + a :| as = elems1U v + +prop_ifoldM :: Fun (Int, Int, Int) Int -> Int -> V -> Property +prop_ifoldM (Fn3 f) z v = + NEV.ifoldM (istep f) z v + === Monad.foldM (\acc (i, a) -> istep f acc i a) z (indexedList v) + +prop_ifoldM' :: Fun (Int, Int, Int) Int -> Int -> V -> Property +prop_ifoldM' (Fn3 f) z v = + NEV.ifoldM' (istep f) z v + === Monad.foldM (\acc (i, a) -> istep f acc i a) z (indexedList v) + +prop_ifoldM_ :: Fun (Int, Int, Int) Int -> Int -> V -> Property +prop_ifoldM_ (Fn3 f) z v = + NEV.ifoldM_ (istep f) z v + === Monad.foldM_ (\acc (i, a) -> istep f acc i a) z (indexedList v) + +prop_ifoldM'_ :: Fun (Int, Int, Int) Int -> Int -> V -> Property +prop_ifoldM'_ (Fn3 f) z v = + NEV.ifoldM'_ (istep f) z v + === Monad.foldM_ (\acc (i, a) -> istep f acc i a) z (indexedList v) diff --git a/test/Test/Data/Vector/NonEmpty/GroupingU.hs b/test/Test/Data/Vector/NonEmpty/GroupingU.hs new file mode 100644 --- /dev/null +++ b/test/Test/Data/Vector/NonEmpty/GroupingU.hs @@ -0,0 +1,107 @@ +module Test.Data.Vector.NonEmpty.GroupingU +( tests +) where + + +import qualified Data.List as List +import qualified Data.List.NonEmpty as NonEmpty +import Data.Vector.NonEmpty.Unboxed (NonEmptyUVector) +import Data.Vector.Unboxed (Unbox) +import qualified Data.Vector.NonEmpty.Unboxed as NEV + +import Test.Data.Vector.NonEmpty.Util +import Test.QuickCheck +import Test.Tasty +import Test.Tasty.QuickCheck + + +tests :: TestTree +tests = testGroup "Grouping (unboxed)" + [ testGroup "group" + [ testProperty "prop_group" prop_group + , testProperty "prop_group_singleton" prop_group_singleton + , testProperty "prop_group_all_equal" prop_group_all_equal + , testProperty "prop_group_distinct" prop_group_distinct + , testProperty "prop_group_runs" prop_group_runs + ] + , testGroup "groupBy" + [ testProperty "prop_groupBy" prop_groupBy + , testProperty "prop_groupBy_singleton" prop_groupBy_singleton + , testProperty "prop_groupBy_all_true" prop_groupBy_all_true + , testProperty "prop_groupBy_all_false" prop_groupBy_all_false + , testProperty "prop_groupBy_equivalence" prop_groupBy_equivalence + , testProperty "prop_groupBy_nontransitive" prop_groupBy_nontransitive + , testProperty "prop_groupBy_asymmetric" prop_groupBy_asymmetric + ] + ] + +groupElems :: Unbox element => NonEmpty.NonEmpty (NonEmptyUVector element) -> [[element]] +groupElems = List.map elemsU . NonEmpty.toList + +prop_group :: NonEmptyUVector Int -> Property +prop_group input = + groupElems (NEV.group (vecU values)) === List.group values + where + values = List.map (`mod` 4) (elemsU input) + +prop_group_singleton :: Int -> Property +prop_group_singleton value = + groupElems (NEV.group (vecU [value])) === [[value]] + +prop_group_all_equal :: Int -> Positive Int -> Property +prop_group_all_equal value (Positive count) = + groupElems (NEV.group (vecU values)) === [values] + where + values = List.replicate count value + +prop_group_distinct :: NonEmptyUVector Int -> Property +prop_group_distinct input = + groupElems (NEV.group (vecU values)) === List.map (: []) values + where + values = List.nub (elemsU input) + +prop_group_runs :: Property +prop_group_runs = once $ + groupElems (NEV.group (vecU "Mississippi")) + === ["M", "i", "ss", "i", "ss", "i", "pp", "i"] + +prop_groupBy :: Fun (Int, Int) Bool -> NonEmptyUVector Int -> Property +prop_groupBy (Fn2 predicate) input = + groupElems (NEV.groupBy predicate (vecU values)) + === List.groupBy predicate values + where + values = List.map (`mod` 4) (elemsU input) + +prop_groupBy_singleton :: Int -> Property +prop_groupBy_singleton value = + groupElems (NEV.groupBy predicate (vecU [value])) === [[value]] + where + predicate _ _ = error "groupBy evaluated its predicate on a singleton" + +prop_groupBy_all_true :: NonEmptyUVector Int -> Property +prop_groupBy_all_true input = + groupElems (NEV.groupBy (\_ _ -> True) input) === [elemsU input] + +prop_groupBy_all_false :: NonEmptyUVector Int -> Property +prop_groupBy_all_false input = + groupElems (NEV.groupBy (\_ _ -> False) input) + === List.map (: []) (elemsU input) + +prop_groupBy_equivalence :: NonEmptyUVector Int -> Property +prop_groupBy_equivalence input = + groupElems (NEV.groupBy sameParity input) + === List.groupBy sameParity (elemsU input) + where + sameParity first second = even first == even second + +prop_groupBy_nontransitive :: Property +prop_groupBy_nontransitive = once $ + groupElems (NEV.groupBy nearby (vecU [1, 2, 3, 4] :: NonEmptyUVector Int)) + === [[1, 2], [3, 4]] + where + nearby first second = abs (first - second) <= 1 + +prop_groupBy_asymmetric :: Property +prop_groupBy_asymmetric = once $ + groupElems (NEV.groupBy (<) (vecU [1, 2, 1, 3, 0, 4] :: NonEmptyUVector Int)) + === [[1, 2], [1, 3], [0, 4]] diff --git a/test/Test/Data/Vector/NonEmpty/InstancesU.hs b/test/Test/Data/Vector/NonEmpty/InstancesU.hs new file mode 100644 --- /dev/null +++ b/test/Test/Data/Vector/NonEmpty/InstancesU.hs @@ -0,0 +1,142 @@ +-- | +-- Module : Test.Data.Vector.NonEmpty.InstancesU +-- Copyright : (c) 2019-2026 Emily Pillmore, Koz Ross +-- License : BSD-style +-- +-- Maintainer : Emily Pillmore +-- Stability : experimental +-- Portability : non-portable +-- +-- Laws and list models for the type class instances of t'NonEmptyUVector'. +-- +module Test.Data.Vector.NonEmpty.InstancesU +( tests +) where + + +import Control.DeepSeq (rnf) +import Control.Exception (evaluate) + +import Data.Data (gmapM, gmapQ, gmapT, showConstr, toConstr) +import qualified Data.List as List +import Data.List.NonEmpty (NonEmpty(..)) +import Data.Semigroup (sconcat, stimes) +import Data.Vector.NonEmpty.Unboxed (NonEmptyUVector) +import qualified Data.Vector.NonEmpty.Unboxed as NEV + +import Test.Data.Vector.NonEmpty.Util +import Test.QuickCheck +import Test.Tasty +import Test.Tasty.QuickCheck + +import Text.Read (readMaybe) + + +tests :: TestTree +tests = testGroup "Instances (unboxed)" + [ testGroup "Eq" + [ testProperty "prop_eq" prop_eq + ] + , testGroup "Ord" + [ testProperty "prop_compare" prop_compare + ] + , testGroup "Show" + [ testProperty "prop_show" prop_show + , testProperty "prop_showsPrec" prop_showsPrec + ] + , testGroup "Read" + [ testProperty "prop_read_show" prop_read_show + , testProperty "prop_read_list" prop_read_list + ] + , testGroup "Semigroup" + [ testProperty "prop_append" prop_append + , testProperty "prop_semigroup_associativity" prop_semigroup_associativity + , testProperty "prop_sconcat" prop_sconcat + , testProperty "prop_stimes" prop_stimes + , testProperty "prop_stimes_non_positive" prop_stimes_non_positive + ] + , testGroup "NFData" + [ testProperty "prop_rnf" prop_rnf + , testProperty "prop_rnf_forces_elements" prop_rnf_forces_elements + ] + , testGroup "Data" + [ testProperty "prop_data" prop_data + ] + ] + +type V = NonEmptyUVector Int + +-- | Either the same vector or an unrelated one, so that equal pairs are +-- generated often. +-- +genNear :: V -> Gen V +genNear v = oneof [pure v, arbitrary] + +-- ---------------------------------------------------------------------- -- +-- Eq and Ord + +prop_eq :: V -> Property +prop_eq v = forAll (genNear v) $ \w -> (v == w) === (elemsU v == elemsU w) + +prop_compare :: V -> Property +prop_compare v = forAll (genNear v) $ \w -> + compare v w === compare (elemsU v) (elemsU w) + +-- ---------------------------------------------------------------------- -- +-- Show and Read + +prop_show :: V -> Property +prop_show v = show v === show (elemsU v) + +prop_showsPrec :: Int -> V -> String -> Property +prop_showsPrec d v s = showsPrec d v s === show (elemsU v) ++ s + +prop_read_show :: V -> Property +prop_read_show v = read (show v) === v + +-- The empty list must not parse. +prop_read_list :: [Int] -> Property +prop_read_list as = + fmap elemsU (readMaybe (show as) :: Maybe V) === whenNonEmpty as + +-- ---------------------------------------------------------------------- -- +-- Semigroup + +prop_append :: V -> V -> Property +prop_append v w = elemsU (v <> w) === elemsU v ++ elemsU w + +prop_semigroup_associativity :: V -> V -> V -> Property +prop_semigroup_associativity u v w = ((u <> v) <> w) === (u <> (v <> w)) + +prop_sconcat :: V -> [V] -> Property +prop_sconcat v vs = elemsU (sconcat (v :| vs)) === List.concatMap elemsU (v : vs) + +prop_stimes :: V -> Property +prop_stimes v = forAll (choose (1, 5)) $ \n -> + elemsU (stimes (n :: Int) v) === List.concat (List.replicate n (elemsU v)) + +-- A non-positive multiplier would produce an empty vector, so it must throw. +prop_stimes_non_positive :: V -> Property +prop_stimes_non_positive v = forAll (choose (-5, 0)) $ \n -> + throws (stimes (n :: Int) v) + +-- ---------------------------------------------------------------------- -- +-- NFData + +prop_rnf :: V -> Property +prop_rnf v = rnf v === () + +prop_rnf_forces_elements :: Property +prop_rnf_forces_elements = once $ + throwsIO (evaluate (rnf (NEV.singleton (error "unforced element" :: Int)))) + +-- ---------------------------------------------------------------------- -- +-- Data + +-- The representation is a single constructor wrapping a single field. +prop_data :: V -> Property +prop_data v = + gmapT id v === v + .&&. gmapM Just v === Just v + .&&. gmapQ (const ()) v === [()] + .&&. showConstr (toConstr v) === "NonEmptyUVector" diff --git a/test/Test/Data/Vector/NonEmpty/ModificationU.hs b/test/Test/Data/Vector/NonEmpty/ModificationU.hs new file mode 100644 --- /dev/null +++ b/test/Test/Data/Vector/NonEmpty/ModificationU.hs @@ -0,0 +1,184 @@ +-- | +-- Module : Test.Data.Vector.NonEmpty.ModificationU +-- Copyright : (c) 2019-2026 Emily Pillmore, Koz Ross +-- License : BSD-style +-- +-- Maintainer : Emily Pillmore +-- Stability : experimental +-- Portability : non-portable +-- +-- Properties for bulk updates, accumulations, permutations, and safe +-- destructive updates. +-- +module Test.Data.Vector.NonEmpty.ModificationU +( tests +) where + + +import qualified Data.List as List +import Data.Maybe (mapMaybe) +import qualified Data.Vector.Unboxed as V +import qualified Data.Vector.Unboxed.Mutable as MV +import Data.Vector.NonEmpty.Unboxed (NonEmptyUVector) +import qualified Data.Vector.NonEmpty.Unboxed as NEV + +import Test.Data.Vector.NonEmpty.Util +import Test.QuickCheck +import Test.Tasty +import Test.Tasty.QuickCheck + + +tests :: TestTree +tests = testGroup "Modification (unboxed)" + [ testGroup "Bulk updates" + [ testProperty "prop_bulk_update" prop_bulk_update + , testProperty "prop_bulk_update_out_of_bounds" prop_bulk_update_out_of_bounds + , testProperty "prop_update" prop_update + , testProperty "prop_update_" prop_update_ + , testProperty "prop_unsafeUpd" prop_unsafeUpd + , testProperty "prop_unsafeUpdate" prop_unsafeUpdate + , testProperty "prop_unsafeUpdate_" prop_unsafeUpdate_ + ] + , testGroup "Accumulations" + [ testProperty "prop_accum" prop_accum + , testProperty "prop_accum_out_of_bounds" prop_accum_out_of_bounds + , testProperty "prop_accumulate" prop_accumulate + , testProperty "prop_accumulate_" prop_accumulate_ + , testProperty "prop_unsafeAccum" prop_unsafeAccum + , testProperty "prop_unsafeAccumulate" prop_unsafeAccumulate + , testProperty "prop_unsafeAccumulate_" prop_unsafeAccumulate_ + ] + , testGroup "Permutations" + [ testProperty "prop_reverse" prop_reverse + , testProperty "prop_reverse_involutive" prop_reverse_involutive + , testProperty "prop_backpermute" prop_backpermute + , testProperty "prop_backpermute_out_of_bounds" prop_backpermute_out_of_bounds + , testProperty "prop_unsafeBackpermute" prop_unsafeBackpermute + ] + , testGroup "Safe destructive updates" + [ testProperty "prop_modify" prop_modify + , testProperty "prop_modify_preserves_input" prop_modify_preserves_input + ] + ] + +-- ---------------------------------------------------------------------- -- +-- Models + +-- | Later updates to the same index win. +-- +updateList :: [(Int, a)] -> [a] -> [a] +updateList us as = List.foldl' (\acc (i, a) -> adjustAt i (const a) acc) as us + +accumList :: (a -> b -> a) -> [(Int, b)] -> [a] -> [a] +accumList f us as = List.foldl' (\acc (i, b) -> adjustAt i (`f` b) acc) as us + +-- ---------------------------------------------------------------------- -- +-- Bulk updates + +prop_bulk_update :: NonEmptyUVector Int -> Property +prop_bulk_update v = forAll (genUpdatesU v) $ \us -> + elemsU (v NEV.// us) === updateList us (elemsU v) + +prop_bulk_update_out_of_bounds :: NonEmptyUVector Int -> Int -> Property +prop_bulk_update_out_of_bounds v a = forAll (genOutOfBoundsU v) $ \i -> + throws (v NEV.// [(i, a)]) + +prop_update :: NonEmptyUVector Int -> Property +prop_update v = forAll (genUpdatesU v) $ \us -> + elemsU (NEV.update v (V.fromList us)) === updateList us (elemsU v) + +-- Surplus values beyond the index vector are ignored. +prop_update_ :: NonEmptyUVector Int -> [Int] -> Property +prop_update_ v surplus = forAll (genUpdatesU v) $ \us -> + let (is, as) = List.unzip us + in elemsU (NEV.update_ v (V.fromList is) (V.fromList (as ++ surplus))) + === updateList us (elemsU v) + +prop_unsafeUpd :: NonEmptyUVector Int -> Property +prop_unsafeUpd v = forAll (genUpdatesU v) $ \us -> + elemsU (NEV.unsafeUpd v us) === updateList us (elemsU v) + +prop_unsafeUpdate :: NonEmptyUVector Int -> Property +prop_unsafeUpdate v = forAll (genUpdatesU v) $ \us -> + elemsU (NEV.unsafeUpdate v (V.fromList us)) === updateList us (elemsU v) + +prop_unsafeUpdate_ :: NonEmptyUVector Int -> Property +prop_unsafeUpdate_ v = forAll (genUpdatesU v) $ \us -> + let (is, as) = List.unzip us + in elemsU (NEV.unsafeUpdate_ v (V.fromList is) (V.fromList as)) + === updateList us (elemsU v) + +-- ---------------------------------------------------------------------- -- +-- Accumulations + +prop_accum :: Fun (Int, Int) Int -> NonEmptyUVector Int -> Property +prop_accum (Fn2 f) v = forAll (genUpdatesU v) $ \us -> + elemsU (NEV.accum f v us) === accumList f us (elemsU v) + +prop_accum_out_of_bounds :: NonEmptyUVector Int -> Int -> Property +prop_accum_out_of_bounds v b = forAll (genOutOfBoundsU v) $ \i -> + throws (NEV.accum (+) v [(i, b)]) + +prop_accumulate :: Fun (Int, Int) Int -> NonEmptyUVector Int -> Property +prop_accumulate (Fn2 f) v = forAll (genUpdatesU v) $ \us -> + elemsU (NEV.accumulate f v (V.fromList us)) === accumList f us (elemsU v) + +prop_accumulate_ :: Fun (Int, Int) Int -> NonEmptyUVector Int -> Property +prop_accumulate_ (Fn2 f) v = forAll (genUpdatesU v) $ \us -> + let (is, bs) = List.unzip us + in elemsU (NEV.accumulate_ f v (V.fromList is) (V.fromList bs)) + === accumList f us (elemsU v) + +prop_unsafeAccum :: Fun (Int, Int) Int -> NonEmptyUVector Int -> Property +prop_unsafeAccum (Fn2 f) v = forAll (genUpdatesU v) $ \us -> + elemsU (NEV.unsafeAccum f v us) === accumList f us (elemsU v) + +prop_unsafeAccumulate :: Fun (Int, Int) Int -> NonEmptyUVector Int -> Property +prop_unsafeAccumulate (Fn2 f) v = forAll (genUpdatesU v) $ \us -> + elemsU (NEV.unsafeAccumulate f v (V.fromList us)) + === accumList f us (elemsU v) + +prop_unsafeAccumulate_ :: Fun (Int, Int) Int -> NonEmptyUVector Int -> Property +prop_unsafeAccumulate_ (Fn2 f) v = forAll (genUpdatesU v) $ \us -> + let (is, bs) = List.unzip us + in elemsU (NEV.unsafeAccumulate_ f v (V.fromList is) (V.fromList bs)) + === accumList f us (elemsU v) + +-- ---------------------------------------------------------------------- -- +-- Permutations + +prop_reverse :: NonEmptyUVector Int -> Property +prop_reverse v = elemsU (NEV.reverse v) === List.reverse (elemsU v) + +prop_reverse_involutive :: NonEmptyUVector Int -> Property +prop_reverse_involutive v = NEV.reverse (NEV.reverse v) === v + +prop_backpermute :: NonEmptyUVector Int -> Property +prop_backpermute v = forAll (genIndicesU v) $ \is -> + elemsU (NEV.backpermute v is) + === mapMaybe (`lookupList` elemsU v) (elemsU is) + +prop_backpermute_out_of_bounds :: NonEmptyUVector Int -> Property +prop_backpermute_out_of_bounds v = forAll (genOutOfBoundsU v) $ \i -> + throws (NEV.backpermute v (NEV.singleton i)) + +prop_unsafeBackpermute :: NonEmptyUVector Int -> Property +prop_unsafeBackpermute v = forAll (genIndicesU v) $ \is -> + elemsU (NEV.unsafeBackpermute v is) + === mapMaybe (`lookupList` elemsU v) (elemsU is) + +-- ---------------------------------------------------------------------- -- +-- Safe destructive updates + +prop_modify :: NonEmptyUVector Int -> Int -> Property +prop_modify v a = forAll ((,) <$> genIndexU v <*> genIndexU v) $ \(i, j) -> + elemsU (NEV.modify (\mv -> MV.write mv i a >> MV.swap mv i j) v) + === swapAt i j (adjustAt i (const a) (elemsU v)) + +-- The input vector is copied, never mutated in place. +prop_modify_preserves_input :: NonEmptyList Int -> Int -> Property +prop_modify_preserves_input (NonEmpty as) a = + (elemsU w, elemsU v) === (List.map (const a) as, as) + where + v = vecU as + w = NEV.modify (`MV.set` a) v diff --git a/test/Test/Data/Vector/NonEmpty/MutableU.hs b/test/Test/Data/Vector/NonEmpty/MutableU.hs new file mode 100644 --- /dev/null +++ b/test/Test/Data/Vector/NonEmpty/MutableU.hs @@ -0,0 +1,440 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeApplications #-} +-- | +-- Module : Test.Data.Vector.NonEmpty.MutableU +-- Copyright : (c) 2019-2026 Emily Pillmore, Koz Ross +-- License : BSD-style +-- +-- Maintainer : Emily Pillmore +-- Stability : experimental +-- Portability : non-portable +-- +-- Properties for non-empty mutable vectors, observed by freezing them +-- into lists. +-- +module Test.Data.Vector.NonEmpty.MutableU +( tests +) where + + +import Control.Monad.ST (ST, runST) + +import qualified Data.List as List +import qualified Data.List.NonEmpty as NonEmpty +import Data.STRef (modifySTRef', newSTRef, readSTRef) +import qualified Data.Vector.Unboxed as V +import Data.Vector.Unboxed.Mutable (MVector) +import qualified Data.Vector.Unboxed.Mutable as MV +import Data.Vector.NonEmpty.Unboxed.Internal + ( NonEmptyMUVector(..) + , NonEmptyUVector(..) + , NonEmptyIOUVector + , NonEmptySTUVector + ) +import qualified Data.Vector.NonEmpty.Unboxed.Mutable as NEMV + +import Test.Data.Vector.NonEmpty.Util +import Test.QuickCheck +import Test.Tasty +import Test.Tasty.QuickCheck + + +tests :: TestTree +tests = testGroup "Mutable (unboxed)" + [ testGroup "Length information" + [ testProperty "prop_length" prop_length + ] + , testGroup "Extracting subvectors" + [ testProperty "prop_slice" prop_slice + , testProperty "prop_slice_shares" prop_slice_shares + , testProperty "prop_init" prop_init + , testProperty "prop_tail" prop_tail + , testProperty "prop_take" prop_take + , testProperty "prop_drop" prop_drop + , testProperty "prop_splitAt" prop_splitAt + , testProperty "prop_unsafeSlice" prop_unsafeSlice + , testProperty "prop_unsafeTake" prop_unsafeTake + , testProperty "prop_unsafeDrop" prop_unsafeDrop + ] + , testGroup "Overlapping" + [ testProperty "prop_overlaps_self" prop_overlaps_self + , testProperty "prop_overlaps_distinct" prop_overlaps_distinct + , testProperty "prop_overlaps_slices" prop_overlaps_slices + ] + , testGroup "Conversions" + [ testProperty "prop_fromMVector" prop_fromMVector + , testProperty "prop_toMVector" prop_toMVector + , testProperty "prop_unsafeFromMVector" prop_unsafeFromMVector + ] + , testGroup "Initialisation" + [ testProperty "prop_new" prop_new + , testProperty "prop_new1" prop_new1 + , testProperty "prop_unsafeNew" prop_unsafeNew + , testProperty "prop_replicate" prop_replicate + , testProperty "prop_replicate1" prop_replicate1 + , testProperty "prop_replicateM" prop_replicateM + , testProperty "prop_replicate1M" prop_replicate1M + , testProperty "prop_clone" prop_clone + ] + , testGroup "Growing" + [ testProperty "prop_grow" prop_grow + , testProperty "prop_grow_negative" prop_grow_negative + , testProperty "prop_unsafeGrow" prop_unsafeGrow + ] + , testGroup "Accessing individual elements" + [ testProperty "prop_read" prop_read + , testProperty "prop_read_out_of_bounds" prop_read_out_of_bounds + , testProperty "prop_write" prop_write + , testProperty "prop_write_out_of_bounds" prop_write_out_of_bounds + , testProperty "prop_modify" prop_modify + , testProperty "prop_swap" prop_swap + , testProperty "prop_unsafeRead" prop_unsafeRead + , testProperty "prop_unsafeWrite" prop_unsafeWrite + , testProperty "prop_unsafeModify" prop_unsafeModify + , testProperty "prop_unsafeSwap" prop_unsafeSwap + ] + , testGroup "Modifying vectors" + [ testProperty "prop_nextPermutation" prop_nextPermutation + , testProperty "prop_nextPermutation_last" prop_nextPermutation_last + ] + , testGroup "Filling and copying" + [ testProperty "prop_set" prop_set + , testProperty "prop_copy" prop_copy + , testProperty "prop_copy_length_mismatch" prop_copy_length_mismatch + , testProperty "prop_unsafeCopy" prop_unsafeCopy + , testProperty "prop_move" prop_move + , testProperty "prop_unsafeMove" prop_unsafeMove + ] + ] + +type V = NonEmptyUVector Int + +-- ---------------------------------------------------------------------- -- +-- Running mutable vectors + +thaw :: V.Unbox a => NonEmptyUVector a -> ST s (NonEmptySTUVector s a) +thaw = fmap NonEmptyMUVector . V.thaw . _neUvec + +thawIO :: V.Unbox a => NonEmptyUVector a -> IO (NonEmptyIOUVector a) +thawIO = fmap NonEmptyMUVector . V.thaw . _neUvec + +-- | Run a computation against a fresh mutable copy of the vector. +-- +withThawed :: V.Unbox a => NonEmptyUVector a -> (forall s. NonEmptySTUVector s a -> ST s b) -> b +withThawed v k = runST (thaw v >>= k) + +freezeList :: V.Unbox a => MVector s a -> ST s [a] +freezeList = fmap V.toList . V.freeze + +freeze :: V.Unbox a => NonEmptySTUVector s a -> ST s [a] +freeze = freezeList . _nemUvec + +-- | A mutable operation's effect on the vector's contents. +-- +mutated :: V -> (forall s. NonEmptySTUVector s Int -> ST s ()) -> [Int] +mutated v k = withThawed v (\mv -> k mv >> freeze mv) + +-- ---------------------------------------------------------------------- -- +-- Length information + +prop_length :: V -> Property +prop_length v = withThawed v (pure . NEMV.length) === List.length (elemsU v) + +-- ---------------------------------------------------------------------- -- +-- Extracting subvectors + +prop_slice :: V -> Property +prop_slice v = forAll (genSliceU v) $ \(i, m) -> + withThawed v (freezeList . NEMV.slice i m) + === List.take m (List.drop i (elemsU v)) + +-- Subvectors are views: writes through them reach the parent vector. +prop_slice_shares :: V -> Int -> Property +prop_slice_shares v a = forAll (genIndexU v) $ \i -> + mutated v (\mv -> MV.write (NEMV.drop i mv) 0 a) + === adjustAt i (const a) (elemsU v) + +prop_init :: V -> Property +prop_init v = + withThawed v (freezeList . NEMV.init) + === List.take (List.length (elemsU v) - 1) (elemsU v) + +prop_tail :: V -> Property +prop_tail v = withThawed v (freezeList . NEMV.tail) === List.drop 1 (elemsU v) + +prop_take :: Int -> V -> Property +prop_take n v = + withThawed v (freezeList . NEMV.take n) === List.take n (elemsU v) + +prop_drop :: Int -> V -> Property +prop_drop n v = + withThawed v (freezeList . NEMV.drop n) === List.drop n (elemsU v) + +prop_splitAt :: Int -> V -> Property +prop_splitAt n v = + withThawed v (\mv -> let (as, bs) = NEMV.splitAt n mv + in (,) <$> freezeList as <*> freezeList bs) + === List.splitAt n (elemsU v) + +prop_unsafeSlice :: V -> Property +prop_unsafeSlice v = forAll (genSliceU v) $ \(i, m) -> + withThawed v (freezeList . NEMV.unsafeSlice i m) + === List.take m (List.drop i (elemsU v)) + +prop_unsafeTake :: V -> Property +prop_unsafeTake v = forAll (choose (0, List.length (elemsU v))) $ \n -> + withThawed v (freezeList . NEMV.unsafeTake n) === List.take n (elemsU v) + +prop_unsafeDrop :: V -> Property +prop_unsafeDrop v = forAll (choose (0, List.length (elemsU v))) $ \n -> + withThawed v (freezeList . NEMV.unsafeDrop n) === List.drop n (elemsU v) + +-- ---------------------------------------------------------------------- -- +-- Overlapping + +prop_overlaps_self :: V -> Property +prop_overlaps_self v = withThawed v (\mv -> pure (NEMV.overlaps mv mv)) === True + +prop_overlaps_distinct :: V -> V -> Property +prop_overlaps_distinct v w = runST (NEMV.overlaps <$> thaw v <*> thaw w) === False + +-- Adjacent slices are disjoint; extending one by an element overlaps them. +prop_overlaps_slices :: V -> Property +prop_overlaps_slices v = n >= 2 ==> forAll (choose (1, n - 1)) $ \k -> + withThawed v (\(NonEmptyMUVector mv) -> + let front m = NonEmptyMUVector (MV.take m mv) + back = NonEmptyMUVector (MV.drop k mv) + in pure (NEMV.overlaps (front k) back, NEMV.overlaps (front (k + 1)) back)) + === (False, True) + where + n = List.length (elemsU v) + +-- ---------------------------------------------------------------------- -- +-- Conversions + +prop_fromMVector :: [Int] -> Property +prop_fromMVector as = + runST (V.thaw (V.fromList as) >>= traverse freeze . NEMV.fromMVector) + === whenNonEmpty as + +prop_toMVector :: V -> Property +prop_toMVector v = withThawed v (freezeList . NEMV.toMVector) === elemsU v + +prop_unsafeFromMVector :: V -> Property +prop_unsafeFromMVector v = + runST (V.thaw (_neUvec v) >>= freeze . NEMV.unsafeFromMVector) === elemsU v + +-- ---------------------------------------------------------------------- -- +-- Initialisation + +prop_new :: NonNegative Int -> Property +prop_new (NonNegative n) = + runST (fmap NEMV.length <$> NEMV.new @_ @Int n) + === if n > 0 then Just n else Nothing + +prop_new1 :: Int -> Property +prop_new1 n = runST (NEMV.length <$> NEMV.new1 @_ @Int n) === max n 1 + +prop_unsafeNew :: NonNegative Int -> Property +prop_unsafeNew (NonNegative n) = + runST (fmap NEMV.length <$> NEMV.unsafeNew @_ @Int n) + === if n > 0 then Just n else Nothing + +prop_replicate :: Int -> Int -> Property +prop_replicate n a = + runST (NEMV.replicate n a >>= traverse freeze) + === whenNonEmpty (List.replicate n a) + +prop_replicate1 :: Int -> Int -> Property +prop_replicate1 n a = + runST (NEMV.replicate1 n a >>= freeze) === List.replicate (max n 1) a + +-- The action runs once per element, in order. +prop_replicateM :: Int -> Property +prop_replicateM n = + runST (counter >>= NEMV.replicateM n >>= traverse freeze) + === whenNonEmpty [1 .. n] + +prop_replicate1M :: Int -> Property +prop_replicate1M n = + runST (counter >>= NEMV.replicate1M n >>= traverse freeze) + === Just [1 .. max n 1] + +-- | An action yielding 1, 2, 3, ... on successive runs. +-- +counter :: ST s (ST s Int) +counter = do + ref <- newSTRef 0 + pure (modifySTRef' ref (+ 1) >> readSTRef ref) + +-- A clone has the same contents but no longer aliases the original. +prop_clone :: V -> Int -> Property +prop_clone v a = + withThawed v (\mv -> do + c <- NEMV.clone mv + MV.set (_nemUvec c) a + (,) <$> freeze mv <*> freeze c) + === (elemsU v, List.map (const a) (elemsU v)) + +-- ---------------------------------------------------------------------- -- +-- Growing + +prop_grow :: V -> NonNegative Int -> Property +prop_grow v (NonNegative n) = + withThawed v (\mv -> do + g <- NEMV.grow mv n + as <- freezeList (MV.take (NEMV.length mv) (_nemUvec g)) + pure (NEMV.length g, as)) + === (List.length (elemsU v) + n, elemsU v) + +prop_grow_negative :: V -> Positive Int -> Property +prop_grow_negative v (Positive n) = + throwsIO (thawIO v >>= \mv -> NEMV.grow mv (negate n)) + +prop_unsafeGrow :: V -> NonNegative Int -> Property +prop_unsafeGrow v (NonNegative n) = + withThawed v (\mv -> do + g <- NEMV.unsafeGrow mv n + as <- freezeList (MV.take (NEMV.length mv) (_nemUvec g)) + pure (NEMV.length g, as)) + === (List.length (elemsU v) + n, elemsU v) + +-- ---------------------------------------------------------------------- -- +-- Accessing individual elements + +prop_read :: V -> Property +prop_read v = forAll (genIndexU v) $ \i -> + Just (withThawed v (`NEMV.read` i)) === lookupList i (elemsU v) + +prop_read_out_of_bounds :: V -> Property +prop_read_out_of_bounds v = forAll (genOutOfBoundsU v) $ \i -> + throwsIO (thawIO v >>= (`NEMV.read` i)) + +prop_write :: V -> Int -> Property +prop_write v a = forAll (genIndexU v) $ \i -> + mutated v (\mv -> NEMV.write mv i a) === adjustAt i (const a) (elemsU v) + +prop_write_out_of_bounds :: V -> Int -> Property +prop_write_out_of_bounds v a = forAll (genOutOfBoundsU v) $ \i -> + throwsIO (thawIO v >>= \mv -> NEMV.write mv i a) + +prop_modify :: Fun Int Int -> V -> Property +prop_modify (Fn f) v = forAll (genIndexU v) $ \i -> + mutated v (\mv -> NEMV.modify mv f i) === adjustAt i f (elemsU v) + +prop_swap :: V -> Property +prop_swap v = forAll ((,) <$> genIndexU v <*> genIndexU v) $ \(i, j) -> + mutated v (\mv -> NEMV.swap mv i j) === swapAt i j (elemsU v) + +prop_unsafeRead :: V -> Property +prop_unsafeRead v = forAll (genIndexU v) $ \i -> + Just (withThawed v (`NEMV.unsafeRead` i)) === lookupList i (elemsU v) + +prop_unsafeWrite :: V -> Int -> Property +prop_unsafeWrite v a = forAll (genIndexU v) $ \i -> + mutated v (\mv -> NEMV.unsafeWrite mv i a) === adjustAt i (const a) (elemsU v) + +prop_unsafeModify :: Fun Int Int -> V -> Property +prop_unsafeModify (Fn f) v = forAll (genIndexU v) $ \i -> + mutated v (\mv -> NEMV.unsafeModify mv f i) === adjustAt i f (elemsU v) + +prop_unsafeSwap :: V -> Property +prop_unsafeSwap v = forAll ((,) <$> genIndexU v <*> genIndexU v) $ \(i, j) -> + mutated v (\mv -> NEMV.unsafeSwap mv i j) === swapAt i j (elemsU v) + +-- ---------------------------------------------------------------------- -- +-- Modifying vectors + +-- Starting from sorted order, successive permutations enumerate every +-- distinct permutation in lexicographic order. +prop_nextPermutation :: Property +prop_nextPermutation = + forAll (choose (1, 5)) $ \n -> + forAll (vectorOf n (choose (0, 3))) $ \as -> + let sorted = List.sort (as :: [Int]) + in withThawed (vecU sorted) enumerate + === List.map NonEmpty.head + (NonEmpty.group (List.sort (List.permutations sorted))) + where + enumerate :: NonEmptySTUVector s Int -> ST s [[Int]] + enumerate mv = do + as <- freeze mv + more <- NEMV.nextPermutation mv + if more then (as :) <$> enumerate mv else pure [as] + +-- The last permutation has no successor and is left unchanged. +prop_nextPermutation_last :: V -> Property +prop_nextPermutation_last v = + withThawed (vecU descending) (\mv -> (,) <$> NEMV.nextPermutation mv <*> freeze mv) + === (False, descending) + where + descending = List.sortBy (flip compare) (elemsU v) + +-- ---------------------------------------------------------------------- -- +-- Filling and copying + +prop_set :: V -> Int -> Property +prop_set v a = + mutated v (`NEMV.set` a) === List.map (const a) (elemsU v) + +-- | Copy @v@ over a vector of the same length, returning the target and +-- source contents afterwards. +-- +copied + :: (forall s. NonEmptySTUVector s Int -> NonEmptySTUVector s Int -> ST s ()) + -> V + -> [Int] + -> ([Int], [Int]) +copied cp v bs = runST $ do + dst <- thaw (vecU bs) + src <- thaw v + cp dst src + (,) <$> freeze dst <*> freeze src + +prop_copy :: V -> Property +prop_copy v = forAll (vectorOf (List.length (elemsU v)) arbitrary) $ \bs -> + copied NEMV.copy v bs === (elemsU v, elemsU v) + +prop_copy_length_mismatch :: V -> Property +prop_copy_length_mismatch v = throwsIO $ do + dst <- thawIO (vecU (0 : elemsU v)) + src <- thawIO v + NEMV.copy dst src + +prop_unsafeCopy :: V -> Property +prop_unsafeCopy v = forAll (vectorOf (List.length (elemsU v)) arbitrary) $ \bs -> + copied NEMV.unsafeCopy v bs === (elemsU v, elemsU v) + +-- | Move between the overlapping slices @[0, n - 1)@ and @[1, n)@ of one +-- vector, in both directions. +-- +moved + :: (forall s. NonEmptySTUVector s Int -> NonEmptySTUVector s Int -> ST s ()) + -> V + -> ([Int], [Int]) +moved mv v = (shift True, shift False) + where + n = List.length (elemsU v) + + shift left = withThawed v $ \(NonEmptyMUVector raw) -> do + let lo = NonEmptyMUVector (MV.slice 0 (n - 1) raw) + hi = NonEmptyMUVector (MV.slice 1 (n - 1) raw) + if left then mv lo hi else mv hi lo + freezeList raw + +prop_move :: V -> Property +prop_move v = List.length as >= 2 ==> + moved NEMV.move v + === (List.drop 1 as ++ List.drop (n - 1) as, List.take 1 as ++ List.take (n - 1) as) + where + as = elemsU v + n = List.length as + +prop_unsafeMove :: V -> Property +prop_unsafeMove v = List.length as >= 2 ==> + moved NEMV.unsafeMove v + === (List.drop 1 as ++ List.drop (n - 1) as, List.take 1 as ++ List.take (n - 1) as) + where + as = elemsU v + n = List.length as diff --git a/test/Test/Data/Vector/NonEmpty/PredicatesU.hs b/test/Test/Data/Vector/NonEmpty/PredicatesU.hs new file mode 100644 --- /dev/null +++ b/test/Test/Data/Vector/NonEmpty/PredicatesU.hs @@ -0,0 +1,192 @@ +-- | +-- Module : Test.Data.Vector.NonEmpty.PredicatesU +-- Copyright : (c) 2019-2026 Emily Pillmore, Koz Ross +-- License : BSD-style +-- +-- Maintainer : Emily Pillmore +-- Stability : experimental +-- Portability : non-portable +-- +-- Properties for filtering, partitioning, and searching. +-- +-- Elements are reduced modulo a small number where duplicates or hits +-- need to be likely. +-- +module Test.Data.Vector.NonEmpty.PredicatesU +( tests +) where + + +import Data.Either (partitionEithers) +import qualified Data.List as List +import qualified Data.List.NonEmpty as NonEmpty +import qualified Data.Maybe as Maybe +import qualified Data.Vector.Unboxed as V +import Data.Vector.NonEmpty.Unboxed (NonEmptyUVector) +import qualified Data.Vector.NonEmpty.Unboxed as NEV + +import Test.Data.Vector.NonEmpty.Util +import Test.QuickCheck +import Test.Tasty +import Test.Tasty.QuickCheck + + +tests :: TestTree +tests = testGroup "Predicates (unboxed)" + [ testGroup "Filtering" + [ testProperty "prop_uniq" prop_uniq + , testProperty "prop_mapMaybe" prop_mapMaybe + , testProperty "prop_imapMaybe" prop_imapMaybe + , testProperty "prop_filter" prop_filter + , testProperty "prop_ifilter" prop_ifilter + , testProperty "prop_filterM" prop_filterM + , testProperty "prop_ifilterM" prop_ifilterM + , testProperty "prop_takeWhile" prop_takeWhile + , testProperty "prop_dropWhile" prop_dropWhile + ] + , testGroup "Partitioning" + [ testProperty "prop_partition" prop_partition + , testProperty "prop_partitionWith" prop_partitionWith + , testProperty "prop_unstablePartition" prop_unstablePartition + , testProperty "prop_span" prop_span + , testProperty "prop_break" prop_break + ] + , testGroup "Searching" + [ testProperty "prop_elem" prop_elem + , testProperty "prop_notElem" prop_notElem + , testProperty "prop_find" prop_find + , testProperty "prop_findIndex" prop_findIndex + , testProperty "prop_findIndices" prop_findIndices + , testProperty "prop_elemIndex" prop_elemIndex + , testProperty "prop_elemIndices" prop_elemIndices + ] + ] + +type V = NonEmptyUVector Int + +-- | Reduce elements to a small range so that duplicates and matches are +-- common. +-- +small :: V -> V +small = vecU . List.map (`mod` 4) . elemsU + +-- ---------------------------------------------------------------------- -- +-- Filtering + +prop_uniq :: V -> Property +prop_uniq v = + elemsU (NEV.uniq w) === List.map NonEmpty.head (NonEmpty.group (elemsU w)) + where + w = small v + +prop_mapMaybe :: Fun Int (Maybe Int) -> V -> Property +prop_mapMaybe (Fn f) v = + V.toList (NEV.mapMaybe f v) === Maybe.mapMaybe f (elemsU v) + +prop_imapMaybe :: Fun (Int, Int) (Maybe Int) -> V -> Property +prop_imapMaybe (Fn2 f) v = + V.toList (NEV.imapMaybe f v) + === Maybe.catMaybes (List.zipWith f [0 ..] (elemsU v)) + +prop_filter :: Fun Int Bool -> V -> Property +prop_filter (Fn p) v = V.toList (NEV.filter p v) === List.filter p (elemsU v) + +prop_ifilter :: Fun (Int, Int) Bool -> V -> Property +prop_ifilter (Fn2 p) v = + V.toList (NEV.ifilter p v) + === [ a | (i, a) <- List.zip [0 ..] (elemsU v), p i a ] + +prop_filterM :: Fun Int Bool -> V -> Property +prop_filterM (Fn p) v = + fmap V.toList (NEV.filterM (\a -> logged a (p a)) v) + === (elemsU v, List.filter p (elemsU v)) + +prop_ifilterM :: Fun (Int, Int) Bool -> V -> Property +prop_ifilterM (Fn2 p) v = + fmap V.toList (NEV.ifilterM (\i a -> logged i (p i a)) v) + === ( List.map fst ias + , [ a | (i, a) <- ias, p i a ] + ) + where + ias = List.zip [0 ..] (elemsU v) + +prop_takeWhile :: Fun Int Bool -> V -> Property +prop_takeWhile (Fn p) v = + V.toList (NEV.takeWhile p v) === List.takeWhile p (elemsU v) + +prop_dropWhile :: Fun Int Bool -> V -> Property +prop_dropWhile (Fn p) v = + V.toList (NEV.dropWhile p v) === List.dropWhile p (elemsU v) + +-- ---------------------------------------------------------------------- -- +-- Partitioning + +prop_partition :: Fun Int Bool -> V -> Property +prop_partition (Fn p) v = + (V.toList as, V.toList bs) === List.partition p (elemsU v) + where + (as, bs) = NEV.partition p v + +prop_partitionWith :: Fun Int (Either Int Int) -> V -> Property +prop_partitionWith (Fn f) v = + (V.toList as, V.toList bs) === partitionEithers (List.map f (elemsU v)) + where + (as, bs) = NEV.partitionWith f v + +-- Only the contents of each side are specified, not their order. +prop_unstablePartition :: Fun Int Bool -> V -> Property +prop_unstablePartition (Fn p) v = + (List.sort (V.toList as), List.sort (V.toList bs)) + === (List.sort ts, List.sort fs) + where + (as, bs) = NEV.unstablePartition p v + (ts, fs) = List.partition p (elemsU v) + +prop_span :: Fun Int Bool -> V -> Property +prop_span (Fn p) v = + (V.toList as, V.toList bs) === List.span p (elemsU v) + where + (as, bs) = NEV.span p v + +prop_break :: Fun Int Bool -> V -> Property +prop_break (Fn p) v = + (V.toList as, V.toList bs) === List.break p (elemsU v) + where + (as, bs) = NEV.break p v + +-- ---------------------------------------------------------------------- -- +-- Searching + +prop_elem :: Int -> V -> Property +prop_elem a v = NEV.elem (a `mod` 4) w === List.elem (a `mod` 4) (elemsU w) + where + w = small v + +prop_notElem :: Int -> V -> Property +prop_notElem a v = + NEV.notElem (a `mod` 4) w === List.notElem (a `mod` 4) (elemsU w) + where + w = small v + +prop_find :: Fun Int Bool -> V -> Property +prop_find (Fn p) v = NEV.find p v === List.find p (elemsU v) + +prop_findIndex :: Fun Int Bool -> V -> Property +prop_findIndex (Fn p) v = NEV.findIndex p v === List.findIndex p (elemsU v) + +prop_findIndices :: Fun Int Bool -> V -> Property +prop_findIndices (Fn p) v = + V.toList (NEV.findIndices p v) === List.findIndices p (elemsU v) + +prop_elemIndex :: Int -> V -> Property +prop_elemIndex a v = + NEV.elemIndex (a `mod` 4) w === List.elemIndex (a `mod` 4) (elemsU w) + where + w = small v + +prop_elemIndices :: Int -> V -> Property +prop_elemIndices a v = + V.toList (NEV.elemIndices (a `mod` 4) w) + === List.elemIndices (a `mod` 4) (elemsU w) + where + w = small v diff --git a/test/Test/Data/Vector/NonEmpty/ScansU.hs b/test/Test/Data/Vector/NonEmpty/ScansU.hs new file mode 100644 --- /dev/null +++ b/test/Test/Data/Vector/NonEmpty/ScansU.hs @@ -0,0 +1,215 @@ +-- | +-- Module : Test.Data.Vector.NonEmpty.ScansU +-- Copyright : (c) 2019-2026 Emily Pillmore, Koz Ross +-- License : BSD-style +-- +-- Maintainer : Emily Pillmore +-- Stability : experimental +-- Portability : non-portable +-- +-- Properties for prefix sums (scans) and transformations. +-- +-- Scan functions are arbitrary, hence neither associative nor commutative, +-- so the models pin down scan direction and argument order. +-- +module Test.Data.Vector.NonEmpty.ScansU +( tests +) where + + +import qualified Data.List as List +import qualified Data.Vector.Unboxed as V +import Data.Vector.NonEmpty.Unboxed (NonEmptyUVector) +import qualified Data.Vector.NonEmpty.Unboxed as NEV + +import Test.Data.Vector.NonEmpty.Util +import Test.QuickCheck +import Test.Tasty +import Test.Tasty.QuickCheck + + +tests :: TestTree +tests = testGroup "Scans (unboxed)" + [ testGroup "Prefix sums" + [ testProperty "prop_prescanl" prop_prescanl + , testProperty "prop_prescanl'" prop_prescanl' + , testProperty "prop_postscanl" prop_postscanl + , testProperty "prop_postscanl'" prop_postscanl' + , testProperty "prop_scanl" prop_scanl + , testProperty "prop_scanl'" prop_scanl' + , testProperty "prop_scanl1" prop_scanl1 + , testProperty "prop_scanl1'" prop_scanl1' + , testProperty "prop_iscanl" prop_iscanl + , testProperty "prop_iscanl'" prop_iscanl' + , testProperty "prop_prescanr" prop_prescanr + , testProperty "prop_prescanr'" prop_prescanr' + , testProperty "prop_postscanr" prop_postscanr + , testProperty "prop_postscanr'" prop_postscanr' + , testProperty "prop_scanr" prop_scanr + , testProperty "prop_scanr'" prop_scanr' + , testProperty "prop_scanr1" prop_scanr1 + , testProperty "prop_scanr1'" prop_scanr1' + , testProperty "prop_iscanr" prop_iscanr + , testProperty "prop_iscanr'" prop_iscanr' + ] + , testGroup "Intersperse tests" + [ testProperty "prop_intersperse" prop_intersperse + , testProperty "prop_intersperse_length" prop_intersperse_length + , testProperty "prop_intersperse_first_last" prop_intersperse_first_last + , testProperty "prop_intersperse_separator" prop_intersperse_separator + , testProperty "prop_intersperse_reconstruction" prop_intersperse_reconstruction + , testProperty "prop_intersperse_singleton" prop_intersperse_singleton + , testProperty "prop_explicit_examples" prop_explicit_examples + ] + ] + +type V = NonEmptyUVector Int + +-- ---------------------------------------------------------------------- -- +-- Models + +-- | Left scan over @(index, element)@ pairs. +-- +iscanlList :: (Int -> a -> b -> a) -> a -> [b] -> [a] +iscanlList f z = List.scanl (\acc (i, b) -> f i acc b) z . List.zip [0 ..] + +-- | Right scan over @(index, element)@ pairs. +-- +iscanrList :: (Int -> a -> b -> b) -> b -> [a] -> [b] +iscanrList f z = List.scanr (\(i, a) acc -> f i a acc) z . List.zip [0 ..] + +-- ---------------------------------------------------------------------- -- +-- Left scans + +prop_prescanl :: Fun (Int, Int) Int -> Int -> V -> Property +prop_prescanl (Fn2 f) z v = + elemsU (NEV.prescanl f z v) + === List.take (NEV.length v) (List.scanl f z (elemsU v)) + +prop_prescanl' :: Fun (Int, Int) Int -> Int -> V -> Property +prop_prescanl' (Fn2 f) z v = + elemsU (NEV.prescanl' f z v) + === List.take (NEV.length v) (List.scanl f z (elemsU v)) + +prop_postscanl :: Fun (Int, Int) Int -> Int -> V -> Property +prop_postscanl (Fn2 f) z v = + elemsU (NEV.postscanl f z v) === List.drop 1 (List.scanl f z (elemsU v)) + +prop_postscanl' :: Fun (Int, Int) Int -> Int -> V -> Property +prop_postscanl' (Fn2 f) z v = + elemsU (NEV.postscanl' f z v) === List.drop 1 (List.scanl f z (elemsU v)) + +prop_scanl :: Fun (Int, Int) Int -> Int -> V -> Property +prop_scanl (Fn2 f) z v = elemsU (NEV.scanl f z v) === List.scanl f z (elemsU v) + +prop_scanl' :: Fun (Int, Int) Int -> Int -> V -> Property +prop_scanl' (Fn2 f) z v = elemsU (NEV.scanl' f z v) === List.scanl f z (elemsU v) + +prop_scanl1 :: Fun (Int, Int) Int -> V -> Property +prop_scanl1 (Fn2 f) v = elemsU (NEV.scanl1 f v) === List.scanl1 f (elemsU v) + +prop_scanl1' :: Fun (Int, Int) Int -> V -> Property +prop_scanl1' (Fn2 f) v = elemsU (NEV.scanl1' f v) === List.scanl1 f (elemsU v) + +prop_iscanl :: Fun (Int, Int, Int) Int -> Int -> V -> Property +prop_iscanl (Fn3 f) z v = + elemsU (NEV.iscanl f z v) === iscanlList f z (elemsU v) + +prop_iscanl' :: Fun (Int, Int, Int) Int -> Int -> V -> Property +prop_iscanl' (Fn3 f) z v = + elemsU (NEV.iscanl' f z v) === iscanlList f z (elemsU v) + +-- ---------------------------------------------------------------------- -- +-- Right scans + +prop_prescanr :: Fun (Int, Int) Int -> Int -> V -> Property +prop_prescanr (Fn2 f) z v = + elemsU (NEV.prescanr f z v) === List.drop 1 (List.scanr f z (elemsU v)) + +prop_prescanr' :: Fun (Int, Int) Int -> Int -> V -> Property +prop_prescanr' (Fn2 f) z v = + elemsU (NEV.prescanr' f z v) === List.drop 1 (List.scanr f z (elemsU v)) + +prop_postscanr :: Fun (Int, Int) Int -> Int -> V -> Property +prop_postscanr (Fn2 f) z v = + elemsU (NEV.postscanr f z v) + === List.take (NEV.length v) (List.scanr f z (elemsU v)) + +prop_postscanr' :: Fun (Int, Int) Int -> Int -> V -> Property +prop_postscanr' (Fn2 f) z v = + elemsU (NEV.postscanr' f z v) + === List.take (NEV.length v) (List.scanr f z (elemsU v)) + +prop_scanr :: Fun (Int, Int) Int -> Int -> V -> Property +prop_scanr (Fn2 f) z v = elemsU (NEV.scanr f z v) === List.scanr f z (elemsU v) + +prop_scanr' :: Fun (Int, Int) Int -> Int -> V -> Property +prop_scanr' (Fn2 f) z v = elemsU (NEV.scanr' f z v) === List.scanr f z (elemsU v) + +prop_scanr1 :: Fun (Int, Int) Int -> V -> Property +prop_scanr1 (Fn2 f) v = elemsU (NEV.scanr1 f v) === List.scanr1 f (elemsU v) + +prop_scanr1' :: Fun (Int, Int) Int -> V -> Property +prop_scanr1' (Fn2 f) v = elemsU (NEV.scanr1' f v) === List.scanr1 f (elemsU v) + +prop_iscanr :: Fun (Int, Int, Int) Int -> Int -> V -> Property +prop_iscanr (Fn3 f) z v = + elemsU (NEV.iscanr f z v) === iscanrList f z (elemsU v) + +prop_iscanr' :: Fun (Int, Int, Int) Int -> Int -> V -> Property +prop_iscanr' (Fn3 f) z v = + elemsU (NEV.iscanr' f z v) === iscanrList f z (elemsU v) + +-- ---------------------------------------------------------------------- -- +-- Intersperse properties + +prop_intersperse :: Int -> V -> Property +prop_intersperse sep v = + elemsU (NEV.intersperse sep v) === List.intersperse sep (elemsU v) + +-- For vectors with length > 1, interspersing should result in length 2*n - 1 +prop_intersperse_length :: Int -> V -> Bool +prop_intersperse_length sep v = + let result = NEV.intersperse sep v + originalLen = NEV.length v + in if originalLen > 1 + then NEV.length result == 2 * originalLen - 1 + else NEV.length result == originalLen + +-- The first and last elements of the result should match the original vector +prop_intersperse_first_last :: Int -> V -> Bool +prop_intersperse_first_last sep v = + let result = NEV.intersperse sep v + in NEV.head result == NEV.head v && NEV.last result == NEV.last v + +-- Every odd-indexed element should be the separator (for vectors with length > 1) +prop_intersperse_separator :: Int -> V -> Bool +prop_intersperse_separator sep v = + let result = NEV.intersperse sep v + in NEV.length v <= 1 || + all (\i -> result NEV.! (2*i+1) == sep) [0 .. NEV.length v - 2] + +-- If we remove the separator, we should get back the original vector +prop_intersperse_reconstruction :: Int -> V -> Bool +prop_intersperse_reconstruction sep v = + let result = NEV.intersperse sep v + resultVector = NEV.toVector result + reconstructed = V.ifilter (\i _ -> i `mod` 2 == 0) resultVector + in V.toList reconstructed == NEV.toList v + +-- For singleton vectors, interspersing should not change the vector +prop_intersperse_singleton :: Int -> Int -> Bool +prop_intersperse_singleton x sep = + let singleton = NEV.singleton x + result = NEV.intersperse sep singleton + in result == singleton + +-- Explicit test cases for edge cases and examples combined into one property +prop_explicit_examples :: Property +prop_explicit_examples = + let normalCase = NEV.intersperse (0 :: Int) (NEV.unsafeFromList [1,2,3 :: Int]) + === NEV.unsafeFromList [1,0,2,0,3 :: Int] + + singletonCase = NEV.intersperse (0 :: Int) (NEV.singleton (5 :: Int)) + === NEV.singleton (5 :: Int) + in normalCase .&&. singletonCase diff --git a/test/Test/Data/Vector/NonEmpty/Util.hs b/test/Test/Data/Vector/NonEmpty/Util.hs --- a/test/Test/Data/Vector/NonEmpty/Util.hs +++ b/test/Test/Data/Vector/NonEmpty/Util.hs @@ -2,7 +2,7 @@ {-# OPTIONS_GHC -Wno-orphans #-} -- | -- Module : Test.Data.Vector.NonEmpty.Util --- Copyright : (c) 2019-2026 Emily Pillmore +-- Copyright : (c) 2019-2026 Emily Pillmore, Koz Ross -- License : BSD-style -- -- Maintainer : Emily Pillmore @@ -19,15 +19,23 @@ module Test.Data.Vector.NonEmpty.Util ( -- * Building and observing vectors vec +, vecU , elems +, elemsU , elems1 +, elems1U , whenNonEmpty -- * Generators , genIndex +, genIndexU , genIndices +, genIndicesU , genOutOfBounds +, genOutOfBoundsU , genSlice +, genSliceU , genUpdates +, genUpdatesU -- * Effects , logged , unfoldStep @@ -49,7 +57,9 @@ import Data.List.NonEmpty (NonEmpty(..)) import Data.Maybe (fromMaybe, listToMaybe) import qualified Data.Vector as V +import qualified Data.Vector.Unboxed as VU import Data.Vector.NonEmpty.Internal (NonEmptyVector(..)) +import Data.Vector.NonEmpty.Unboxed.Internal (NonEmptyUVector(..)) import Test.QuickCheck @@ -58,6 +68,10 @@ arbitrary = vec . getNonEmpty <$> arbitrary shrink = fmap (vec . getNonEmpty) . shrink . NonEmpty . elems +instance (Arbitrary a, VU.Unbox a) => Arbitrary (NonEmptyUVector a) where + arbitrary = vecU . getNonEmpty <$> arbitrary + shrink = fmap (vecU . getNonEmpty) . shrink . NonEmpty . elemsU + -- ---------------------------------------------------------------------- -- -- Building and observing vectors @@ -67,17 +81,32 @@ vec :: [a] -> NonEmptyVector a vec = NonEmptyVector . V.fromList +-- | As 'vec', but for unboxed representations. +-- +vecU :: VU.Unbox a => [a] -> NonEmptyUVector a +vecU = NonEmptyUVector . VU.fromList + -- | The elements of a non-empty vector, read from its representation. -- elems :: NonEmptyVector a -> [a] elems = V.toList . _neVec +-- | As 'elems', but for unboxed representations. +-- +elemsU :: VU.Unbox a => NonEmptyUVector a -> [a] +elemsU = VU.toList . _neUvec + -- | The elements of a non-empty vector as a non-empty list, read from its -- representation. -- elems1 :: NonEmptyVector a -> NonEmpty a elems1 (NonEmptyVector v) = V.unsafeHead v :| V.toList (V.unsafeTail v) +-- | As 'elems1', but for unboxed representations. +-- +elems1U :: VU.Unbox a => NonEmptyUVector a -> NonEmpty a +elems1U (NonEmptyUVector v) = VU.unsafeHead v :| VU.toList (VU.unsafeTail v) + -- | Model of the 'Maybe'-valued constructors: 'Nothing' exactly when the -- result would be empty. -- @@ -93,11 +122,21 @@ genIndex :: NonEmptyVector a -> Gen Int genIndex (NonEmptyVector v) = choose (0, V.length v - 1) +-- | As 'genIndex', but for unboxed representations. +-- +genIndexU :: VU.Unbox a => NonEmptyUVector a -> Gen Int +genIndexU (NonEmptyUVector v) = choose (0, VU.length v - 1) + -- | A non-empty vector of valid indices into the vector. -- genIndices :: NonEmptyVector a -> Gen (NonEmptyVector Int) genIndices v = vec <$> listOf1 (genIndex v) +-- | As 'genIndices', but for unboxed representations. +-- +genIndicesU :: VU.Unbox a => NonEmptyUVector a -> Gen (NonEmptyUVector Int) +genIndicesU v = vecU <$> listOf1 (genIndexU v) + -- | An index outside the bounds of the vector, on either side. -- genOutOfBounds :: NonEmptyVector a -> Gen Int @@ -108,6 +147,16 @@ where n = V.length v +-- | As 'genOutOfBounds', but for unboxed representations. +-- +genOutOfBoundsU :: VU.Unbox a => NonEmptyUVector a -> Gen Int +genOutOfBoundsU (NonEmptyUVector v) = oneof + [ choose (-10, -1) + , choose (n, n + 10) + ] + where + n = VU.length v + -- | A valid @(offset, length)@ slice of the vector, possibly empty. -- genSlice :: NonEmptyVector a -> Gen (Int, Int) @@ -118,10 +167,24 @@ where n = V.length v +-- | As 'genSlice', but for unboxed representations. +genSliceU :: VU.Unbox a => NonEmptyUVector a -> Gen (Int, Int) +genSliceU (NonEmptyUVector v) = do + i <- choose (0, n) + m <- choose (0, n - i) + pure (i, m) + where + n = VU.length v + -- | A list of updates at valid indices of the vector. -- genUpdates :: Arbitrary b => NonEmptyVector a -> Gen [(Int, b)] genUpdates v = listOf ((,) <$> genIndex v <*> arbitrary) + +-- | As 'genUpdates', but for unboxed representations. +-- +genUpdatesU :: (VU.Unbox a, Arbitrary b) => NonEmptyUVector a -> Gen [(Int, b)] +genUpdatesU v = listOf ((,) <$> genIndexU v <*> arbitrary) -- ---------------------------------------------------------------------- -- -- Effects