chimera 0.3.3.0 → 0.3.4.0

raw patch · 15 files changed

+1446/−1233 lines, 15 filesdep +infinite-listdep ~QuickCheckdep ~adjunctionsdep ~distributivePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: infinite-list

Dependency ranges changed: QuickCheck, adjunctions, distributive, mtl, primitive, random, tasty, tasty-bench, tasty-hunit, tasty-quickcheck, tasty-smallcheck, transformers, vector

API changes (from Hackage documentation)

Files

• Data/Chimera.hs +0/−697
• Data/Chimera/ContinuousMapping.hs +0/−206
• Data/Chimera/FromIntegral.hs +0/−19
• Data/Chimera/WheelMapping.hs +0/−233
• bench/Bench.hs +2/−1
• cbits/aarch64.c +9/−0
• cbits/aarch64.h +5/−0
• changelog.md +5/−0
• chimera.cabal +96/−72
• src/Data/Chimera.hs +795/−0
• src/Data/Chimera/Compat.hs +50/−0
• src/Data/Chimera/ContinuousMapping.hs +204/−0
• src/Data/Chimera/FromIntegral.hs +18/−0
• src/Data/Chimera/WheelMapping.hs +229/−0
• test/Test.hs +33/−5

@@ -1,697 +0,0 @@--- |--- Module:      Data.Chimera--- Copyright:   (c) 2018-2019 Andrew Lelechenko--- Licence:     MIT--- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>------ Lazy infinite streams with O(1) indexing.--{-# LANGUAGE BangPatterns          #-}-{-# LANGUAGE CPP                   #-}-{-# LANGUAGE DeriveTraversable     #-}-{-# LANGUAGE FlexibleContexts      #-}-{-# LANGUAGE FlexibleInstances     #-}-{-# LANGUAGE LambdaCase            #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ScopedTypeVariables   #-}-{-# LANGUAGE TupleSections         #-}-{-# LANGUAGE TypeApplications      #-}-{-# LANGUAGE TypeFamilies          #-}--module Data.Chimera-  ( -- * Memoization-    memoize-  , memoizeFix--  -- * Chimera-  , Chimera-  , VChimera-  , UChimera--  -- * Construction-  , tabulate-  , tabulateFix-  , tabulateFix'-  , iterate-  , unfoldr-  , cycle-  , fromListWithDef-  , fromVectorWithDef--  -- * Manipulation-  , interleave--  -- * Elimination-  , index-  , toList--  -- * Monadic construction-  -- $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--#ifdef MIN_VERSION_mtl-import Control.Monad.Reader (MonadReader, ask, local)-#endif-#ifdef MIN_VERSION_distributive-import Data.Distributive-#ifdef MIN_VERSION_adjunctions-import qualified Data.Functor.Rep as Rep-#endif-#endif--import Data.Chimera.FromIntegral---- $monadic--- Be careful: the stream is infinite, so--- monadic effects must be lazy--- in order to be executed in a finite time.------ For instance, lazy state monad works fine:------ >>> import Control.Monad.State.Lazy--- >>> ch = evalState (tabulateM (\i -> do modify (+ i); get)) 0 :: UChimera Word--- >>> take 10 (toList ch)--- [0,1,3,6,10,15,21,28,36,45]------ But the same computation in the strict state--- monad "Control.Monad.State.Strict" diverges.---- $subvectors--- Internally 'Chimera' consists of a number of subvectors.--- Following functions provide a low-level access to them.--- This ability is especially important for streams of booleans.------ Let us use 'Chimera' to memoize predicates @f1@, @f2@ @::@ 'Word' @->@ 'Bool'.--- Imagine them both already--- caught in amber as @ch1@, @ch2@ @::@ 'UChimera' 'Bool',--- and now we want to memoize @f3 x = f1 x && f2 x@ as @ch3@.--- One can do it in as follows:------ > ch3 = tabulate (\i -> index ch1 i && index ch2 i)------ There are two unsatisfactory things here. Firstly,--- even unboxed vectors store only one boolean per byte.--- We would rather reach out for 'Data.Bit.Bit' wrapper,--- which provides an instance of unboxed vector--- with one boolean per bit. Secondly, combining--- existing predicates by indexing them and tabulating again--- becomes relatively expensive, given how small and simple--- our data is. Fortunately, there is an ultra-fast 'Data.Bit.zipBits'--- to zip bit vectors. We can combine it altogether like this:------ > import Data.Bit--- > import Data.Bits--- > ch1 = tabulate (Bit . f1)--- > ch2 = tabulate (Bit . f2)--- > 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.------ @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 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 = 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 = 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-  index = index-#endif-#endif--bits :: Int-bits = finiteBitSize (0 :: Word)---- | Create a stream of values of a given function.--- Once created it can be accessed via 'index' or 'toList'.------ >>> ch = tabulate (^ 2) :: UChimera Word--- >>> index ch 9--- 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-  :: (Monad m, G.Vector v a)-  => (Word -> m a)-  -> m (Chimera v a)-tabulateM f = Chimera <$> generateArrayM (bits + 1) tabulateSubVector-  where-    tabulateSubVector 0 = G.singleton <$> f 0-    tabulateSubVector i = G.generateM ii (\j -> f (int2word (ii + j)))-      where-        ii = 1 `unsafeShiftL` (i - 1)--{-# SPECIALIZE tabulateM :: G.Vector v a => (Word -> Identity a) -> Identity (Chimera v a) #-}---- | For a given @f@ create a stream of values of a recursive function 'fix' @f@.--- Once created it can be accessed via 'index' or 'toList'.------ For example, imagine that we want to tabulate--- <https://en.wikipedia.org/wiki/Catalan_number Catalan numbers>:------ >>> catalan n = if n == 0 then 1 else sum [ catalan i * catalan (n - 1 - i) | i <- [0 .. n - 1] ]------ Can we find @catalanF@ such that @catalan@ = 'fix' @catalanF@?--- Just replace all recursive calls to @catalan@ with @f@:------ >>> catalanF f n = if n == 0 then 1 else sum [ f i * f (n - 1 - i) | i <- [0 .. n - 1] ]------ Now we are ready to use 'tabulateFix':------ >>> ch = tabulateFix catalanF :: VChimera Integer--- >>> index ch 9--- 4862--- >>> take 10 (toList ch)--- [1,1,2,5,14,42,132,429,1430,4862]------ __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 .))---- | Fully memoizing version of 'tabulateFix'.--- This function will tabulate every recursive call,--- but might allocate a lot of memory in doing so.--- For example, the following piece of code calculates the--- highest number reached by the--- <https://en.wikipedia.org/wiki/Collatz_conjecture#Statement_of_the_problem Collatz sequence>--- of a given number, but also allocates tens of gigabytes of memory,--- because the Collatz sequence will spike to very high numbers.------ >>> collatzF :: (Word -> Word) -> (Word -> Word)--- >>> collatzF _ 0 = 0--- >>> collatzF f n = if n <= 2 then 4 else n `max` f (if even n then n `quot` 2 else 3 * n + 1)--- >>>--- >>> maximumBy (comparing $ index $ tabulateFix' collatzF) [0..1000000]--- ...------ Using 'memoizeFix' instead fixes the problem:------ >>> 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 .))---- | Monadic version of 'tabulateFix'.--- 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-  :: (Monad m, G.Vector v a)-  => ((Word -> m a) -> Word -> m a)-  -> m (Chimera v a)-tabulateFixM = tabulateFixM_ Downwards--{-# 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)-  => ((Word -> m a) -> Word -> m a)-  -> m (Chimera v a)-tabulateFixM' = tabulateFixM_ Full--{-# 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''.-tabulateFixM_-  :: forall m v a.-     (Monad m, G.Vector v a)-  => Strategy-  -> ((Word -> m a) -> Word -> m a)-  -> m (Chimera v a)-tabulateFixM_ strat f = result-  where-    result :: m (Chimera v a)-    result = Chimera <$> generateArrayM (bits + 1) tabulateSubVector--    tabulateSubVector :: Int -> m (v a)-    tabulateSubVector 0 = G.singleton <$> case strat of-      Downwards -> fix f 0-      Full      -> f (\k -> flip index k <$> result) 0-    tabulateSubVector i = subResult-      where-        subResult      = G.generateM ii (\j -> f fixF (int2word (ii + j)))-        subResultBoxed = V.generateM ii (\j -> f fixF (int2word (ii + j)))-        ii = 1 `unsafeShiftL` (i - 1)--        fixF :: Word -> m a-        fixF k-          | k < int2word ii-          = flip index k <$> result-          | k <= int2word ii `shiftL` 1 - 1-          = (`V.unsafeIndex` (word2int k - ii)) <$> subResultBoxed-          | otherwise-          = case strat of-              Downwards -> f fixF k-              Full      -> flip index k <$> result---- | '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'.------ @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 <- iterateListNM bits go (G.singleton nextSeed)-  pure $ Chimera $ A.fromListN (bits + 1) (z : zs)-  where-    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 `A.indexArray` (bits - lz))-  `G.unsafeIndex`-  word2int (i .&. complement ((1 `shiftL` (bits - 1)) `unsafeShiftR` lz))-  where-    lz :: Int-    !lz = countLeadingZeros i-{-# INLINE index #-}---- | Convert a stream to an infinite list.------ >>> 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--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"-  _ -> tabulate (G.unsafeIndex vec . word2int . (`rem` l))-  where-    l = int2word $ G.length vec---- | Memoize a function:--- repeating calls to 'memoize' @f@ @n@--- would compute @f@ @n@ only once--- and cache the result in 'VChimera'.--- This is just a shortcut for 'index' '.' 'tabulate'.--- When @a@ is 'U.Unbox', it is faster to use--- '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---- | For a given @f@ memoize a recursive function 'fix' @f@,--- caching results in 'VChimera'.--- This is just a shortcut for 'index' '.' 'tabulateFix'.--- When @a@ is 'U.Unbox', it is faster to use--- 'index' ('tabulateFix' @f@ :: 'UChimera' @a@).------ prop> memoizeFix f n = fix f n------ For example, imagine that we want to memoize--- <https://en.wikipedia.org/wiki/Fibonacci_number Fibonacci numbers>:------ >>> fibo n = if n < 2 then toInteger n else fibo (n - 1) + fibo (n - 2)------ Can we find @fiboF@ such that @fibo@ = 'fix' @fiboF@?--- Just replace all recursive calls to @fibo@ with @f@:------ >>> fiboF f n = if n < 2 then toInteger n else f (n - 1) + f (n - 2)------ Now we are ready to use 'memoizeFix':------ >>> memoizeFix fiboF 10--- 55--- >>> memoizeFix fiboF 100--- 354224848179261915075------ This function can be used even when arguments--- of recursive calls are not strictly decreasing,--- but they might not get memoized. If this is not desired--- use 'tabulateFix'' instead.--- For example, here is a routine to measure the length of--- <https://oeis.org/A006577 Collatz sequence>:------ >>> 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 = 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.------ @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-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,206 +0,0 @@--- |--- Module:      Data.Chimera.ContinuousMapping--- Copyright:   (c) 2017 Andrew Lelechenko--- Licence:     MIT--- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>------ Helpers for continuous mappings, useful to memoize--- functions on 'Int' (instead of 'Word' only) and--- functions over two and three arguments.------ __Example 1__------ Imagine writing a program to simulate--- <https://en.wikipedia.org/wiki/Rule_90 Rule 90>.--- This is a cellular automaton,--- which consists of an infinite one-dimensional line of cells,--- each being either dead ('False') or alive ('True').--- If two neighbours of a cell are equal,--- it becomes dead on the next step, otherwise alive.------ Usually cellular automata are modelled by a finite vector.--- This is a bit suboptimal, because cellular automata--- may grow in different directions over time, but with--- a finite vector one has to define a bounding segment well beforehand.--- Moreover, what if we are interested to explore--- an evolution of an essentially infinite initial configuration?------ It would be natural to encode an initial configuration--- as a function 'Int' @->@ 'Bool', which takes a coordinate--- and returns the status of the corresponding cell. Define--- a function, which translates the automaton to the next step:------ > step :: (Int -> Bool) -> (Int -> Bool)--- > step current = \n -> current (n - 1) /= current (n + 1)------ Unfortunately, iterating @step@ would be extremely slow--- because of branching recursion. One--- could suggest to introduce a caching layer:------ > step :: (Int -> Bool) -> (Int -> Bool)--- > step current = \n -> current' (n - 1) /= current' (n + 1)--- >   where--- >     current' = memoize (current . fromIntegral) . fromIntegral------ Unfortunately, it would not work well,--- because 'fromIntegral' @::@ 'Int' @->@ 'Word'--- maps @-1@ to 'maxBound' and it would take ages to memoize--- everything up to 'maxBound'.--- But continuous mappings 'intToWord' and 'wordToInt' avoid this issue:------ > step :: (Int -> Bool) -> (Int -> Bool)--- > step current = \n -> current' (n - 1) /= current' (n + 1)--- >   where--- >     current' = memoize (current . wordToInt) . intToWord------ __Example 2__------ What about another famous cellular automaton:--- <https://en.wikipedia.org/wiki/Conway%27s_Game_of_Life Conway's Game of Life>?--- It is two-dimensional, so its state can be represented as--- a function 'Int' @->@ 'Int' @->@ 'Bool'. Following the approach above,--- we would like to memoize such functions.--- Namely, cast the state to 'Word' @->@ 'Bool', ready for memoization:------ > cast :: (Int -> Int -> Bool) -> (Word -> Bool)--- > cast f = \n -> let (x, y) = fromZCurve n in--- >  f (wordToInt x) (wordToInt y)------ and then back:------ > uncast :: (Word -> Bool) -> (Int -> Int -> Bool)--- > uncast g = \x y -> g (toZCurve (intToWord x) (intToWord y))-----module Data.Chimera.ContinuousMapping-  ( intToWord-  , wordToInt-  , toZCurve-  , fromZCurve-  , toZCurve3-  , fromZCurve3-  ) where--import Data.Bits-import Data.Chimera.FromIntegral-import Data.Word---- | Total map, which satisfies------ prop> abs (intToWord x - intToWord y) <= 2 * abs (x - y)------ Note that usual 'fromIntegral' @::@ 'Int' @->@ 'Word' does not--- satisfy this inequality,--- because it has a discontinuity between −1 and 0.------ >>> 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 = (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 = 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>.------ Only lower halfs of bits of arguments are used (32 bits on 64-bit architecture).------ >>> [ 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---- | Inverse for 'toZCurve'.--- See <https://en.wikipedia.org/wiki/Z-order_curve Z-order curve>.------ >>> 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))---- | Total map from space to line, continuous almost everywhere.--- See <https://en.wikipedia.org/wiki/Z-order_curve Z-order curve>.------ Only lower thirds of bits of arguments are used (21 bits on 64-bit architecture).------ >>> [ 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---- | Inverse for 'toZCurve3'.--- See <https://en.wikipedia.org/wiki/Z-order_curve Z-order curve>.------ >>> map fromZCurve3 [0..63]--- [(0,0,0),(1,0,0),(0,1,0),(1,1,0),(0,0,1),(1,0,1),(0,1,1),(1,1,1),(2,0,0),(3,0,0),(2,1,0),(3,1,0),(2,0,1),(3,0,1),(2,1,1),(3,1,1),---  (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 = fromIntegral (x5 :: Word64)-  where-    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-    x4 = (x3 `xor` (x3 `shiftL`  2)) .&. 0x3333333333333333-    x5 = (x4 `xor` (x4 `shiftL`  1)) .&. 0x5555555555555555---- Inspired by https://fgiesen.wordpress.com/2009/12/13/decoding-morton-codes/-part1by2 :: Word -> Word-part1by2 x = fromIntegral (x5 :: Word64)-  where-    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-    x4 = (x3 `xor` (x3 `shiftL`  4)) .&. 0x30c30c30c30c30c3-    x5 = (x4 `xor` (x4 `shiftL`  2)) .&. 0x1249249249249249---- Inspired by https://fgiesen.wordpress.com/2009/12/13/decoding-morton-codes/-compact1by1 :: Word -> Word-compact1by1 x = fromIntegral (x5 :: Word64)-  where-    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-    x4 = (x3 `xor` (x3 `shiftR`  8)) .&. 0x0000ffff0000ffff-    x5 = (x4 `xor` (x4 `shiftR` 16)) .&. 0x00000000ffffffff---- Inspired by https://fgiesen.wordpress.com/2009/12/13/decoding-morton-codes/-compact1by2 :: Word -> Word-compact1by2 x = fromIntegral (x5 :: Word64)-  where-    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-    x4 = (x3 `xor` (x3 `shiftR` 16)) .&. 0xffff00000000ffff-    x5 = (x4 `xor` (x4 `shiftR` 32)) .&. 0x00000000ffffffff

@@ -1,19 +0,0 @@--- |--- Module:      Data.Chimera.FromIntegral--- Copyright:   (c) 2018 Andrew Lelechenko--- Licence:     MIT--- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>--{-# OPTIONS_GHC -fno-warn-unused-imports #-}-{-# OPTIONS_HADDOCK hide #-}--module Data.Chimera.FromIntegral-  ( word2int-  , int2word-  ) where--word2int :: Word -> Int-word2int = fromIntegral--int2word :: Int -> Word-int2word = fromIntegral

@@ -1,233 +0,0 @@--- |--- Module:      Data.Chimera.WheelMapping--- Copyright:   (c) 2017 Andrew Lelechenko--- Licence:     MIT--- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>------ Helpers for mapping to <http://mathworld.wolfram.com/RoughNumber.html rough numbers>--- and back. This has various applications in number theory.------ __Example__------ Let @isPrime@ be an expensive predicate,--- which checks whether its argument is a prime number.--- We can memoize it as usual:------ > isPrimeCache1 :: UChimera Bool--- > isPrimeCache1 = tabulate isPrime--- >--- > isPrime1 :: Word -> Bool--- > isPrime1 = index isPrimeCache1------ But one may argue that since the only even prime number is 2,--- it is quite wasteful to cache @isPrime@ for even arguments.--- So we can save half the space by memoizing it for odd--- numbers only:------ > isPrimeCache2 :: UChimera Bool--- > isPrimeCache2 = tabulate (isPrime . (\n -> 2 * n + 1))--- >--- > isPrime2 :: Word -> Bool--- > isPrime2 n--- >   | n == 2    = True--- >   | even n    = False--- >   | otherwise = index isPrimeCache2 ((n - 1) `quot` 2)------ Here @\\n -> 2 * n + 1@ maps n to the (n+1)-th odd number,--- and @\\n -> (n - 1) \`quot\` 2@ takes it back. These functions--- are available below as 'fromWheel2' and 'toWheel2'.------ Odd numbers are the simplest example of numbers, lacking--- small prime factors (so called--- <http://mathworld.wolfram.com/RoughNumber.html rough numbers>).--- Removing numbers, having small prime factors, is sometimes--- called <https://en.wikipedia.org/wiki/Wheel_factorization wheel sieving>.------ One can go further and exclude not only even numbers,--- but also integers, divisible by 3.--- To do this we need a function which maps n to the (n+1)-th number coprime with 2 and 3--- (thus, with 6) and its inverse: namely, 'fromWheel6' and 'toWheel6'. Then write------ > isPrimeCache6 :: UChimera Bool--- > isPrimeCache6 = tabulate (isPrime . fromWheel6)--- >--- > isPrime6 :: Word -> Bool--- > isPrime6 n--- >   | n `elem` [2, 3] = True--- >   | n `gcd` 6 /= 1  = False--- >   | otherwise       = index isPrimeCache6 (toWheel6 n)------ Thus, the wheel of 6 saves more space, improving memory locality.------ (If you need to reduce memory consumption even further,--- consider using 'Data.Bit.Bit' wrapper,--- which provides an instance of unboxed vector,--- packing one boolean per bit instead of one boolean per byte for 'Bool')-----{-# LANGUAGE BangPatterns  #-}-{-# LANGUAGE CPP           #-}-{-# LANGUAGE MagicHash     #-}-{-# LANGUAGE UnboxedTuples #-}--module Data.Chimera.WheelMapping-  ( fromWheel2-  , toWheel2-  , fromWheel6-  , toWheel6-  , fromWheel30-  , toWheel30-  , fromWheel210-  , toWheel210-  ) where--import Data.Bits-import GHC.Exts--bits :: Int-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 #-}---- | 'fromWheel2' n is the (n+1)-th positive odd number.--- Sequence <https://oeis.org/A005408 A005408>.------ prop> map fromWheel2 [0..] == [ n | n <- [0..], n `gcd` 2 == 1 ]------ >>> 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 #-}---- | 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-  _  -> i `quot` 3-  where-    m# = 12297829382473034411## -- (2^65+1) / 3-    !(# z1#, _ #) = timesWord2# m# i#--{-# INLINE toWheel6 #-}---- | 'fromWheel6' n is the (n+1)-th positive number, not divisible by 2 or 3.--- Sequence <https://oeis.org/A007310 A007310>.------ prop> map fromWheel6 [0..] == [ n | n <- [0..], n `gcd` 6 == 1 ]------ >>> 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 #-}---- | 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-    (q, r) = case bits of-      64 -> (q64, r64)-      _  -> i `quotRem` 30--    m# = 9838263505978427529## -- (2^67+7) / 15-    !(# z1#, _ #) = timesWord2# m# i#-    q64 = W# z1# `shiftR` 4-    r64 = i - q64 `shiftL` 5 + q64 `shiftL` 1--{-# INLINE toWheel30 #-}---- | 'fromWheel30' n is the (n+1)-th positive number, not divisible by 2, 3 or 5.--- Sequence <https://oeis.org/A007775 A007775>.------ prop> map fromWheel30 [0..] == [ n | n <- [0..], n `gcd` 30 == 1 ]------ >>> 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)-{-# INLINE fromWheel30 #-}---- | 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-    !(q, W# r#) = case bits of-      64 -> (q64, r64)-      _  -> i `quotRem` 210--    m# = 5621864860559101445## -- (2^69+13) / 105-    !(# z1#, _ #) = timesWord2# m# i#-    q64 = W# z1# `shiftR` 6-    r64 = i - q64 * 210--    tableEl# =-#if MIN_VERSION_base(4,16,0)-      word8ToWord#-#endif-      (indexWord8OffAddr# table# (word2Int# r#))--    table# :: Addr#-    table# = "\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\SOH\SOH\STX\STX\STX\STX\ETX\ETX\EOT\EOT\EOT\EOT\ENQ\ENQ\ENQ\ENQ\ENQ\ENQ\ACK\ACK\a\a\a\a\a\a\b\b\b\b\t\t\n\n\n\n\v\v\v\v\v\v\f\f\f\f\f\f\r\r\SO\SO\SO\SO\SO\SO\SI\SI\SI\SI\DLE\DLE\DC1\DC1\DC1\DC1\DC1\DC1\DC2\DC2\DC2\DC2\DC3\DC3\DC3\DC3\DC3\DC3\DC4\DC4\DC4\DC4\DC4\DC4\DC4\DC4\NAK\NAK\NAK\NAK\SYN\SYN\ETB\ETB\ETB\ETB\CAN\CAN\EM\EM\EM\EM\SUB\SUB\SUB\SUB\SUB\SUB\SUB\SUB\ESC\ESC\ESC\ESC\ESC\ESC\FS\FS\FS\FS\GS\GS\GS\GS\GS\GS\RS\RS\US\US\US\US      !!\"\"\"\"\"\"######$$$$%%&&&&''''''(())))))****++,,,,--........../"#-    -- map Data.Char.chr [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 2, 2, 2, 2, 3, 3, 4, 4, 4, 4, 5, 5, 5, 5, 5, 5, 6, 6, 7, 7, 7, 7, 7, 7, 8, 8, 8, 8, 9, 9, 10, 10, 10, 10, 11, 11, 11, 11, 11, 11, 12, 12, 12, 12, 12, 12, 13, 13, 14, 14, 14, 14, 14, 14, 15, 15, 15, 15, 16, 16, 17, 17, 17, 17, 17, 17, 18, 18, 18, 18, 19, 19, 19, 19, 19, 19, 20, 20, 20, 20, 20, 20, 20, 20, 21, 21, 21, 21, 22, 22, 23, 23, 23, 23, 24, 24, 25, 25, 25, 25, 26, 26, 26, 26, 26, 26, 26, 26, 27, 27, 27, 27, 27, 27, 28, 28, 28, 28, 29, 29, 29, 29, 29, 29, 30, 30, 31, 31, 31, 31, 32, 32, 32, 32, 32, 32, 33, 33, 34, 34, 34, 34, 34, 34, 35, 35, 35, 35, 35, 35, 36, 36, 36, 36, 37, 37, 38, 38, 38, 38, 39, 39, 39, 39, 39, 39, 40, 40, 41, 41, 41, 41, 41, 41, 42, 42, 42, 42, 43, 43, 44, 44, 44, 44, 45, 45, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 47]--{-# INLINE toWheel210 #-}---- | 'fromWheel210' n is the (n+1)-th positive number, not divisible by 2, 3, 5 or 7.--- Sequence <https://oeis.org/A008364 A008364>.------ prop> map fromWheel210 [0..] == [ n | n <- [0..], n `gcd` 210 == 1 ]------ >>> 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-    !(q, W# r#) = case bits of-      64 -> (q64, r64)-      _  -> i `quotRem` 48--    m# = 12297829382473034411## -- (2^65+1) / 3-    !(# z1#, _ #) = timesWord2# m# i#-    q64 = W# z1# `shiftR` 5-    r64 = i - q64 `shiftL` 5 - q64 `shiftL` 4--    tableEl# =-#if MIN_VERSION_base(4,16,0)-      word8ToWord#-#endif-      (indexWord8OffAddr# table# (word2Int# r#))--    table# :: Addr#-    table# = "\SOH\v\r\DC1\DC3\ETB\GS\US%)+/5;=CGIOSYaegkmqy\DEL\131\137\139\143\149\151\157\163\167\169\173\179\181\187\191\193\197\199\209"#-    -- map Data.Char.chr [1, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, 53, 59, 61, 67, 71, 73, 79, 83, 89, 97, 101, 103, 107, 109, 113, 121, 127, 131, 137, 139, 143, 149, 151, 157, 163, 167, 169, 173, 179, 181, 187, 191, 193, 197, 199, 209]--{-# INLINE fromWheel210 #-}

@@ -30,7 +30,8 @@  addCompare :: ([String] -> Benchmark -> Benchmark) addCompare (size : name : path)-  | name /= "Chimera" = bcompare (printAwkExpr (locateBenchmark (size : chimeraBenchName : path)))+  | name /= chimeraBenchName+  = bcompare (printAwkExpr (locateBenchmark (size : chimeraBenchName : path))) addCompare _ = id  randomChimera :: UChimera Int

@@ -0,0 +1,9 @@+#include <stdint.h>++uint64_t umulh(uint64_t x, uint64_t y) {+  return ((unsigned __int128)x * y) >> 64;+}++uint64_t umodh(uint64_t lo, uint64_t hi, uint64_t m) {+  return (((unsigned __int128)hi << 64) + lo) % m;+}

@@ -0,0 +1,5 @@+#include <stdint.h>++uint64_t umulh(uint64_t x, uint64_t y);++uint64_t umodh(uint64_t lo, uint64_t hi, uint64_t m);

@@ -1,3 +1,8 @@+# 0.3.4.0++* Add `foldr` catamorphism and `fromInfinite` / `toInfinite` conversions.+* Add `iterateWithIndex` and `iterateWithIndexM`.+ # 0.3.3.0  * Add `fromListWithDef`, `fromVectorWithDef`, `interleave`.

@@ -1,92 +1,116 @@-name: chimera-version: 0.3.3.0-cabal-version: 2.0-build-type: Simple-license: BSD3-license-file: LICENSE-copyright: 2017-2019 Bodigrim-maintainer: andrew.lelechenko@gmail.com-homepage: https://github.com/Bodigrim/chimera#readme-category: Data-synopsis: Lazy infinite streams with O(1) indexing and applications for memoization-author: Bodigrim-extra-source-files:-  README.md-  changelog.md-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+cabal-version:      2.0+name:               chimera+version:            0.3.4.0+license:            BSD3+license-file:       LICENSE+copyright:          2017-2019 Bodigrim+maintainer:         andrew.lelechenko@gmail.com+author:             Bodigrim+tested-with:+    ghc ==9.8.1 ghc ==9.6.3 ghc ==9.4.7 ghc ==9.2.8 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++homepage:           https://github.com/Bodigrim/chimera#readme+synopsis:+    Lazy infinite streams with O(1) indexing and applications for memoization+ description:-  There are plenty of memoizing libraries on Hackage, but they-  usually fall into two categories:-  .-  * Store cache as a flat array, enabling us+    There are plenty of memoizing libraries on Hackage, but they+    usually fall into two categories:+    .+    * Store cache as a flat array, enabling us     to obtain cached values in O(1) time, which is nice.     The drawback is that one must specify the size     of the array beforehand,     limiting an interval of inputs,     and actually allocate it at once.-  * Store cache as a lazy binary tree.+    * Store cache as a lazy binary tree.     Thanks to laziness, one can freely use the full range of inputs.     The drawback is that obtaining values from a tree     takes logarithmic time and is unfriendly to CPU cache,     which kinda defeats the purpose.-  .-  This package intends to tackle both issues,-  providing a data type 'Chimera' for-  lazy infinite compact streams with cache-friendly O(1) indexing.-  .-  Additional features include:-  .-  * memoization of recursive functions and recurrent sequences,-  * memoization of functions of several, possibly signed arguments,-  * efficient memoization of boolean predicates.+    .+    This package intends to tackle both issues,+    providing a data type 'Chimera' for+    lazy infinite compact streams with cache-friendly O(1) indexing.+    .+    Additional features include:+    .+    * memoization of recursive functions and recurrent sequences,+    * memoization of functions of several, possibly signed arguments,+    * efficient memoization of boolean predicates. +category:           Data+build-type:         Simple+extra-source-files: cbits/aarch64.h+extra-doc-files:+    README.md+    changelog.md+ source-repository head-  type: git-  location: https://github.com/Bodigrim/chimera+    type:     git+    location: https://github.com/Bodigrim/chimera  flag representable-  description: Define Representable instance from adjunctions package-  default: True+    description: Define Representable instance from adjunctions package  library-  build-depends: base >=4.9 && <5, primitive, transformers, vector-  if flag(representable)-    build-depends: adjunctions, distributive, mtl-  exposed-modules:-    Data.Chimera-    Data.Chimera.ContinuousMapping-    Data.Chimera.WheelMapping-  other-modules:-    Data.Chimera.FromIntegral-  default-language: Haskell2010-  ghc-options: -Wall -Wcompat+    exposed-modules:+        Data.Chimera+        Data.Chimera.ContinuousMapping+        Data.Chimera.WheelMapping +    hs-source-dirs:   src+    other-modules:+        Data.Chimera.FromIntegral+        Data.Chimera.Compat++    default-language: Haskell2010+    ghc-options:      -Wall -Wcompat+    build-depends:+        base >=4.9 && <5,+        infinite-list <0.2,+        primitive <0.10,+        transformers <0.7,+        vector <0.14++    if arch(aarch64)+        c-sources:    cbits/aarch64.c+        include-dirs: cbits++    if flag(representable)+        build-depends:+            adjunctions <4.5,+            distributive <0.7,+            mtl <2.4+ test-suite chimera-test-  build-depends:-    base >=4.5 && <5,-    chimera,-    QuickCheck >=2.10,-    tasty,-    tasty-hunit,-    tasty-quickcheck,-    tasty-smallcheck,-    vector-  type: exitcode-stdio-1.0-  main-is: Test.hs-  default-language: Haskell2010-  hs-source-dirs: test-  ghc-options: -Wall -Wcompat+    type:             exitcode-stdio-1.0+    main-is:          Test.hs+    hs-source-dirs:   test+    default-language: Haskell2010+    ghc-options:      -Wall -Wcompat+    build-depends:+        base >=4.5 && <5,+        chimera,+        QuickCheck >=2.10 && <2.15,+        tasty <1.6,+        tasty-hunit <0.11,+        tasty-quickcheck <0.11,+        tasty-smallcheck <0.9,+        vector  benchmark chimera-bench-  build-depends:-    base,-    chimera,-    mtl,-    random,-    tasty >= 1.4.2,-    tasty-bench >= 0.3.2-  type: exitcode-stdio-1.0-  main-is: Bench.hs-  default-language: Haskell2010-  hs-source-dirs: bench-  ghc-options: -Wall -Wcompat+    type:             exitcode-stdio-1.0+    main-is:          Bench.hs+    hs-source-dirs:   bench+    default-language: Haskell2010+    ghc-options:      -Wall -Wcompat+    build-depends:+        base,+        chimera,+        mtl,+        random <1.3,+        tasty >=1.4.2,+        tasty-bench >=0.3.2 && <0.4

@@ -0,0 +1,795 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}++-- |+-- Module:      Data.Chimera+-- Copyright:   (c) 2018-2019 Andrew Lelechenko+-- Licence:     BSD3+-- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>+--+-- Lazy infinite streams with O(1) indexing.+module Data.Chimera (+  -- * Memoization+  memoize,+  memoizeFix,++  -- * Chimera+  Chimera,+  VChimera,+  UChimera,++  -- * Construction+  tabulate,+  tabulateFix,+  tabulateFix',+  iterate,+  iterateWithIndex,+  unfoldr,+  cycle,+  fromListWithDef,+  fromVectorWithDef,+  fromInfinite,++  -- * Manipulation+  interleave,++  -- * Elimination+  index,+  foldr,+  toList,+  toInfinite,++  -- * Monadic construction+  -- $monadic+  tabulateM,+  tabulateFixM,+  tabulateFixM',+  iterateM,+  iterateWithIndexM,+  unfoldrM,++  -- * Subvectors+  -- $subvectors+  mapSubvectors,+  traverseSubvectors,+  zipWithSubvectors,+  zipWithMSubvectors,+  sliceSubvectors,+) where++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 Data.List.Infinite (Infinite (..))+import qualified Data.List.Infinite as Inf+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+import GHC.Exts (fromListN)+import Prelude hiding (Applicative (..), and, cycle, div, drop, foldr, fromIntegral, iterate, not, or, (*), (^))++#ifdef MIN_VERSION_mtl+import Control.Monad.Reader (MonadReader, ask, local)+#endif+#ifdef MIN_VERSION_distributive+import Data.Distributive+#ifdef MIN_VERSION_adjunctions+import qualified Data.Functor.Rep as Rep+#endif+#endif++import Data.Chimera.FromIntegral++-- $monadic+-- Be careful: the stream is infinite, so+-- monadic effects must be lazy+-- in order to be executed in a finite time.+--+-- For instance, lazy state monad works fine:+--+-- >>> import Control.Monad.State.Lazy+-- >>> ch = evalState (tabulateM (\i -> do modify (+ i); get)) 0 :: UChimera Word+-- >>> take 10 (toList ch)+-- [0,1,3,6,10,15,21,28,36,45]+--+-- But the same computation in the strict state+-- monad "Control.Monad.State.Strict" diverges.++-- $subvectors+-- Internally 'Chimera' consists of a number of subvectors.+-- Following functions provide a low-level access to them.+-- This ability is especially important for streams of booleans.+--+-- Let us use 'Chimera' to memoize predicates @f1@, @f2@ @::@ 'Word' @->@ 'Bool'.+-- Imagine them both already+-- caught in amber as @ch1@, @ch2@ @::@ 'UChimera' 'Bool',+-- and now we want to memoize @f3 x = f1 x && f2 x@ as @ch3@.+-- One can do it in as follows:+--+-- > ch3 = tabulate (\i -> index ch1 i && index ch2 i)+--+-- There are two unsatisfactory things here. Firstly,+-- even unboxed vectors store only one boolean per byte.+-- We would rather reach out for 'Data.Bit.Bit' wrapper,+-- which provides an instance of unboxed vector+-- with one boolean per bit. Secondly, combining+-- existing predicates by indexing them and tabulating again+-- becomes relatively expensive, given how small and simple+-- our data is. Fortunately, there is an ultra-fast 'Data.Bit.zipBits'+-- to zip bit vectors. We can combine it altogether like this:+--+-- > import Data.Bit+-- > import Data.Bits+-- > ch1 = tabulate (Bit . f1)+-- > ch2 = tabulate (Bit . f2)+-- > 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.+--+-- @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 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 = 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 = 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+  index = index+#endif+#endif++bits :: Int+bits = finiteBitSize (0 :: Word)++-- | Create a stream of values of a given function.+-- Once created it can be accessed via 'index' or 'toList'.+--+-- >>> ch = tabulate (^ 2) :: UChimera Word+-- >>> index ch 9+-- 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+  :: (Monad m, G.Vector v a)+  => (Word -> m a)+  -> m (Chimera v a)+tabulateM f = Chimera <$> generateArrayM (bits + 1) tabulateSubVector+  where+    tabulateSubVector 0 = G.singleton <$> f 0+    tabulateSubVector i = G.generateM ii (\j -> f (int2word (ii + j)))+      where+        ii = 1 `unsafeShiftL` (i - 1)+{-# SPECIALIZE tabulateM :: G.Vector v a => (Word -> Identity a) -> Identity (Chimera v a) #-}++-- | For a given @f@ create a stream of values of a recursive function 'fix' @f@.+-- Once created it can be accessed via 'index' or 'toList'.+--+-- For example, imagine that we want to tabulate+-- <https://en.wikipedia.org/wiki/Catalan_number Catalan numbers>:+--+-- >>> catalan n = if n == 0 then 1 else sum [ catalan i * catalan (n - 1 - i) | i <- [0 .. n - 1] ]+--+-- Can we find @catalanF@ such that @catalan@ = 'fix' @catalanF@?+-- Just replace all recursive calls to @catalan@ with @f@:+--+-- >>> catalanF f n = if n == 0 then 1 else sum [ f i * f (n - 1 - i) | i <- [0 .. n - 1] ]+--+-- Now we are ready to use 'tabulateFix':+--+-- >>> ch = tabulateFix catalanF :: VChimera Integer+-- >>> index ch 9+-- 4862+-- >>> take 10 (toList ch)+-- [1,1,2,5,14,42,132,429,1430,4862]+--+-- __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 .))++-- | Fully memoizing version of 'tabulateFix'.+-- This function will tabulate every recursive call,+-- but might allocate a lot of memory in doing so.+-- For example, the following piece of code calculates the+-- highest number reached by the+-- <https://en.wikipedia.org/wiki/Collatz_conjecture#Statement_of_the_problem Collatz sequence>+-- of a given number, but also allocates tens of gigabytes of memory,+-- because the Collatz sequence will spike to very high numbers.+--+-- >>> collatzF :: (Word -> Word) -> (Word -> Word)+-- >>> collatzF _ 0 = 0+-- >>> collatzF f n = if n <= 2 then 4 else n `max` f (if even n then n `quot` 2 else 3 * n + 1)+-- >>>+-- >>> maximumBy (comparing $ index $ tabulateFix' collatzF) [0..1000000]+-- ...+--+-- Using 'memoizeFix' instead fixes the problem:+--+-- >>> 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 .))++-- | Monadic version of 'tabulateFix'.+-- 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+  :: (Monad m, G.Vector v a)+  => ((Word -> m a) -> Word -> m a)+  -> m (Chimera v a)+tabulateFixM = tabulateFixM_ Downwards+{-# 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)+  => ((Word -> m a) -> Word -> m a)+  -> m (Chimera v a)+tabulateFixM' = tabulateFixM_ Full+{-# 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''.+tabulateFixM_+  :: forall m v a+   . (Monad m, G.Vector v a)+  => Strategy+  -> ((Word -> m a) -> Word -> m a)+  -> m (Chimera v a)+tabulateFixM_ strat f = result+  where+    result :: m (Chimera v a)+    result = Chimera <$> generateArrayM (bits + 1) tabulateSubVector++    tabulateSubVector :: Int -> m (v a)+    tabulateSubVector 0 =+      G.singleton <$> case strat of+        Downwards -> fix f 0+        Full -> f (\k -> flip index k <$> result) 0+    tabulateSubVector i = subResult+      where+        subResult = G.generateM ii (\j -> f fixF (int2word (ii + j)))+        subResultBoxed = V.generateM ii (\j -> f fixF (int2word (ii + j)))+        ii = 1 `unsafeShiftL` (i - 1)++        fixF :: Word -> m a+        fixF k+          | k < int2word ii =+              flip index k <$> result+          | k <= int2word ii `shiftL` 1 - 1 =+              (`V.unsafeIndex` (word2int k - ii)) <$> subResultBoxed+          | otherwise =+              case strat of+                Downwards -> f fixF k+                Full -> flip index k <$> result++-- | 'iterate' @f@ @x@ returns an infinite stream, generated by+-- repeated applications of @f@ to @x@.+--+-- It holds that 'index' ('iterate' @f@ @x@) 0 is equal 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'.+--+-- @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 <- iterateListNM bits go (G.singleton nextSeed)+  pure $ Chimera $ fromListN (bits + 1) (z : zs)+  where+    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 $ fromListN (bits + 1) (z : zs)+{-# SPECIALIZE unfoldrM :: G.Vector v b => (a -> Identity (b, a)) -> a -> Identity (Chimera v b) #-}++-- | 'iterateWithIndex' @f@ @x@ returns an infinite stream, generated by+-- applications of @f@ to a current index and previous value, starting from @x@.+--+-- It holds that 'index' ('iterateWithIndex' @f@ @x@) 0 is equal to @x@.+--+-- >>> ch = iterateWithIndex (+) 100 :: UChimera Word+-- >>> take 10 (toList ch)+-- [100,101,103,106,110,115,121,128,136,145]+--+-- @since 0.3.4.0+iterateWithIndex :: G.Vector v a => (Word -> a -> a) -> a -> Chimera v a+iterateWithIndex f = runIdentity . iterateWithIndexM ((pure .) . f)++iterateWithIndexExactVecNM :: forall m a v. (Monad m, G.Vector v a) => Int -> (Word -> a -> m a) -> a -> m (v a)+iterateWithIndexExactVecNM n f s = G.unfoldrExactNM n go (int2word n, s)+  where+    go :: (Word, a) -> m (a, (Word, a))+    go (i, x) = do+      x' <- f i x+      pure (x', (i + 1, x'))++-- | Monadic version of 'iterateWithIndex'.+--+-- @since 0.3.4.0+iterateWithIndexM :: (Monad m, G.Vector v a) => (Word -> a -> m a) -> a -> m (Chimera v a)+iterateWithIndexM f seed = do+  nextSeed <- f 1 seed+  let z = G.singleton seed+  zs <- iterateListNM bits go (G.singleton nextSeed)+  pure $ Chimera $ fromListN (bits + 1) (z : zs)+  where+    go vec =+      iterateWithIndexExactVecNM (G.length vec `shiftL` 1) f (G.unsafeLast vec)+{-# SPECIALIZE iterateWithIndexM :: G.Vector v a => (Word -> a -> Identity a) -> a -> Identity (Chimera v a) #-}++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 `A.indexArray` (bits - lz))+    `G.unsafeIndex` word2int (i .&. complement ((1 `shiftL` (bits - 1)) `unsafeShiftR` lz))+  where+    lz :: Int+    !lz = countLeadingZeros i+{-# INLINE index #-}++-- | Convert a stream to an infinite list.+--+-- >>> 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++-- | Convert a stream to a proper infinite list.+--+-- @since 0.3.4.0+toInfinite :: G.Vector v a => Chimera v a -> Infinite a+toInfinite = foldr (:<)++-- | Right-associative fold, necessarily lazy in the accumulator.+-- Any unconditional attempt to force the accumulator even to WHNF+-- will hang the computation. E. g., the following definition isn't productive:+--+-- > import Data.List.NonEmpty (NonEmpty(..))+-- > toNonEmpty = foldr (\a (x :| xs) -> a :| x : xs) :: VChimera a -> NonEmpty a+--+-- One should use lazy patterns, e. g.,+--+-- > toNonEmpty = foldr (\a ~(x :| xs) -> a :| x : xs)+foldr :: G.Vector v a => (a -> b -> b) -> Chimera v a -> b+foldr f (Chimera vs) = F.foldr (flip $ G.foldr f) undefined vs++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 . 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 infinite list.+--+-- @since 0.3.4.0+fromInfinite+  :: G.Vector v a+  => Infinite a+  -> Chimera v a+fromInfinite = Chimera . fromListN (bits + 1) . go0+  where+    go0 (x :< xs) = G.singleton x : go 0 xs++    go k xs = G.fromListN kk ys : go (k + 1) zs+      where+        kk = 1 `shiftL` k+        (ys, zs) = Inf.splitAt kk xs++-- | 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 . 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"+  _ -> tabulate (G.unsafeIndex vec . word2int . (`rem` l))+  where+    l = int2word $ G.length vec++-- | Memoize a function:+-- repeating calls to 'memoize' @f@ @n@+-- would compute @f@ @n@ only once+-- and cache the result in 'VChimera'.+-- This is just a shortcut for 'index' '.' 'tabulate'.+-- When @a@ is 'U.Unbox', it is faster to use+-- '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++-- | For a given @f@ memoize a recursive function 'fix' @f@,+-- caching results in 'VChimera'.+-- This is just a shortcut for 'index' '.' 'tabulateFix'.+-- When @a@ is 'U.Unbox', it is faster to use+-- 'index' ('tabulateFix' @f@ :: 'UChimera' @a@).+--+-- prop> memoizeFix f n = fix f n+--+-- For example, imagine that we want to memoize+-- <https://en.wikipedia.org/wiki/Fibonacci_number Fibonacci numbers>:+--+-- >>> fibo n = if n < 2 then toInteger n else fibo (n - 1) + fibo (n - 2)+--+-- Can we find @fiboF@ such that @fibo@ = 'fix' @fiboF@?+-- Just replace all recursive calls to @fibo@ with @f@:+--+-- >>> fiboF f n = if n < 2 then toInteger n else f (n - 1) + f (n - 2)+--+-- Now we are ready to use 'memoizeFix':+--+-- >>> memoizeFix fiboF 10+-- 55+-- >>> memoizeFix fiboF 100+-- 354224848179261915075+--+-- This function can be used even when arguments+-- of recursive calls are not strictly decreasing,+-- but they might not get memoized. If this is not desired+-- use 'tabulateFix'' instead.+-- For example, here is a routine to measure the length of+-- <https://oeis.org/A006577 Collatz sequence>:+--+-- >>> 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 = 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) #-}++-- | Zip subvectors from two streams, using a given length-preserving function.+--+-- @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+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

@@ -0,0 +1,50 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CApiFFI #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE UnliftedFFITypes #-}++-- |+-- Module:      Data.Chimera.Compat+-- Copyright:   (c) 2023 Andrew Lelechenko+-- Licence:     BSD3+-- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>+--+-- See https://gitlab.haskell.org/ghc/ghc/-/issues/22933+-- and https://gitlab.haskell.org/ghc/ghc/-/issues/22966+module Data.Chimera.Compat (+  timesWord2#,+  remWord2#,+) where++#ifdef aarch64_HOST_ARCH+import GHC.Exts (Word(..), Word#, timesWord#)++timesWord2# :: Word# -> Word# -> (# Word#, Word# #)+timesWord2# x y = (# z, timesWord# x y #)+  where+    !(W# z) = c_umulh (W# x) (W# y)+{-# INLINE timesWord2# #-}++foreign import capi unsafe "aarch64.h umulh" c_umulh :: Word -> Word -> Word++remWord2# :: Word# -> Word# -> Word# -> Word#+remWord2# lo hi m = r+  where+    !(W# r) = c_umodh (W# lo) (W# hi) (W# m)+{-# INLINE remWord2# #-}++foreign import capi unsafe "aarch64.h umodh" c_umodh :: Word -> Word -> Word -> Word++#else++import GHC.Exts (Word#, timesWord2#, quotRemWord2#)++remWord2# :: Word# -> Word# -> Word# -> Word#+remWord2# lo hi m = r+  where+    !(# _, r #) = quotRemWord2# hi lo m+{-# INLINE remWord2# #-}++#endif

@@ -0,0 +1,204 @@+-- |+-- Module:      Data.Chimera.ContinuousMapping+-- Copyright:   (c) 2017 Andrew Lelechenko+-- Licence:     BSD3+-- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>+--+-- Helpers for continuous mappings, useful to memoize+-- functions on 'Int' (instead of 'Word' only) and+-- functions over two and three arguments.+--+-- __Example 1__+--+-- Imagine writing a program to simulate+-- <https://en.wikipedia.org/wiki/Rule_90 Rule 90>.+-- This is a cellular automaton,+-- which consists of an infinite one-dimensional line of cells,+-- each being either dead ('False') or alive ('True').+-- If two neighbours of a cell are equal,+-- it becomes dead on the next step, otherwise alive.+--+-- Usually cellular automata are modelled by a finite vector.+-- This is a bit suboptimal, because cellular automata+-- may grow in different directions over time, but with+-- a finite vector one has to define a bounding segment well beforehand.+-- Moreover, what if we are interested to explore+-- an evolution of an essentially infinite initial configuration?+--+-- It would be natural to encode an initial configuration+-- as a function 'Int' @->@ 'Bool', which takes a coordinate+-- and returns the status of the corresponding cell. Define+-- a function, which translates the automaton to the next step:+--+-- > step :: (Int -> Bool) -> (Int -> Bool)+-- > step current = \n -> current (n - 1) /= current (n + 1)+--+-- Unfortunately, iterating @step@ would be extremely slow+-- because of branching recursion. One+-- could suggest to introduce a caching layer:+--+-- > step :: (Int -> Bool) -> (Int -> Bool)+-- > step current = \n -> current' (n - 1) /= current' (n + 1)+-- >   where+-- >     current' = memoize (current . fromIntegral) . fromIntegral+--+-- Unfortunately, it would not work well,+-- because 'fromIntegral' @::@ 'Int' @->@ 'Word'+-- maps @-1@ to 'maxBound' and it would take ages to memoize+-- everything up to 'maxBound'.+-- But continuous mappings 'intToWord' and 'wordToInt' avoid this issue:+--+-- > step :: (Int -> Bool) -> (Int -> Bool)+-- > step current = \n -> current' (n - 1) /= current' (n + 1)+-- >   where+-- >     current' = memoize (current . wordToInt) . intToWord+--+-- __Example 2__+--+-- What about another famous cellular automaton:+-- <https://en.wikipedia.org/wiki/Conway%27s_Game_of_Life Conway's Game of Life>?+-- It is two-dimensional, so its state can be represented as+-- a function 'Int' @->@ 'Int' @->@ 'Bool'. Following the approach above,+-- we would like to memoize such functions.+-- Namely, cast the state to 'Word' @->@ 'Bool', ready for memoization:+--+-- > cast :: (Int -> Int -> Bool) -> (Word -> Bool)+-- > cast f = \n -> let (x, y) = fromZCurve n in+-- >  f (wordToInt x) (wordToInt y)+--+-- and then back:+--+-- > uncast :: (Word -> Bool) -> (Int -> Int -> Bool)+-- > uncast g = \x y -> g (toZCurve (intToWord x) (intToWord y))+module Data.Chimera.ContinuousMapping (+  intToWord,+  wordToInt,+  toZCurve,+  fromZCurve,+  toZCurve3,+  fromZCurve3,+) where++import Data.Bits+import Data.Chimera.FromIntegral+import Data.Word++-- | Total map, which satisfies+--+-- prop> abs (intToWord x - intToWord y) <= 2 * abs (x - y)+--+-- Note that usual 'fromIntegral' @::@ 'Int' @->@ 'Word' does not+-- satisfy this inequality,+-- because it has a discontinuity between −1 and 0.+--+-- >>> 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 = (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 = 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>.+--+-- Only lower halfs of bits of arguments are used (32 bits on 64-bit architecture).+--+-- >>> [ 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++-- | Inverse for 'toZCurve'.+-- See <https://en.wikipedia.org/wiki/Z-order_curve Z-order curve>.+--+-- >>> 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))++-- | Total map from space to line, continuous almost everywhere.+-- See <https://en.wikipedia.org/wiki/Z-order_curve Z-order curve>.+--+-- Only lower thirds of bits of arguments are used (21 bits on 64-bit architecture).+--+-- >>> [ 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++-- | Inverse for 'toZCurve3'.+-- See <https://en.wikipedia.org/wiki/Z-order_curve Z-order curve>.+--+-- >>> map fromZCurve3 [0..63]+-- [(0,0,0),(1,0,0),(0,1,0),(1,1,0),(0,0,1),(1,0,1),(0,1,1),(1,1,1),(2,0,0),(3,0,0),(2,1,0),(3,1,0),(2,0,1),(3,0,1),(2,1,1),(3,1,1),+--  (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 = fromIntegral (x5 :: Word64)+  where+    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+    x4 = (x3 `xor` (x3 `shiftL` 2)) .&. 0x3333333333333333+    x5 = (x4 `xor` (x4 `shiftL` 1)) .&. 0x5555555555555555++-- Inspired by https://fgiesen.wordpress.com/2009/12/13/decoding-morton-codes/+part1by2 :: Word -> Word+part1by2 x = fromIntegral (x5 :: Word64)+  where+    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+    x4 = (x3 `xor` (x3 `shiftL` 4)) .&. 0x30c30c30c30c30c3+    x5 = (x4 `xor` (x4 `shiftL` 2)) .&. 0x1249249249249249++-- Inspired by https://fgiesen.wordpress.com/2009/12/13/decoding-morton-codes/+compact1by1 :: Word -> Word+compact1by1 x = fromIntegral (x5 :: Word64)+  where+    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+    x4 = (x3 `xor` (x3 `shiftR` 8)) .&. 0x0000ffff0000ffff+    x5 = (x4 `xor` (x4 `shiftR` 16)) .&. 0x00000000ffffffff++-- Inspired by https://fgiesen.wordpress.com/2009/12/13/decoding-morton-codes/+compact1by2 :: Word -> Word+compact1by2 x = fromIntegral (x5 :: Word64)+  where+    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+    x4 = (x3 `xor` (x3 `shiftR` 16)) .&. 0xffff00000000ffff+    x5 = (x4 `xor` (x4 `shiftR` 32)) .&. 0x00000000ffffffff

@@ -0,0 +1,18 @@+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_HADDOCK hide #-}++-- |+-- Module:      Data.Chimera.FromIntegral+-- Copyright:   (c) 2018 Andrew Lelechenko+-- Licence:     BSD3+-- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>+module Data.Chimera.FromIntegral (+  word2int,+  int2word,+) where++word2int :: Word -> Int+word2int = fromIntegral++int2word :: Int -> Word+int2word = fromIntegral

@@ -0,0 +1,229 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnboxedTuples #-}+{-# OPTIONS_GHC -Wno-missing-signatures #-}++-- |+-- Module:      Data.Chimera.WheelMapping+-- Copyright:   (c) 2017 Andrew Lelechenko+-- Licence:     BSD3+-- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>+--+-- Helpers for mapping to <http://mathworld.wolfram.com/RoughNumber.html rough numbers>+-- and back. This has various applications in number theory.+--+-- __Example__+--+-- Let @isPrime@ be an expensive predicate,+-- which checks whether its argument is a prime number.+-- We can memoize it as usual:+--+-- > isPrimeCache1 :: UChimera Bool+-- > isPrimeCache1 = tabulate isPrime+-- >+-- > isPrime1 :: Word -> Bool+-- > isPrime1 = index isPrimeCache1+--+-- But one may argue that since the only even prime number is 2,+-- it is quite wasteful to cache @isPrime@ for even arguments.+-- So we can save half the space by memoizing it for odd+-- numbers only:+--+-- > isPrimeCache2 :: UChimera Bool+-- > isPrimeCache2 = tabulate (isPrime . (\n -> 2 * n + 1))+-- >+-- > isPrime2 :: Word -> Bool+-- > isPrime2 n+-- >   | n == 2    = True+-- >   | even n    = False+-- >   | otherwise = index isPrimeCache2 ((n - 1) `quot` 2)+--+-- Here @\\n -> 2 * n + 1@ maps n to the (n+1)-th odd number,+-- and @\\n -> (n - 1) \`quot\` 2@ takes it back. These functions+-- are available below as 'fromWheel2' and 'toWheel2'.+--+-- Odd numbers are the simplest example of numbers, lacking+-- small prime factors (so called+-- <http://mathworld.wolfram.com/RoughNumber.html rough numbers>).+-- Removing numbers, having small prime factors, is sometimes+-- called <https://en.wikipedia.org/wiki/Wheel_factorization wheel sieving>.+--+-- One can go further and exclude not only even numbers,+-- but also integers, divisible by 3.+-- To do this we need a function which maps n to the (n+1)-th number coprime with 2 and 3+-- (thus, with 6) and its inverse: namely, 'fromWheel6' and 'toWheel6'. Then write+--+-- > isPrimeCache6 :: UChimera Bool+-- > isPrimeCache6 = tabulate (isPrime . fromWheel6)+-- >+-- > isPrime6 :: Word -> Bool+-- > isPrime6 n+-- >   | n `elem` [2, 3] = True+-- >   | n `gcd` 6 /= 1  = False+-- >   | otherwise       = index isPrimeCache6 (toWheel6 n)+--+-- Thus, the wheel of 6 saves more space, improving memory locality.+--+-- (If you need to reduce memory consumption even further,+-- consider using 'Data.Bit.Bit' wrapper,+-- which provides an instance of unboxed vector,+-- packing one boolean per bit instead of one boolean per byte for 'Bool')+module Data.Chimera.WheelMapping (+  fromWheel2,+  toWheel2,+  fromWheel6,+  toWheel6,+  fromWheel30,+  toWheel30,+  fromWheel210,+  toWheel210,+) where++import Data.Bits+import Data.Chimera.Compat+import GHC.Exts hiding (timesWord2#)++bits :: Int+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 #-}++-- | 'fromWheel2' n is the (n+1)-th positive odd number.+-- Sequence <https://oeis.org/A005408 A005408>.+--+-- prop> map fromWheel2 [0..] == [ n | n <- [0..], n `gcd` 2 == 1 ]+--+-- >>> 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 #-}++-- | 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+  _ -> i `quot` 3+  where+    m# = 12297829382473034411## -- (2^65+1) / 3+    !(# z1#, _ #) = timesWord2# m# i#+{-# INLINE toWheel6 #-}++-- | 'fromWheel6' n is the (n+1)-th positive number, not divisible by 2 or 3.+-- Sequence <https://oeis.org/A007310 A007310>.+--+-- prop> map fromWheel6 [0..] == [ n | n <- [0..], n `gcd` 6 == 1 ]+--+-- >>> 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 #-}++-- | 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+    (q, r) = case bits of+      64 -> (q64, r64)+      _ -> i `quotRem` 30++    m# = 9838263505978427529## -- (2^67+7) / 15+    !(# z1#, _ #) = timesWord2# m# i#+    q64 = W# z1# `shiftR` 4+    r64 = i - q64 `shiftL` 5 + q64 `shiftL` 1+{-# INLINE toWheel30 #-}++-- | 'fromWheel30' n is the (n+1)-th positive number, not divisible by 2, 3 or 5.+-- Sequence <https://oeis.org/A007775 A007775>.+--+-- prop> map fromWheel30 [0..] == [ n | n <- [0..], n `gcd` 30 == 1 ]+--+-- >>> 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)+{-# INLINE fromWheel30 #-}++-- | 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+    !(q, W# r#) = case bits of+      64 -> (q64, r64)+      _ -> i `quotRem` 210++    m# = 5621864860559101445## -- (2^69+13) / 105+    !(# z1#, _ #) = timesWord2# m# i#+    q64 = W# z1# `shiftR` 6+    r64 = i - q64 * 210++    tableEl# = word8ToWord# (indexWord8OffAddr# table# (word2Int# r#))++    table# :: Addr#+    table# = "\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\SOH\SOH\STX\STX\STX\STX\ETX\ETX\EOT\EOT\EOT\EOT\ENQ\ENQ\ENQ\ENQ\ENQ\ENQ\ACK\ACK\a\a\a\a\a\a\b\b\b\b\t\t\n\n\n\n\v\v\v\v\v\v\f\f\f\f\f\f\r\r\SO\SO\SO\SO\SO\SO\SI\SI\SI\SI\DLE\DLE\DC1\DC1\DC1\DC1\DC1\DC1\DC2\DC2\DC2\DC2\DC3\DC3\DC3\DC3\DC3\DC3\DC4\DC4\DC4\DC4\DC4\DC4\DC4\DC4\NAK\NAK\NAK\NAK\SYN\SYN\ETB\ETB\ETB\ETB\CAN\CAN\EM\EM\EM\EM\SUB\SUB\SUB\SUB\SUB\SUB\SUB\SUB\ESC\ESC\ESC\ESC\ESC\ESC\FS\FS\FS\FS\GS\GS\GS\GS\GS\GS\RS\RS\US\US\US\US      !!\"\"\"\"\"\"######$$$$%%&&&&''''''(())))))****++,,,,--........../"#+-- map Data.Char.chr [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 2, 2, 2, 2, 3, 3, 4, 4, 4, 4, 5, 5, 5, 5, 5, 5, 6, 6, 7, 7, 7, 7, 7, 7, 8, 8, 8, 8, 9, 9, 10, 10, 10, 10, 11, 11, 11, 11, 11, 11, 12, 12, 12, 12, 12, 12, 13, 13, 14, 14, 14, 14, 14, 14, 15, 15, 15, 15, 16, 16, 17, 17, 17, 17, 17, 17, 18, 18, 18, 18, 19, 19, 19, 19, 19, 19, 20, 20, 20, 20, 20, 20, 20, 20, 21, 21, 21, 21, 22, 22, 23, 23, 23, 23, 24, 24, 25, 25, 25, 25, 26, 26, 26, 26, 26, 26, 26, 26, 27, 27, 27, 27, 27, 27, 28, 28, 28, 28, 29, 29, 29, 29, 29, 29, 30, 30, 31, 31, 31, 31, 32, 32, 32, 32, 32, 32, 33, 33, 34, 34, 34, 34, 34, 34, 35, 35, 35, 35, 35, 35, 36, 36, 36, 36, 37, 37, 38, 38, 38, 38, 39, 39, 39, 39, 39, 39, 40, 40, 41, 41, 41, 41, 41, 41, 42, 42, 42, 42, 43, 43, 44, 44, 44, 44, 45, 45, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 47]++{-# INLINE toWheel210 #-}++-- | 'fromWheel210' n is the (n+1)-th positive number, not divisible by 2, 3, 5 or 7.+-- Sequence <https://oeis.org/A008364 A008364>.+--+-- prop> map fromWheel210 [0..] == [ n | n <- [0..], n `gcd` 210 == 1 ]+--+-- >>> 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+    !(q, W# r#) = case bits of+      64 -> (q64, r64)+      _ -> i `quotRem` 48++    m# = 12297829382473034411## -- (2^65+1) / 3+    !(# z1#, _ #) = timesWord2# m# i#+    q64 = W# z1# `shiftR` 5+    r64 = i - q64 `shiftL` 5 - q64 `shiftL` 4++    tableEl# = word8ToWord# (indexWord8OffAddr# table# (word2Int# r#))++    table# :: Addr#+    table# = "\SOH\v\r\DC1\DC3\ETB\GS\US%)+/5;=CGIOSYaegkmqy\DEL\131\137\139\143\149\151\157\163\167\169\173\179\181\187\191\193\197\199\209"#+-- map Data.Char.chr [1, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, 53, 59, 61, 67, 71, 73, 79, 83, 89, 97, 101, 103, 107, 109, 113, 121, 127, 131, 137, 139, 143, 149, 151, 157, 163, 167, 169, 173, 179, 181, 187, 191, 193, 197, 199, 209]++{-# INLINE fromWheel210 #-}++#if !MIN_VERSION_base(4,16,0)+word8ToWord# :: Word# -> Word#+word8ToWord# x = x+#endif

@@ -7,7 +7,7 @@ import Test.QuickCheck.Function import Test.Tasty import Test.Tasty.HUnit as H-import Test.Tasty.QuickCheck as QC+import Test.Tasty.QuickCheck as QC hiding ((.&.))  import Data.Bits import Data.Foldable@@ -44,17 +44,29 @@     ]    , testGroup "to . from Z-curve 2D"-    [ QC.testProperty "random" $ \z -> uncurry toZCurve (fromZCurve z) === z+    [ QC.testProperty "random" $ \z ->+      let mask = (1 `shiftL` ((finiteBitSize (0 :: Word) `shiftR` 1) `shiftL` 1)) - 1 in+      uncurry toZCurve (fromZCurve z) ===+        z .&. mask     ]   , testGroup "from . to Z-curve 2D"-    [ QC.testProperty "random" $ \x y -> fromZCurve (toZCurve x y) === (x `rem` (1 `shiftL` 32), y `rem` (1 `shiftL` 32))+    [ QC.testProperty "random" $ \x y ->+      let mask = (1 `shiftL` (finiteBitSize (0 :: Word) `shiftR` 1)) - 1 in+        fromZCurve (toZCurve x y) ===+          (x .&. mask, y .&. mask)     ]    , testGroup "to . from Z-curve 3D"-    [ QC.testProperty "random" $ \t -> (\(x, y, z) -> toZCurve3 x y z) (fromZCurve3 t) === t `rem` (1 `shiftL` 63)+    [ QC.testProperty "random" $ \t ->+      let mask = (1 `shiftL` (finiteBitSize (0 :: Word) `quot` 3) * 3) - 1 in+        (\(x, y, z) -> toZCurve3 x y z) (fromZCurve3 t) ===+          t .&. mask     ]   , testGroup "from . to Z-curve 3D"-    [ QC.testProperty "random" $ \x y z -> fromZCurve3 (toZCurve3 x y z) === (x `rem` (1 `shiftL` 21), y `rem` (1 `shiftL` 21), z `rem` (1 `shiftL` 21))+    [ QC.testProperty "random" $ \x y z ->+      let mask = (1 `shiftL` (finiteBitSize (0 :: Word) `quot` 3)) - 1 in+        fromZCurve3 (toZCurve3 x y z) ===+          (x .&. mask, y .&. mask, z .&. mask)     ]   ] @@ -103,6 +115,19 @@       let jx = ix `mod` 65536 in         iterate f seed !! fromIntegral jx === Ch.index (Ch.iterate f seed :: UChimera Word) jx +  , QC.testProperty "head . iterate" $+    \(Fun _ (f :: Word -> Word)) seed ->+        seed === Ch.index (Ch.iterate f seed :: UChimera Word) 0++  , QC.testProperty "iterateWithIndex" $+    \(Fun _ (f :: (Word, Int) -> Int)) seed ix ->+      let jx = ix `mod` 65536 in+        iterateWithIndex (curry f) seed !! fromIntegral jx === Ch.index (Ch.iterateWithIndex (curry f) seed :: UChimera Int) jx++  , QC.testProperty "head . iterateWithIndex" $+    \(Fun _ (f :: (Word, Int) -> Int)) seed ->+        seed === Ch.index (Ch.iterateWithIndex (curry f) seed :: UChimera Int) 0+   , QC.testProperty "unfoldr" $     \(Fun _ (f :: Word -> (Int, Word))) seed ix ->       let jx = ix `mod` 65536 in@@ -171,3 +196,6 @@   $ map f   $ takeWhile (\y -> 0 <= y && y < x)   $ splt x++iterateWithIndex :: (Word -> a -> a) -> a -> [a]+iterateWithIndex f seed = L.unfoldr (\(ix, a) -> let a' = f (ix + 1) a in Just (a, (ix + 1, a'))) (0, seed)