chimera 0.3.2.0 → 0.3.3.0

raw patch · 9 files changed

+446/−151 lines, 9 filesdep +primitivedep +transformersdep ~tastydep ~tasty-benchsetup-changedPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: primitive, transformers

Dependency ranges changed: tasty, tasty-bench

API changes (from Hackage documentation)

Files

• Data/Chimera.hs +297/−31
• Data/Chimera/Compat.hs +0/−56
• Data/Chimera/ContinuousMapping.hs +30/−29
• Data/Chimera/WheelMapping.hs +17/−2
• Setup.hs +0/−2
• bench/Bench.hs +31/−17
• changelog.md +9/−0
• chimera.cabal +5/−5
• test/Test.hs +57/−9

@@ -11,8 +11,10 @@ {-# LANGUAGE DeriveTraversable     #-} {-# LANGUAGE FlexibleContexts      #-} {-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE LambdaCase            #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TupleSections         #-} {-# LANGUAGE TypeApplications      #-} {-# LANGUAGE TypeFamilies          #-} @@ -31,8 +33,14 @@   , tabulateFix   , tabulateFix'   , iterate+  , unfoldr   , cycle+  , fromListWithDef+  , fromVectorWithDef +  -- * Manipulation+  , interleave+   -- * Elimination   , index   , toList@@ -41,20 +49,30 @@   -- $monadic   , tabulateM   , tabulateFixM+  , tabulateFixM'   , iterateM+  , unfoldrM    -- * Subvectors   -- $subvectors   , mapSubvectors+  , traverseSubvectors   , zipSubvectors+  , zipWithSubvectors+  , zipWithMSubvectors+  , sliceSubvectors   ) where  import Prelude hiding ((^), (*), div, fromIntegral, not, and, or, cycle, iterate, drop) import Control.Applicative import Control.Monad.Fix+import Control.Monad.Trans.Class+import qualified Control.Monad.Trans.State.Lazy as LazyState import Control.Monad.Zip import Data.Bits+import qualified Data.Foldable as F import Data.Functor.Identity+import qualified Data.Primitive.Array as A import qualified Data.Vector as V import qualified Data.Vector.Generic as G import qualified Data.Vector.Unboxed as U@@ -69,7 +87,6 @@ #endif #endif -import Data.Chimera.Compat import Data.Chimera.FromIntegral  -- $monadic@@ -114,52 +131,71 @@ -- > import Data.Bits -- > ch1 = tabulate (Bit . f1) -- > ch2 = tabulate (Bit . f2)--- > ch3 = zipSubvectors (zipBits (.&.)) ch1 ch2+-- > ch3 = zipWithSubvectors (zipBits (.&.)) ch1 ch2  -- | Lazy infinite streams with elements from @a@, -- backed by a 'G.Vector' @v@ (boxed, unboxed, storable, etc.). -- Use 'tabulate', 'tabulateFix', etc. to create a stream -- and 'index' to access its arbitrary elements -- in constant time.-newtype Chimera v a = Chimera { _unChimera :: V.Vector (v a) }-  deriving (Functor, Foldable, Traversable)+--+-- @since 0.2.0.0+newtype Chimera v a = Chimera { unChimera :: A.Array (v a) }+  deriving+  ( Functor     -- ^ @since 0.2.0.0+  , Foldable    -- ^ @since 0.2.0.0+  , Traversable -- ^ @since 0.2.0.0+  )  -- | Streams backed by boxed vectors.+--+-- @since 0.3.0.0 type VChimera = Chimera V.Vector  -- | Streams backed by unboxed vectors.+--+-- @since 0.3.0.0 type UChimera = Chimera U.Vector  -- | 'pure' creates a constant stream.+--+-- @since 0.2.0.0 instance Applicative (Chimera V.Vector) where-  pure   = tabulate   . const-  (<*>)  = zipSubvectors (<*>)+  pure a = Chimera $ A.arrayFromListN (bits + 1) $+    G.singleton a : map (\k -> G.replicate (1 `shiftL` k) a) [0 .. bits - 1]+  (<*>)  = zipWithSubvectors (<*>) #if __GLASGOW_HASKELL__ > 801-  liftA2 f = zipSubvectors (liftA2 f)+  liftA2 f = zipWithSubvectors (liftA2 f) #endif +-- | @since 0.3.1.0 instance Monad (Chimera V.Vector) where   m >>= f = tabulate $ \w -> index (f (index m w)) w +-- | @since 0.3.1.0 instance MonadFix (Chimera V.Vector) where   mfix = tabulate . mfix . fmap index +-- | @since 0.3.1.0 instance MonadZip (Chimera V.Vector) where-  mzip as bs = tabulate (\w -> (index as w, index bs w))-  mzipWith f as bs = tabulate $ \w -> f (index as w) (index bs w)+  mzip = zipWithSubvectors mzip+  mzipWith = zipWithSubvectors . mzipWith  #ifdef MIN_VERSION_mtl+-- | @since 0.3.1.0 instance MonadReader Word (Chimera V.Vector) where   ask = tabulate id   local = flip $ (tabulate .) . (.) . index #endif  #ifdef MIN_VERSION_distributive+-- | @since 0.3.1.0 instance Distributive (Chimera V.Vector) where   distribute = tabulate . flip (fmap . flip index)   collect f = tabulate . flip ((<$>) . (. f) . flip index)  #ifdef MIN_VERSION_adjunctions+-- | @since 0.3.1.0 instance Rep.Representable (Chimera V.Vector) where   type Rep (Chimera V.Vector) = Word   tabulate = tabulate@@ -168,7 +204,7 @@ #endif  bits :: Int-bits = fbs (0 :: Word)+bits = finiteBitSize (0 :: Word)  -- | Create a stream of values of a given function. -- Once created it can be accessed via 'index' or 'toList'.@@ -178,18 +214,24 @@ -- 81 -- >>> take 10 (toList ch) -- [0,1,4,9,16,25,36,49,64,81]+--+-- @since 0.2.0.0 tabulate :: G.Vector v a => (Word -> a) -> Chimera v a tabulate f = runIdentity $ tabulateM (pure . f) +-- | Similar to 'V.generateM', but for raw arrays.+generateArrayM :: Monad m => Int -> (Int -> m a) -> m (A.Array a)+generateArrayM n f = A.arrayFromListN n <$> traverse f [0..n - 1]+ -- | Monadic version of 'tabulate'.+--+-- @since 0.2.0.0 tabulateM-  :: forall m v a.-     (Monad m, G.Vector v a)+  :: (Monad m, G.Vector v a)   => (Word -> m a)   -> m (Chimera v a)-tabulateM f = Chimera <$> V.generateM (bits + 1) tabulateSubVector+tabulateM f = Chimera <$> generateArrayM (bits + 1) tabulateSubVector   where-    tabulateSubVector :: Int -> m (v a)     tabulateSubVector 0 = G.singleton <$> f 0     tabulateSubVector i = G.generateM ii (\j -> f (int2word (ii + j)))       where@@ -220,6 +262,8 @@ -- -- __Note__: Only recursive function calls with decreasing arguments are memoized. -- If full memoization is desired, use 'tabulateFix'' instead.+--+-- @since 0.2.0.0 tabulateFix :: G.Vector v a => ((Word -> a) -> Word -> a) -> Chimera v a tabulateFix uf = runIdentity $ tabulateFixM ((pure .) . uf . (runIdentity .)) @@ -243,6 +287,8 @@ -- -- >>> maximumBy (comparing $ memoizeFix collatzF) [0..1000000] -- 56991483520+--+-- @since 0.3.2.0 tabulateFix' :: G.Vector v a => ((Word -> a) -> Word -> a) -> Chimera v a tabulateFix' uf = runIdentity $ tabulateFixM' ((pure .) . uf . (runIdentity .)) @@ -250,9 +296,10 @@ -- There are no particular guarantees about the order of recursive calls: -- they may be executed more than once or executed in different order. -- That said, monadic effects must be idempotent and commutative.+--+-- @since 0.2.0.0 tabulateFixM-  :: forall m v a.-     (Monad m, G.Vector v a)+  :: (Monad m, G.Vector v a)   => ((Word -> m a) -> Word -> m a)   -> m (Chimera v a) tabulateFixM = tabulateFixM_ Downwards@@ -260,6 +307,8 @@ {-# SPECIALIZE tabulateFixM :: G.Vector v a => ((Word -> Identity a) -> Word -> Identity a) -> Identity (Chimera v a) #-}  -- | Monadic version of 'tabulateFix''.+--+-- @since 0.3.3.0 tabulateFixM'   :: forall m v a.      (Monad m, G.Vector v a)@@ -267,7 +316,9 @@   -> m (Chimera v a) tabulateFixM' = tabulateFixM_ Full --- | Memoization strategy, only used by 'tabulateFixM_'.+{-# SPECIALIZE tabulateFixM' :: G.Vector v a => ((Word -> Identity a) -> Word -> Identity a) -> Identity (Chimera v a) #-}++-- | Memoization strategy, only used by @tabulateFixM_@. data Strategy = Full | Downwards  -- | Internal implementation for 'tabulateFixM' and 'tabulateFixM''.@@ -280,7 +331,7 @@ tabulateFixM_ strat f = result   where     result :: m (Chimera v a)-    result = Chimera <$> V.generateM (bits + 1) tabulateSubVector+    result = Chimera <$> generateArrayM (bits + 1) tabulateSubVector      tabulateSubVector :: Int -> m (v a)     tabulateSubVector 0 = G.singleton <$> case strat of@@ -303,43 +354,114 @@               Downwards -> f fixF k               Full      -> flip index k <$> result --- | 'iterate' @f@ @x@ returns an infinite stream--- of repeated applications of @f@ to @x@.+-- | 'iterate' @f@ @x@ returns an infinite stream, generated by+-- repeated applications of @f@ to @x@. -- -- >>> ch = iterate (+ 1) 0 :: UChimera Int -- >>> take 10 (toList ch) -- [0,1,2,3,4,5,6,7,8,9]+--+-- @since 0.3.0.0 iterate :: G.Vector v a => (a -> a) -> a -> Chimera v a iterate f = runIdentity . iterateM (pure . f) +-- | Similar to 'G.iterateNM'.+iterateListNM :: forall a m. Monad m => Int -> (a -> m a) -> a -> m [a]+iterateListNM n f = if n <= 0 then const (pure []) else go (n - 1)+  where+    go :: Int -> a -> m [a]+    go 0 s = pure [s]+    go k s = do+      fs <- f s+      (s :) <$> go (k - 1) fs+ -- | Monadic version of 'iterate'.-iterateM :: forall m v a. (Monad m, G.Vector v a) => (a -> m a) -> a -> m (Chimera v a)+--+-- @since 0.3.0.0+iterateM :: (Monad m, G.Vector v a) => (a -> m a) -> a -> m (Chimera v a) iterateM f seed = do   nextSeed <- f seed   let z = G.singleton seed-  zs <- V.iterateNM bits go (G.singleton nextSeed)-  pure $ Chimera $ z `V.cons` zs+  zs <- iterateListNM bits go (G.singleton nextSeed)+  pure $ Chimera $ A.fromListN (bits + 1) (z : zs)   where-    go :: v a -> m (v a)     go vec = do       nextSeed <- f (G.unsafeLast vec)       G.iterateNM (G.length vec `shiftL` 1) f nextSeed  {-# SPECIALIZE iterateM :: G.Vector v a => (a -> Identity a) -> a -> Identity (Chimera v a) #-} +-- | 'unfoldr' @f@ @x@ returns an infinite stream, generated by+-- repeated applications of @f@ to @x@, similar to `Data.List.unfoldr`.+--+-- >>> ch = unfoldr (\acc -> (acc * acc, acc + 1)) 0 :: UChimera Int+-- >>> take 10 (toList ch)+-- [0,1,4,9,16,25,36,49,64,81]+--+-- @since 0.3.3.0+unfoldr :: G.Vector v b => (a -> (b, a)) -> a -> Chimera v b+unfoldr f = runIdentity . unfoldrM (pure . f)++-- | This is not quite satisfactory, see https://github.com/haskell/vector/issues/447+unfoldrExactVecNM :: forall m a b v. (Monad m, G.Vector v b) => Int -> (a -> m (b, a)) -> a -> m (v b, a)+unfoldrExactVecNM n f s = flip LazyState.evalStateT s $ do+  vec <- G.replicateM n f'+  seed <- LazyState.get+  pure (vec, seed)+  where+    f' :: LazyState.StateT a m b+    f' = do+      seed <- LazyState.get+      (value, newSeed) <- lift (f seed)+      LazyState.put newSeed+      pure value++-- | Monadic version of 'unfoldr'.+--+-- @since 0.3.3.0+unfoldrM :: (Monad m, G.Vector v b) => (a -> m (b, a)) -> a -> m (Chimera v b)+unfoldrM f seed = do+  let go n s = if n >= bits then pure [] else do+        (vec, s') <- unfoldrExactVecNM (1 `shiftL` n) f s+        rest <- go (n + 1) s'+        pure $ vec : rest+  (z, seed') <- unfoldrExactVecNM 1 f seed+  zs <- go 0 seed'+  pure $ Chimera $ A.fromListN (bits + 1) (z : zs)++interleaveVec :: G.Vector v a => v a -> v a -> v a+interleaveVec as bs = G.generate (G.length as `shiftL` 1)+  (\n -> (if even n then as else bs) G.! (n `shiftR` 1))++-- | Intertleave two streams, sourcing even elements from the first one+-- and odd elements from the second one.+--+-- >>> ch = interleave (tabulate id) (tabulate (+ 100)) :: UChimera Word+-- >>> take 10 (toList ch)+-- [0,100,1,101,2,102,3,103,4,104]+--+-- @since 0.3.3.0+interleave :: G.Vector v a => Chimera v a -> Chimera v a -> Chimera v a+interleave (Chimera as) (Chimera bs) = Chimera $ A.arrayFromListN (bits + 1) vecs+  where+    vecs = A.indexArray as 0 : A.indexArray bs 0 :+      map (\i -> interleaveVec (A.indexArray as i) (A.indexArray bs i)) [1 .. bits - 1]+ -- | Index a stream in a constant time. -- -- >>> ch = tabulate (^ 2) :: UChimera Word -- >>> index ch 9 -- 81+--+-- @since 0.2.0.0 index :: G.Vector v a => Chimera v a -> Word -> a index (Chimera vs) i =-  (vs `V.unsafeIndex` (fbs i - lz))+  (vs `A.indexArray` (bits - lz))   `G.unsafeIndex`-  word2int (i .&. complement ((1 `shiftL` (fbs i - 1)) `unsafeShiftR` lz))+  word2int (i .&. complement ((1 `shiftL` (bits - 1)) `unsafeShiftR` lz))   where     lz :: Int-    !lz = word2int (clz i)+    !lz = countLeadingZeros i {-# INLINE index #-}  -- | Convert a stream to an infinite list.@@ -347,15 +469,81 @@ -- >>> ch = tabulate (^ 2) :: UChimera Word -- >>> take 10 (toList ch) -- [0,1,4,9,16,25,36,49,64,81]+--+-- @since 0.3.0.0 toList :: G.Vector v a => Chimera v a -> [a] toList (Chimera vs) = foldMap G.toList vs --- | Return an infinite repetion of a given vector.+measureOff :: Int -> [a] -> Either Int ([a], [a])+measureOff n+  | n <= 0 = Right . ([], )+  | otherwise = go n+  where+    go m [] = Left m+    go 1 (x : xs) = Right ([x], xs)+    go m (x : xs) = case go (m - 1) xs of+      l@Left{} -> l+      Right (xs', xs'') -> Right (x : xs', xs'')++measureOffVector :: G.Vector v a => Int -> v a -> Either Int (v a, v a)+measureOffVector n xs+  | n <= l = Right (G.splitAt n xs)+  | otherwise = Left (n - l)+  where+    l = G.length xs++-- | Create a stream of values from a given prefix, followed by default value+-- afterwards.+--+-- @since 0.3.3.0+fromListWithDef+  :: G.Vector v a+  => a   -- ^ Default value+  -> [a] -- ^ Prefix+  -> Chimera v a+fromListWithDef a = Chimera . A.fromListN (bits + 1) . go0+  where+    go0 = \case+      [] -> G.singleton a : map (\k -> G.replicate (1 `shiftL` k) a) [0 .. bits - 1]+      x : xs -> G.singleton x : go 0 xs++    go k xs = case measureOff kk xs of+      Left l -> G.fromListN kk (xs ++ replicate l a) :+        map (\n -> G.replicate (1 `shiftL` n) a) [k + 1 .. bits - 1]+      Right (ys, zs) -> G.fromListN kk ys : go (k + 1) zs+      where+        kk = 1 `shiftL` k++-- | Create a stream of values from a given prefix, followed by default value+-- afterwards.+--+-- @since 0.3.3.0+fromVectorWithDef+  :: G.Vector v a+  => a   -- ^ Default value+  -> v a -- ^ Prefix+  -> Chimera v a+fromVectorWithDef a = Chimera . A.fromListN (bits + 1) . go0+  where+    go0 xs = case G.uncons xs of+      Nothing -> G.singleton a : map (\k -> G.replicate (1 `shiftL` k) a) [0 .. bits - 1]+      Just (y, ys) -> G.singleton y : go 0 ys++    go k xs = case measureOffVector kk xs of+      Left l -> (xs G.++ G.replicate l a) :+        map (\n -> G.replicate (1 `shiftL` n) a) [k + 1 .. bits - 1]+      Right (ys, zs) -> ys : go (k + 1) zs+      where+        kk = 1 `shiftL` k++-- | Return an infinite repetition of a given vector. -- Throw an error on an empty vector. -- -- >>> ch = cycle (Data.Vector.fromList [4, 2]) :: VChimera Int -- >>> take 10 (toList ch) -- [4,2,4,2,4,2,4,2,4,2]+--+-- @since 0.3.0.0 cycle :: G.Vector v a => v a -> Chimera v a cycle vec = case l of   0 -> error "Data.Chimera.cycle: empty list"@@ -372,6 +560,8 @@ -- 'index' ('tabulate' @f@ :: 'UChimera' @a@). -- -- prop> memoize f n = f n+--+-- @since 0.3.0.0 memoize :: (Word -> a) -> (Word -> a) memoize = index @V.Vector . tabulate @@ -410,22 +600,98 @@ -- >>> collatzF f n = if n <= 1 then 0 else 1 + f (if even n then n `quot` 2 else 3 * n + 1) -- >>> memoizeFix collatzF 27 -- 111+--+-- @since 0.3.0.0 memoizeFix :: ((Word -> a) -> Word -> a) -> (Word -> a) memoizeFix = index @V.Vector . tabulateFix  -- | Map subvectors of a stream, using a given length-preserving function.+--+-- @since 0.3.0.0 mapSubvectors   :: (G.Vector u a, G.Vector v b)   => (u a -> v b)   -> Chimera u a   -> Chimera v b-mapSubvectors f (Chimera bs) = Chimera (fmap f bs)+mapSubvectors f = runIdentity . traverseSubvectors (pure . f) +-- | Traverse subvectors of a stream, using a given length-preserving function.+--+-- Be careful, because similar to 'tabulateM', only lazy monadic effects can+-- be executed in a finite time: lazy state monad is fine, but strict one is+-- not.+--+-- @since 0.3.3.0+traverseSubvectors+  :: (G.Vector u a, G.Vector v b, Applicative m)+  => (u a -> m (v b))+  -> Chimera u a+  -> m (Chimera v b)+traverseSubvectors f (Chimera bs) = Chimera <$> traverse safeF bs+  where+    -- Computing vector length is cheap, so let's check that @f@ preserves length.+    safeF x = (\fx -> if G.length x == G.length fx then fx else+        error "traverseSubvectors: the function is not length-preserving") <$> f x++{-# SPECIALIZE traverseSubvectors :: (G.Vector u a, G.Vector v b) => (u a -> Identity (v b)) -> Chimera u a -> Identity (Chimera v b)  #-}++-- | @since 0.3.0.0+zipSubvectors :: (G.Vector u a, G.Vector v b, G.Vector w c) => (u a -> v b -> w c) -> Chimera u a -> Chimera v b -> Chimera w c+zipSubvectors = zipWithSubvectors+{-# DEPRECATED zipSubvectors "Use zipWithSubvectors instead" #-}+ -- | Zip subvectors from two streams, using a given length-preserving function.-zipSubvectors+--+-- @since 0.3.3.0+zipWithSubvectors   :: (G.Vector u a, G.Vector v b, G.Vector w c)   => (u a -> v b -> w c)   -> Chimera u a   -> Chimera v b   -> Chimera w c-zipSubvectors f (Chimera bs1) (Chimera bs2) = Chimera (mzipWith f bs1 bs2)+zipWithSubvectors f = (runIdentity .) . zipWithMSubvectors ((pure .) . f)++-- | Zip subvectors from two streams, using a given monadic length-preserving function.+-- Caveats for 'tabulateM' and 'traverseSubvectors' apply.+--+-- @since 0.3.3.0+zipWithMSubvectors+  :: (G.Vector u a, G.Vector v b, G.Vector w c, Applicative m)+  => (u a -> v b -> m (w c))+  -> Chimera u a+  -> Chimera v b+  -> m (Chimera w c)+zipWithMSubvectors f (Chimera bs1) (Chimera bs2) = Chimera <$> sequenceA (mzipWith safeF bs1 bs2)+  where+    -- Computing vector length is cheap, so let's check that @f@ preserves length.+    safeF x y = (\fx -> if G.length x == G.length fx then fx else+        error "traverseSubvectors: the function is not length-preserving") <$> f x y++{-# SPECIALIZE zipWithMSubvectors :: (G.Vector u a, G.Vector v b, G.Vector w c) => (u a -> v b -> Identity (w c)) -> Chimera u a -> Chimera v b -> Identity (Chimera w c) #-}++-- | Take a slice of 'Chimera', represented as a list on consecutive subvectors.+--+-- @since 0.3.3.0+sliceSubvectors+  :: G.Vector v a+  => Int -- ^ How many initial elements to drop?+  -> Int -- ^ How many subsequent elements to take?+  -> Chimera v a+  -> [v a]+sliceSubvectors off len = doTake len . doDrop off . F.toList . unChimera+  where+    doTake !_ [] = []+    doTake n (x : xs)+      | n <= 0 = []+      | n >= l = x : doTake (n - l) xs+      | otherwise = [G.take n x]+      where+        l = G.length x++    doDrop !_ [] = []+    doDrop n (x : xs)+      | n <= 0 = x : xs+      | l <= n = doDrop (n - l) xs+      | otherwise = G.drop n x : xs+      where+        l = G.length x

@@ -1,56 +0,0 @@--- |--- Module:      Data.Chimera.Compat--- Copyright:   (c) 2017 Andrew Lelechenko--- Licence:     MIT--- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>--{-# LANGUAGE CPP       #-}-{-# LANGUAGE MagicHash #-}--{-# OPTIONS_GHC -fno-warn-unused-imports #-}-{-# OPTIONS_HADDOCK hide #-}--module Data.Chimera.Compat-  ( clz-  , fbs-  ) where--import Data.Bits-import GHC.Exts-import Unsafe.Coerce--#if __GLASGOW_HASKELL__ > 709--clz :: Word -> Word-clz (W# w#) = W# (clz# w#)-{-# INLINE clz #-}--#else--int2word :: Int -> Word-int2word = unsafeCoerce--clz :: Word -> Word-clz w = int2word $ case setBits of-  []      -> sz-  (s : _) -> sz - s - 1-  where-    sz = fbs w-    setBits = map fst $ filter snd $ map (\i -> (i, testBit w i)) [sz - 1, sz - 2 .. 0]-{-# INLINE clz #-}--#endif--#if __GLASGOW_HASKELL__ > 707--fbs :: Word -> Int-fbs = finiteBitSize-{-# INLINE fbs #-}--#else--fbs :: Word -> Int-fbs = bitSize-{-# INLINE fbs #-}--#endif

@@ -64,37 +64,26 @@ -- -- > cast :: (Int -> Int -> Bool) -> (Word -> Bool) -- > cast f = \n -> let (x, y) = fromZCurve n in--- >  f (word2int x) (word2int y)+-- >  f (wordToInt x) (wordToInt y) -- -- and then back: -- -- > uncast :: (Word -> Bool) -> (Int -> Int -> Bool)--- > uncast g = \x y -> g (toZCurve (int2word x) (int2word y))+-- > uncast g = \x y -> g (toZCurve (intToWord x) (intToWord y)) -- -{-# LANGUAGE CPP #-}--#include "MachDeps.h"- module Data.Chimera.ContinuousMapping   ( intToWord   , wordToInt-#if WORD_SIZE_IN_BITS == 64   , toZCurve   , fromZCurve   , toZCurve3   , fromZCurve3-#endif   ) where  import Data.Bits-import Unsafe.Coerce--word2int :: Word -> Int-word2int = unsafeCoerce--int2word :: Int -> Word-int2word = unsafeCoerce+import Data.Chimera.FromIntegral+import Data.Word  -- | Total map, which satisfies --@@ -106,19 +95,23 @@ -- -- >>> map intToWord [-5..5] -- [9,7,5,3,1,0,2,4,6,8,10]+--+-- @since 0.2.0.0 intToWord :: Int -> Word-intToWord i-  | i >= 0    = int2word        i `shiftL` 1-  | otherwise = int2word (-1 - i) `shiftL` 1 + 1+intToWord i = (if sign == 0 then id else complement) (int2word i) `shiftL` 1 + sign+  where+    sign = int2word i `shiftR` (finiteBitSize i - 1)+{-# INLINE intToWord #-}  -- | Inverse for 'intToWord'. -- -- >>> map wordToInt [0..10] -- [0,-1,1,-2,2,-3,3,-4,4,-5,5]+--+-- @since 0.2.0.0 wordToInt :: Word -> Int-wordToInt w-  | even w    =         word2int (w `shiftR` 1)-  | otherwise = negate (word2int (w `shiftR` 1)) - 1+wordToInt w = word2int $ (if w .&. 1 == 0 then id else complement) (w `shiftR` 1)+{-# INLINE wordToInt #-}  -- | Total map from plain to line, continuous almost everywhere. -- See <https://en.wikipedia.org/wiki/Z-order_curve Z-order curve>.@@ -127,6 +120,8 @@ -- -- >>> [ toZCurve x y | x <- [0..3], y <- [0..3] ] -- [0,2,8,10,1,3,9,11,4,6,12,14,5,7,13,15]+--+-- @since 0.2.0.0 toZCurve :: Word -> Word -> Word toZCurve x y = part1by1 y `shiftL` 1 .|. part1by1 x @@ -135,6 +130,8 @@ -- -- >>> map fromZCurve [0..15] -- [(0,0),(1,0),(0,1),(1,1),(2,0),(3,0),(2,1),(3,1),(0,2),(1,2),(0,3),(1,3),(2,2),(3,2),(2,3),(3,3)]+--+-- @since 0.2.0.0 fromZCurve :: Word -> (Word, Word) fromZCurve z = (compact1by1 z, compact1by1 (z `shiftR` 1)) @@ -146,6 +143,8 @@ -- >>> [ toZCurve3 x y z | x <- [0..3], y <- [0..3], z <- [0..3] ] -- [0,4,32,36,2,6,34,38,16,20,48,52,18,22,50,54,1,5,33,37,3,7,35,39,17,21,49,53,19,23,51,55, -- 8,12,40,44,10,14,42,46,24,28,56,60,26,30,58,62,9,13,41,45,11,15,43,47,25,29,57,61,27,31,59,63]+--+-- @since 0.2.0.0 toZCurve3 :: Word -> Word -> Word -> Word toZCurve3 x y z = part1by2 z `shiftL` 2 .|. part1by2 y `shiftL` 1 .|. part1by2 x @@ -157,14 +156,16 @@ --  (0,2,0),(1,2,0),(0,3,0),(1,3,0),(0,2,1),(1,2,1),(0,3,1),(1,3,1),(2,2,0),(3,2,0),(2,3,0),(3,3,0),(2,2,1),(3,2,1),(2,3,1),(3,3,1), --  (0,0,2),(1,0,2),(0,1,2),(1,1,2),(0,0,3),(1,0,3),(0,1,3),(1,1,3),(2,0,2),(3,0,2),(2,1,2),(3,1,2),(2,0,3),(3,0,3),(2,1,3),(3,1,3), --  (0,2,2),(1,2,2),(0,3,2),(1,3,2),(0,2,3),(1,2,3),(0,3,3),(1,3,3),(2,2,2),(3,2,2),(2,3,2),(3,3,2),(2,2,3),(3,2,3),(2,3,3),(3,3,3)]+--+-- @since 0.2.0.0 fromZCurve3 :: Word -> (Word, Word, Word) fromZCurve3 z = (compact1by2 z, compact1by2 (z `shiftR` 1), compact1by2 (z `shiftR` 2))  -- Inspired by https://fgiesen.wordpress.com/2009/12/13/decoding-morton-codes/ part1by1 :: Word -> Word-part1by1 x = x5+part1by1 x = fromIntegral (x5 :: Word64)   where-    x0 = x                           .&. 0x00000000ffffffff+    x0 = fromIntegral x              .&. 0x00000000ffffffff     x1 = (x0 `xor` (x0 `shiftL` 16)) .&. 0x0000ffff0000ffff     x2 = (x1 `xor` (x1 `shiftL`  8)) .&. 0x00ff00ff00ff00ff     x3 = (x2 `xor` (x2 `shiftL`  4)) .&. 0x0f0f0f0f0f0f0f0f@@ -173,9 +174,9 @@  -- Inspired by https://fgiesen.wordpress.com/2009/12/13/decoding-morton-codes/ part1by2 :: Word -> Word-part1by2 x = x5+part1by2 x = fromIntegral (x5 :: Word64)   where-    x0 = x                           .&. 0x00000000ffffffff+    x0 = fromIntegral x              .&. 0x00000000ffffffff     x1 = (x0 `xor` (x0 `shiftL` 32)) .&. 0xffff00000000ffff     x2 = (x1 `xor` (x1 `shiftL` 16)) .&. 0x00ff0000ff0000ff     x3 = (x2 `xor` (x2 `shiftL`  8)) .&. 0xf00f00f00f00f00f@@ -184,9 +185,9 @@  -- Inspired by https://fgiesen.wordpress.com/2009/12/13/decoding-morton-codes/ compact1by1 :: Word -> Word-compact1by1 x = x5+compact1by1 x = fromIntegral (x5 :: Word64)   where-    x0 = x                           .&. 0x5555555555555555+    x0 = fromIntegral x              .&. 0x5555555555555555     x1 = (x0 `xor` (x0 `shiftR`  1)) .&. 0x3333333333333333     x2 = (x1 `xor` (x1 `shiftR`  2)) .&. 0x0f0f0f0f0f0f0f0f     x3 = (x2 `xor` (x2 `shiftR`  4)) .&. 0x00ff00ff00ff00ff@@ -195,9 +196,9 @@  -- Inspired by https://fgiesen.wordpress.com/2009/12/13/decoding-morton-codes/ compact1by2 :: Word -> Word-compact1by2 x = x5+compact1by2 x = fromIntegral (x5 :: Word64)   where-    x0 = x                           .&. 0x1249249249249249+    x0 = fromIntegral x              .&. 0x1249249249249249     x1 = (x0 `xor` (x0 `shiftR`  2)) .&. 0x30c30c30c30c30c3     x2 = (x1 `xor` (x1 `shiftR`  4)) .&. 0xf00f00f00f00f00f     x3 = (x2 `xor` (x2 `shiftR`  8)) .&. 0x00ff0000ff0000ff

@@ -82,15 +82,16 @@   ) where  import Data.Bits-import Data.Chimera.Compat import GHC.Exts  bits :: Int-bits = fbs (0 :: Word)+bits = finiteBitSize (0 :: Word)  -- | Left inverse for 'fromWheel2'. Monotonically non-decreasing function. -- -- prop> toWheel2 . fromWheel2 == id+--+-- @since 0.2.0.0 toWheel2 :: Word -> Word toWheel2 i = i `shiftR` 1 {-# INLINE toWheel2 #-}@@ -102,6 +103,8 @@ -- -- >>> map fromWheel2 [0..9] -- [1,3,5,7,9,11,13,15,17,19]+--+-- @since 0.2.0.0 fromWheel2 :: Word -> Word fromWheel2 i = i `shiftL` 1 + 1 {-# INLINE fromWheel2 #-}@@ -109,6 +112,8 @@ -- | Left inverse for 'fromWheel6'. Monotonically non-decreasing function. -- -- prop> toWheel6 . fromWheel6 == id+--+-- @since 0.2.0.0 toWheel6 :: Word -> Word toWheel6 i@(W# i#) = case bits of   64 -> W# z1# `shiftR` 1@@ -126,6 +131,8 @@ -- -- >>> map fromWheel6 [0..9] -- [1,5,7,11,13,17,19,23,25,29]+--+-- @since 0.2.0.0 fromWheel6 :: Word -> Word fromWheel6 i = i `shiftL` 1 + i + (i .&. 1) + 1 {-# INLINE fromWheel6 #-}@@ -133,6 +140,8 @@ -- | Left inverse for 'fromWheel30'. Monotonically non-decreasing function. -- -- prop> toWheel30 . fromWheel30 == id+--+-- @since 0.2.0.0 toWheel30 :: Word -> Word toWheel30 i@(W# i#) = q `shiftL` 3 + (r + r `shiftR` 4) `shiftR` 2   where@@ -154,6 +163,8 @@ -- -- >>> map fromWheel30 [0..9] -- [1,7,11,13,17,19,23,29,31,37]+--+-- @since 0.2.0.0 fromWheel30 :: Word -> Word fromWheel30 i = ((i `shiftL` 2 - i `shiftR` 2) .|. 1)               + ((i `shiftL` 1 - i `shiftR` 1) .&. 2)@@ -162,6 +173,8 @@ -- | Left inverse for 'fromWheel210'. Monotonically non-decreasing function. -- -- prop> toWheel210 . fromWheel210 == id+--+-- @since 0.2.0.0 toWheel210 :: Word -> Word toWheel210 i@(W# i#) = q `shiftL` 5 + q `shiftL` 4 + W# tableEl#   where@@ -193,6 +206,8 @@ -- -- >>> map fromWheel210 [0..9] -- [1,11,13,17,19,23,29,31,37,41]+--+-- @since 0.2.0.0 fromWheel210 :: Word -> Word fromWheel210 i@(W# i#) = q * 210 + W# tableEl#   where

@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain

@@ -3,8 +3,10 @@ module Main where  import Control.Monad.State (evalState, put, get)+import Data.Bits import Data.Chimera import Test.Tasty.Bench+import Test.Tasty.Patterns.Printer import System.Random  #ifdef MIN_VERSION_ral@@ -12,17 +14,25 @@ #endif  sizes :: Num a => [a]-sizes = [100, 200, 500, 1000]+sizes = [7, 8, 9, 10]  main :: IO ()-main = defaultMain $ (: []) $ bgroup "read"-  [ bgroup "Chimera" (map benchReadChimera sizes)-  , bgroup "List"    (map benchReadList    sizes)+main = defaultMain $ (: []) $ mapLeafBenchmarks addCompare $ bgroup "read"+  [ bgroup chimeraBenchName (map benchReadChimera sizes)+  , bgroup "List"           (map benchReadList    sizes) #ifdef MIN_VERSION_ral-  , bgroup "RAL"     (map benchReadRAL     sizes)+  , bgroup "RAL"            (map benchReadRAL     sizes) #endif   ] +chimeraBenchName :: String+chimeraBenchName = "Chimera"++addCompare :: ([String] -> Benchmark -> Benchmark)+addCompare (size : name : path)+  | name /= "Chimera" = bcompare (printAwkExpr (locateBenchmark (size : chimeraBenchName : path)))+addCompare _ = id+ randomChimera :: UChimera Int randomChimera = flip evalState (mkStdGen 42) $ tabulateM $ const $ do   g <- get@@ -35,7 +45,7 @@  #ifdef MIN_VERSION_ral randomRAL :: RAL.RAList Int-randomRAL = RAL.fromList $ take (maximum sizes) $ randoms (mkStdGen 42)+randomRAL = RAL.fromList $ take (1 `shiftL` (maximum sizes)) $ randoms (mkStdGen 42) #endif  randomIndicesWord :: [Word]@@ -44,27 +54,31 @@ randomIndicesInt :: [Int] randomIndicesInt = randoms (mkStdGen 42) -benchReadChimera :: Word -> Benchmark-benchReadChimera n+benchReadChimera :: Int -> Benchmark+benchReadChimera k   = bench (show n)   $ nf (sum . map (index randomChimera))-  $ map (`rem` n)+  $ map (.&. (n - 1))   $ take (fromIntegral n) randomIndicesWord+  where+    n = 1 `shiftL` k  benchReadList :: Int -> Benchmark-benchReadList n-  = bcompare ("$NF == \"" ++ show n ++ "\" && $(NF-1) == \"Chimera\"")-  $ bench (show n)+benchReadList k+  = bench (show n)   $ nf (sum . map (randomList !!))-  $ map (`mod` n)+  $ map (.&. (n - 1))   $ take n randomIndicesInt+  where+    n = 1 `shiftL` k  #ifdef MIN_VERSION_ral benchReadRAL :: Int -> Benchmark-benchReadRAL n-  = bcompare ("$NF == \"" ++ show n ++ "\" && $(NF-1) == \"Chimera\"")-  $ bench (show n)+benchReadRAL k+  = bench (show n)   $ nf (sum . map (randomRAL RAL.!))-  $ map (`mod` n)+  $ map (.&. (n - 1))   $ take n randomIndicesInt+  where+    n = 1 `shiftL` k #endif

@@ -1,3 +1,11 @@+# 0.3.3.0++* Add `fromListWithDef`, `fromVectorWithDef`, `interleave`.+* Add `unfoldr` and `unfoldrM`.+* Export `tabulateFixM'`.+* Add `sliceSubvectors`, `traverseSubvectors`, `zipWithSubvectors` and `zipWithMSubvectors`.+* Deprecate `zipSubvectors` in favor of `zipWithSubvectors`.+ # 0.3.2.0  * Implement `tabulateFix'`.@@ -17,6 +25,7 @@ * Implement `mapSubvectors` and `zipSubvectors` * Make boxed `tabulateFix` even lazier. * Speed up `Data.Chimera.WheelMapping`.+* Remove `mapWithKey`, `traverseWithKey`, `zipWithKey`, `zipWithKeyM`.  # 0.2.0.0 

@@ -1,5 +1,5 @@ name: chimera-version: 0.3.2.0+version: 0.3.3.0 cabal-version: 2.0 build-type: Simple license: BSD3@@ -13,7 +13,7 @@ extra-source-files:   README.md   changelog.md-tested-with: GHC==9.0.1, GHC==8.10.5, GHC==8.8.4, GHC==8.6.5, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2+tested-with: GHC==9.4.4, GHC==9.2.5, GHC==9.0.2, GHC==8.10.7, GHC==8.8.4, GHC==8.6.5, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2 description:   There are plenty of memoizing libraries on Hackage, but they   usually fall into two categories:@@ -49,7 +49,7 @@   default: True  library-  build-depends: base >=4.9 && <5, vector+  build-depends: base >=4.9 && <5, primitive, transformers, vector   if flag(representable)     build-depends: adjunctions, distributive, mtl   exposed-modules:@@ -57,7 +57,6 @@     Data.Chimera.ContinuousMapping     Data.Chimera.WheelMapping   other-modules:-    Data.Chimera.Compat     Data.Chimera.FromIntegral   default-language: Haskell2010   ghc-options: -Wall -Wcompat@@ -84,7 +83,8 @@     chimera,     mtl,     random,-    tasty-bench >= 0.2.4+    tasty >= 1.4.2,+    tasty-bench >= 0.3.2   type: exitcode-stdio-1.0   main-is: Bench.hs   default-language: Haskell2010

@@ -12,11 +12,12 @@ import Data.Bits import Data.Foldable import Data.Function (fix)+import qualified Data.List as L import qualified Data.Vector.Generic as G-import qualified Data.Vector.Unboxed as U  import Data.Chimera.ContinuousMapping import Data.Chimera.WheelMapping+import Data.Chimera (UChimera, VChimera) import qualified Data.Chimera as Ch  instance (G.Vector v a, Arbitrary a) => Arbitrary (Ch.Chimera v a) where@@ -72,40 +73,87 @@   [ QC.testProperty "index . tabulate = id" $     \(Fun _ (f :: Word -> Bool)) ix ->       let jx = ix `mod` 65536 in-        f jx === Ch.index (Ch.tabulate f :: Ch.Chimera U.Vector Bool) jx+        f jx === Ch.index (Ch.tabulate f :: UChimera Bool) jx +  , QC.testProperty "memoize = id" $+    \(Fun _ (f :: Word -> Bool)) ix ->+      let jx = ix `mod` 65536 in+        f jx === Ch.memoize f jx+   , QC.testProperty "index . tabulateFix = fix" $     \(Fun _ g) ix ->       let jx = ix `mod` 65536 in         let f = mkUnfix g in-          fix f jx === Ch.index (Ch.tabulateFix f :: Ch.Chimera U.Vector Bool) jx+          fix f jx === Ch.index (Ch.tabulateFix f :: UChimera Bool) jx    , QC.testProperty "index . tabulateFix' = fix" $     \(Fun _ g) ix ->       let jx = ix `mod` 65536 in         let f = mkUnfix g in-          fix f jx === Ch.index (Ch.tabulateFix' f :: Ch.Chimera U.Vector Bool) jx+          fix f jx === Ch.index (Ch.tabulateFix' f :: UChimera Bool) jx +  , QC.testProperty "memoizeFix = fix" $+    \(Fun _ g) ix ->+      let jx = ix `mod` 65536 in+        let f = mkUnfix g in+          fix f jx === Ch.memoizeFix f jx+   , QC.testProperty "iterate" $     \(Fun _ (f :: Word -> Word)) seed ix ->       let jx = ix `mod` 65536 in-        iterate f seed !! fromIntegral jx === Ch.index (Ch.iterate f seed :: Ch.Chimera U.Vector Word) jx+        iterate f seed !! fromIntegral jx === Ch.index (Ch.iterate f seed :: UChimera Word) jx +  , QC.testProperty "unfoldr" $+    \(Fun _ (f :: Word -> (Int, Word))) seed ix ->+      let jx = ix `mod` 65536 in+        L.unfoldr (Just . f) seed !! fromIntegral jx === Ch.index (Ch.unfoldr f seed :: UChimera Int) jx++  , QC.testProperty "interleave" $+    \(Fun _ (f :: Word -> Bool)) (Fun _ (g :: Word -> Bool)) ix ->+      let jx = ix `mod` 65536 in+        (if even jx then f else g) (jx `quot` 2) === Ch.index (Ch.interleave (Ch.tabulate f) (Ch.tabulate g) :: UChimera Bool) jx++  , QC.testProperty "pure" $+    \x ix ->+      let jx = ix `mod` 65536 in+        x === Ch.index (pure x :: VChimera Word) jx+   , QC.testProperty "cycle" $     \xs ix -> not (null xs) ==>       let jx = ix `mod` 65536 in-        let vs = U.fromList xs :: U.Vector Bool in-          vs U.! (fromIntegral jx `mod` U.length vs) === Ch.index (Ch.cycle vs) jx+        let vs = G.fromList xs in+          vs G.! (fromIntegral jx `mod` G.length vs) === Ch.index (Ch.cycle vs :: UChimera Bool) jx +  , QC.testProperty "toList" $+    \x xs -> xs === take (length xs) (Ch.toList (Ch.fromListWithDef x xs :: UChimera Bool))++  , QC.testProperty "fromListWithDef" $+    \x xs ix ->+      let jx = ix `mod` 65536 in+        (if fromIntegral jx < length xs then xs !! fromIntegral jx else x) ===+          Ch.index (Ch.fromListWithDef x xs :: UChimera Bool) jx++  , QC.testProperty "fromVectorWithDef" $+    \x xs ix ->+      let jx = ix `mod` 65536 in+        let vs = G.fromList xs in+          (if fromIntegral jx < length xs then vs G.! fromIntegral jx else x) ===+            Ch.index (Ch.fromVectorWithDef x vs :: UChimera Bool) jx+   , QC.testProperty "mapWithKey" $     \(Blind bs) (Fun _ (g :: Word -> Word)) ix ->       let jx = ix `mod` 65536 in-        g (Ch.index bs jx) === Ch.index (Ch.mapSubvectors (G.map g) bs :: Ch.Chimera U.Vector Word) jx+        g (Ch.index bs jx) === Ch.index (Ch.mapSubvectors (G.map g) bs :: UChimera Word) jx    , QC.testProperty "zipWithKey" $     \(Blind bs1) (Blind bs2) (Fun _ (g :: (Word, Word) -> Word)) ix ->       let jx = ix `mod` 65536 in-        g (Ch.index bs1 jx, Ch.index bs2 jx) === Ch.index (Ch.zipSubvectors (G.zipWith (curry g)) bs1 bs2 :: Ch.Chimera U.Vector Word) jx+        g (Ch.index bs1 jx, Ch.index bs2 jx) === Ch.index (Ch.zipWithSubvectors (G.zipWith (curry g)) bs1 bs2 :: UChimera Word) jx++  , QC.testProperty "sliceSubvectors" $+    \x xs ix ->+      let vs = G.fromList xs in+        fold (Ch.sliceSubvectors ix (G.length vs - max 0 ix) (Ch.fromVectorWithDef x vs :: UChimera Bool)) === G.drop ix vs   ]  -------------------------------------------------------------------------------