vector-circular 0.1 → 0.1.1
raw patch · 3 files changed
+223/−9 lines, 3 filesdep +deepseqdep ~base
Dependencies added: deepseq
Dependency ranges changed: base
Files
- src/Data/Vector/Circular.hs +215/−6
- test/Main.hs +3/−0
- vector-circular.cabal +5/−3
src/Data/Vector/Circular.hs view
@@ -1,7 +1,9 @@ {-# language BangPatterns , CPP+ , DeriveAnyClass , DeriveFunctor+ , DeriveGeneric , DerivingStrategies , InstanceSigs , ScopedTypeVariables@@ -16,6 +18,7 @@ -- * Construction , singleton , toVector+ , toNonEmptyVector , fromVector , unsafeFromVector , fromList@@ -46,14 +49,38 @@ , Data.Vector.Circular.foldMap1' , Data.Vector.Circular.toNonEmpty + -- * Specialized folds+ , Data.Vector.Circular.all+ , Data.Vector.Circular.any+ , Data.Vector.Circular.and+ , Data.Vector.Circular.or+ , Data.Vector.Circular.sum+ , Data.Vector.Circular.product+ , Data.Vector.Circular.maximum+ , Data.Vector.Circular.maximumBy+ , Data.Vector.Circular.minimum+ , Data.Vector.Circular.minimumBy+ , rotateToMinimumBy+ , rotateToMaximumBy+ -- * Indexing , index , head , last++ -- * Zipping+ , Data.Vector.Circular.zipWith+ , Data.Vector.Circular.zipWith3+ , Data.Vector.Circular.zip+ , Data.Vector.Circular.zip3++ -- * Permutations+ , Data.Vector.Circular.reverse ) where import Control.Monad (when, forM_) import Control.Monad.ST (ST, runST)+import Control.DeepSeq #if MIN_VERSION_base(4,13,0) import Data.Foldable (foldMap') #endif /* MIN_VERSION_base(4,13,0) */@@ -64,6 +91,7 @@ import Data.Vector (Vector) import Data.Vector.NonEmpty (NonEmptyVector) import GHC.Base (modInt)+import GHC.Generics (Generic) import Prelude hiding (head, length, last) import Language.Haskell.TH.Syntax import qualified Data.Foldable as Foldable@@ -81,10 +109,26 @@ { vector :: {-# UNPACK #-} !(NonEmptyVector a) , rotation :: {-# UNPACK #-} !Int }- deriving stock (Ord, Show, Read)- deriving stock (Functor)+ deriving stock+ ( Functor -- ^ @since 0.1+ , Generic -- ^ @since 0.1.1+ , Ord -- ^ @since 0.1+ , Read -- ^ @since 0.1+ , Show -- ^ @since 0.1+ )+ deriving anyclass+ ( NFData -- ^ @since 0.1.1+ ) +-- | @since 0.1.1+instance Traversable CircularVector where+ traverse :: (Applicative f) => (a -> f b) -> CircularVector a -> f (CircularVector b)+ traverse f (CircularVector v rot) =+ CircularVector <$> traverse f v <*> pure rot++-- | @since 0.1 instance Eq a => Eq (CircularVector a) where+ (==) :: CircularVector a -> CircularVector a -> Bool c0@(CircularVector x rx) == c1@(CircularVector y ry) | NonEmpty.length x /= NonEmpty.length y = False | rx == ry = x == y@@ -93,7 +137,10 @@ -- | The 'Semigroup' @('<>')@ operation behaves by un-rolling -- the two vectors so that their rotation is 0, concatenating -- them, returning a new vector with a 0-rotation.+--+-- @since 0.1 instance Semigroup (CircularVector a) where+ (<>) :: CircularVector a -> CircularVector a -> CircularVector a lhs <> rhs = CircularVector v 0 where szLhs = length lhs@@ -106,6 +153,7 @@ else index rhs (ix - szLhs) {-# inline (<>) #-} +-- | @since 0.1 instance Foldable CircularVector where foldMap :: Monoid m => (a -> m) -> CircularVector a -> m foldMap = Data.Vector.Circular.foldMap@@ -125,11 +173,13 @@ length = Data.Vector.Circular.length {-# inline length #-} +-- | @since 0.1 instance Foldable1 CircularVector where foldMap1 :: Semigroup m => (a -> m) -> CircularVector a -> m foldMap1 = Data.Vector.Circular.foldMap1 {-# inline foldMap1 #-} +-- | @since 0.1 instance Lift a => Lift (CircularVector a) where lift c = do v <- [|NonEmpty.toVector (vector c)|]@@ -142,11 +192,14 @@ #endif /* MIN_VERSION_template_haskell(2,16,0) */ -- | Get the length of a 'CircularVector'.+--+-- @since 0.1 length :: CircularVector a -> Int length (CircularVector v _) = NonEmpty.length v {-# inline length #-} -- | Lazily-accumulating monoidal fold over a 'CircularVector'.+-- @since 0.1 foldMap :: Monoid m => (a -> m) -> CircularVector a -> m foldMap f = \v -> let len = Data.Vector.Circular.length v@@ -157,6 +210,8 @@ {-# inline foldMap #-} -- | Strictly-accumulating monoidal fold over a 'CircularVector'.+--+-- @since 0.1 foldMap' :: Monoid m => (a -> m) -> CircularVector a -> m foldMap' f = \v -> let len = Data.Vector.Circular.length v@@ -166,40 +221,51 @@ in go 0 mempty {-# inline foldMap' #-} +-- | @since 0.1 foldr :: (a -> b -> b) -> b -> CircularVector a -> b foldr = Foldable.foldr +-- | @since 0.1 foldl :: (b -> a -> b) -> b -> CircularVector a -> b foldl = Foldable.foldl +-- | @since 0.1 foldr' :: (a -> b -> b) -> b -> CircularVector a -> b foldr' = Foldable.foldr' +-- | @since 0.1 foldl' :: (b -> a -> b) -> b -> CircularVector a -> b foldl' = Foldable.foldl' +-- | @since 0.1 foldr1 :: (a -> a -> a) -> CircularVector a -> a foldr1 = Foldable.foldr1 +-- | @since 0.1 foldl1 :: (a -> a -> a) -> CircularVector a -> a foldl1 = Foldable.foldl1 +-- | @since 0.1 toNonEmpty :: CircularVector a -> NonEmpty a toNonEmpty = Foldable1.toNonEmpty -- | Lazily-accumulating semigroupoidal fold over -- a 'CircularVector'.+--+-- @since 0.1 foldMap1 :: Semigroup m => (a -> m) -> CircularVector a -> m foldMap1 f = \v -> let len = Data.Vector.Circular.length v go !ix- | ix < len = f (index v ix) <> go (ix + 1)- | otherwise = f (head v)- in go 1+ | ix < len-1 = f (index v ix) <> go (ix + 1)+ | otherwise = f (last v)+ in go 0 {-# inline foldMap1 #-} -- | Strictly-accumulating semigroupoidal fold over -- a 'CircularVector'.+--+-- @since 0.1 foldMap1' :: Semigroup m => (a -> m) -> CircularVector a -> m foldMap1' f = \v -> let len = Data.Vector.Circular.length v@@ -210,13 +276,20 @@ {-# inline foldMap1' #-} -- | Construct a 'Vector' from a 'CircularVector'.+--+-- @since 0.1 toVector :: CircularVector a -> Vector a toVector v = Vector.generate (length v) (index v) +-- | Construct a 'NonEmptyVector' from a 'CircularVector'.+--+-- @since 0.1.1 toNonEmptyVector :: CircularVector a -> NonEmptyVector a toNonEmptyVector v = NonEmpty.generate1 (length v) (index v) -- | Construct a 'CircularVector' from a 'NonEmptyVector'.+--+-- @since 0.1 fromVector :: NonEmptyVector a -> CircularVector a fromVector v = CircularVector v 0 {-# inline fromVector #-}@@ -224,15 +297,21 @@ -- | Construct a 'CircularVector' from a 'Vector'. -- -- Calls @'error'@ if the input vector is empty.+--+-- @since 0.1 unsafeFromVector :: Vector a -> CircularVector a unsafeFromVector = fromVector . NonEmpty.unsafeFromVector -- | Construct a 'CircularVector' from a list.+--+-- @since 0.1 fromList :: [a] -> Maybe (CircularVector a) fromList xs = fromListN (Prelude.length xs) xs {-# inline fromList #-} -- | Construct a 'CircularVector' from a list with a size hint.+--+-- @since 0.1 fromListN :: Int -> [a] -> Maybe (CircularVector a) fromListN n xs = fromVector <$> (NonEmpty.fromListN n xs) {-# inline fromListN #-}@@ -240,6 +319,8 @@ -- | Construct a 'CircularVector' from a list. -- -- Calls @'error'@ if the input list is empty.+--+-- @since 0.1 unsafeFromList :: [a] -> CircularVector a unsafeFromList xs = unsafeFromListN (Prelude.length xs) xs @@ -247,17 +328,23 @@ -- -- Calls @'error'@ if the input list is empty, or -- if the size hint is @'<=' 0@.+--+-- @since 0.1 unsafeFromListN :: Int -> [a] -> CircularVector a unsafeFromListN n xs | n <= 0 = error "Data.Vector.Circular.unsafeFromListN: invalid length!" | otherwise = unsafeFromVector (Vector.fromListN n xs) -- | Construct a singleton 'CircularVector.+--+-- @since 0.1 singleton :: a -> CircularVector a singleton = fromVector . NonEmpty.singleton {-# inline singleton #-} -- | Index into a 'CircularVector'. This is always total.+--+-- @since 0.1 index :: CircularVector a -> Int -> a index (CircularVector v r) = \ !ix -> let len = NonEmpty.length v@@ -265,11 +352,15 @@ {-# inline index #-} -- | Get the first element of a 'CircularVector'. This is always total.+--+-- @since 0.1 head :: CircularVector a -> a head v = index v 0 {-# inline head #-} -- | Get the last element of a 'CircularVector'. This is always total.+--+-- @since 0.1 last :: CircularVector a -> a last v = index v (Data.Vector.Circular.length v - 1) {-# inline last #-}@@ -279,6 +370,8 @@ -- /Note/: Right rotations start to break down due to -- arithmetic overflow when the size of the input vector is -- @'>' 'maxBound' @'Int'@+--+-- @since 0.1 rotateRight :: Int -> CircularVector a -> CircularVector a rotateRight r' (CircularVector v r) = CircularVector v h where@@ -291,6 +384,8 @@ -- /Note/: Left rotations start to break down due to -- arithmetic underflow when the size of the input vector is -- @'>' 'maxBound' @'Int'@+--+-- @since 0.1 rotateLeft :: Int -> CircularVector a -> CircularVector a rotateLeft r' (CircularVector v r) = CircularVector v h where@@ -301,7 +396,7 @@ -- | Construct a 'CircularVector' at compile-time using -- typed Template Haskell. ----- TODO: show examples+-- @since 0.1 vec :: Lift a => [a] -> Q (TExp (CircularVector a)) vec [] = fail "Cannot create an empty CircularVector!" vec xs =@@ -311,15 +406,18 @@ unsafeTExpCoerce [|unsafeFromList xs|] #endif /* MIN_VERSION_template_haskell(2,16,0) */ +-- | @since 0.1 equivalent :: Ord a => CircularVector a -> CircularVector a -> Bool equivalent x y = vector (canonise x) == vector (canonise y) +-- | @since 0.1 canonise :: Ord a => CircularVector a -> CircularVector a canonise (CircularVector v r) = CircularVector v' (r - lr) where lr = leastRotation (NonEmpty.toVector v) v' = toNonEmptyVector (rotateRight lr (CircularVector v 0)) +-- | @since 0.1 leastRotation :: forall a. (Ord a) => Vector a -> Int leastRotation v = runST go where@@ -354,3 +452,114 @@ unsafeMod :: Int -> Int -> Int unsafeMod = GHC.Base.modInt {-# inline unsafeMod #-}++-- | /O(min(m,n))/ Zip two circular vectors with the given function.+--+-- @since 0.1.1+zipWith :: (a -> b -> c) -> CircularVector a -> CircularVector b -> CircularVector c+zipWith f a b = fromVector $ NonEmpty.zipWith f (toNonEmptyVector a) (toNonEmptyVector b)++-- | Zip three circular vectors with the given function.+--+-- @since 0.1.1+zipWith3 :: (a -> b -> c -> d) -> CircularVector a -> CircularVector b -> CircularVector c+ -> CircularVector d+zipWith3 f a b c = fromVector $+ NonEmpty.zipWith3 f (toNonEmptyVector a) (toNonEmptyVector b) (toNonEmptyVector c)++-- | /O(min(n,m))/ Elementwise pairing of circular vector elements.+-- This is a special case of 'zipWith' where the function argument is '(,)'+--+-- @since 0.1.1+zip :: CircularVector a -> CircularVector b -> CircularVector (a,b)+zip a b = fromVector $ NonEmpty.zip (toNonEmptyVector a) (toNonEmptyVector b)++-- | Zip together three circular vectors.+--+-- @since 0.1.1+zip3 :: CircularVector a -> CircularVector b -> CircularVector c -> CircularVector (a,b,c)+zip3 a b c = fromVector $ NonEmpty.zip3 (toNonEmptyVector a) (toNonEmptyVector b) (toNonEmptyVector c)++-- | /O(n)/ Reverse a circular vector.+--+-- @since 0.1.1+reverse :: CircularVector a -> CircularVector a+reverse = fromVector . NonEmpty.reverse . toNonEmptyVector++-- | /O(n)/ Rotate to the minimum element of the circular vector according to the+-- given comparison function.+--+-- @since 0.1.1+rotateToMinimumBy :: (a -> a -> Ordering) -> CircularVector a -> CircularVector a+rotateToMinimumBy f (CircularVector v _rot) =+ CircularVector v (NonEmpty.minIndexBy f v)++-- | /O(n)/ Rotate to the maximum element of the circular vector according to the+-- given comparison function.+--+-- @since 0.1.1+rotateToMaximumBy :: (a -> a -> Ordering) -> CircularVector a -> CircularVector a+rotateToMaximumBy f (CircularVector v _rot) =+ CircularVector v (NonEmpty.maxIndexBy f v)++-- | /O(n)/ Check if all elements satisfy the predicate.+--+-- @since 0.1.1+all :: (a -> Bool) -> CircularVector a -> Bool+all f = NonEmpty.all f . vector++-- | /O(n)/ Check if any element satisfies the predicate.+--+-- @since 0.1.1+any :: (a -> Bool) -> CircularVector a -> Bool+any f = NonEmpty.any f . vector++-- | /O(n)/ Check if all elements are True.+--+-- @since 0.1.1+and :: CircularVector Bool -> Bool+and = NonEmpty.and . vector++-- | /O(n)/ Check if any element is True.+--+-- @since 0.1.1+or :: CircularVector Bool -> Bool+or = NonEmpty.or . vector++-- | /O(n)/ Compute the sum of the elements.+--+-- @since 0.1.1+sum :: Num a => CircularVector a -> a+sum = NonEmpty.sum . vector++-- | /O(n)/ Compute the product of the elements.+--+-- @since 0.1.1+product :: Num a => CircularVector a -> a+product = NonEmpty.sum . vector++-- | /O(n)/ Yield the maximum element of the circular vector.+--+-- @since 0.1.1+maximum :: Ord a => CircularVector a -> a+maximum = NonEmpty.maximum . vector++-- | /O(n)/ Yield the maximum element of a circular vector according to the+-- given comparison function.+--+-- @since 0.1.1+maximumBy :: (a -> a -> Ordering) -> CircularVector a -> a+maximumBy f = NonEmpty.maximumBy f . vector++-- | /O(n)/ Yield the minimum element of the circular vector.+--+-- @since 0.1.1+minimum :: Ord a => CircularVector a -> a+minimum = NonEmpty.minimum . vector++-- | /O(n)/ Yield the minimum element of a circular vector according to the+-- given comparison function.+--+-- @since 0.1.1+minimumBy :: (a -> a -> Ordering) -> CircularVector a -> a+minimumBy f = NonEmpty.minimumBy f . vector
test/Main.hs view
@@ -7,6 +7,7 @@ import Data.Vector.Circular +import GHC.Generics import Hedgehog import Hedgehog.Classes import qualified Hedgehog.Gen as Gen@@ -23,11 +24,13 @@ circularLaws :: [Laws] circularLaws = [ eqLaws genCircular+ , genericLaws genCircular (from <$> genCircular :: Gen (Rep (CircularVector SomeType) ())) , ordLaws genCircular , semigroupLaws genCircular , foldableLaws genCircular1 , functorLaws genCircular1+ , traversableLaws genCircular1 ] prop_canonise :: Property
vector-circular.cabal view
@@ -2,7 +2,7 @@ name: vector-circular version:- 0.1+ 0.1.1 synopsis: circular vectors description:@@ -31,14 +31,16 @@ exposed-modules: Data.Vector.Circular build-depends:- , base >= 4.11 && < 4.15+ , base >= 4.11 && < 4.17 , nonempty-vector >= 0.2 && < 0.3 , primitive >= 0.6.4 && < 0.8 , semigroupoids >= 5.3 && < 5.4 , template-haskell >= 2.12 && < 2.17 , vector >= 0.12 && < 0.13+ , deepseq >= 1.4 && < 1.5 ghc-options:- -Wall -O2+ -Wall+ -O2 default-language: Haskell2010