chimera 0.2.0.0 → 0.3.0.0

raw patch · 11 files changed

+566/−940 lines, 11 filesdep −gaugedep −ghc-primdep −transformersdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies removed: gauge, ghc-prim, transformers

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• Data/Chimera.hs +263/−84
• Data/Chimera/Bool.hs +0/−297
• Data/Chimera/Compat.hs +0/−1
• Data/Chimera/ContinuousMapping.hs +84/−51
• Data/Chimera/Unboxed.hs +0/−138
• Data/Chimera/WheelMapping.hs +100/−63
• README.md +55/−39
• app/find-foo.hs +0/−126
• bench/Bench.hs +0/−32
• chimera.cabal +39/−40
• test/Test.hs +25/−69

@@ -1,146 +1,325 @@ -- | -- Module:      Data.Chimera--- Copyright:   (c) 2018 Andrew Lelechenko+-- Copyright:   (c) 2018-2019 Andrew Lelechenko -- Licence:     MIT -- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com> ----- Lazy, infinite stream with O(1) indexing.+-- Lazy infinite streams with O(1) indexing.  {-# LANGUAGE CPP                 #-} {-# LANGUAGE DeriveFoldable      #-} {-# LANGUAGE DeriveFunctor       #-} {-# LANGUAGE DeriveTraversable   #-}+{-# LANGUAGE FlexibleContexts    #-}+{-# LANGUAGE FlexibleInstances   #-} {-# LANGUAGE ScopedTypeVariables #-}--{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# LANGUAGE TypeApplications    #-}  module Data.Chimera-  ( Chimera-  , index+  ( -- * Memoization+    memoize+  , memoizeFix +  -- * Chimera+  , Chimera+  , VChimera+  , UChimera+   -- * Construction   , tabulate   , tabulateFix+  , iterate+  , cycle++  -- * Elimination+  , index+  , toList++  -- * Monadic construction+  -- $monadic   , tabulateM   , tabulateFixM+  , iterateM -  -- * Manipulation-  , mapWithKey-  , traverseWithKey-  , zipWithKey-  , zipWithKeyM+  -- * Subvectors+  -- $subvectors+  , mapSubvectors+  , zipSubvectors   ) where -import Prelude hiding ((^), (*), div, mod, fromIntegral, not, and, or)+import Prelude hiding ((^), (*), div, fromIntegral, not, and, or, cycle, iterate, drop) import Control.Applicative import Data.Bits-import Data.Foldable hiding (and, or) import Data.Function (fix) import Data.Functor.Identity import qualified Data.Vector as V-import Data.Word+import qualified Data.Vector.Generic as G+import qualified Data.Vector.Unboxed as U  import Data.Chimera.Compat import Data.Chimera.FromIntegral --- | Representation of a lazy infinite stream, offering--- indexing via 'index' in constant time.-newtype Chimera a = Chimera { _unChimera :: V.Vector (V.Vector a) }+-- $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 = zipSubvectors (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) --- | Similar to 'ZipList'.-instance Applicative Chimera where+-- | Streams backed by boxed vectors.+type VChimera = Chimera V.Vector++-- | Streams backed by unboxed vectors.+type UChimera = Chimera U.Vector++-- | 'pure' creates a constant stream.+instance Applicative (Chimera V.Vector) where   pure   = tabulate   . const-  (<*>)  = zipWithKey (const ($))+  (<*>)  = zipSubvectors (<*>) #if __GLASGOW_HASKELL__ > 801-  liftA2 = zipWithKey . const+  liftA2 f = zipSubvectors (liftA2 f) #endif  bits :: Int bits = fbs (0 :: Word) --- | Create a stream from the function.--- The function must be well-defined for any value of argument--- and should not return 'error' / 'undefined'.-tabulate :: (Word -> a) -> Chimera a-tabulate f = runIdentity $ tabulateM (return . f)+-- | 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]+tabulate :: G.Vector v a => (Word -> a) -> Chimera v a+tabulate f = runIdentity $ tabulateM (pure . f) --- | Create a stream from the monadic function.-tabulateM :: forall m a. Monad m => (Word -> m a) -> m (Chimera a)+-- | Monadic version of 'tabulate'.+tabulateM+  :: forall m v a.+     (Monad m, G.Vector v a)+  => (Word -> m a)+  -> m (Chimera v a) tabulateM f = do   z  <- f 0-  zs <- V.generateM bits tabulateU-  return $ Chimera $ V.singleton z `V.cons` zs+  zs <- V.generateM bits tabulateSubVector+  pure $ Chimera $ G.singleton z `V.cons` zs   where-    tabulateU :: Int -> m (V.Vector a)-    tabulateU i = V.generateM ii (\j -> f (int2word (ii + j)))+    tabulateSubVector :: Int -> m (v a)+    tabulateSubVector i = G.generateM ii (\j -> f (int2word (ii + j)))       where         ii = 1 `shiftL` i-{-# SPECIALIZE tabulateM :: (Word -> Identity a) -> Identity (Chimera a) #-} --- | Create a stream from the unfixed function.-tabulateFix :: ((Word -> a) -> Word -> a) -> Chimera a-tabulateFix uf = runIdentity $ tabulateFixM ((return .) . uf . (runIdentity .))+{-# SPECIALIZE tabulateM :: G.Vector v a => (Word -> Identity a) -> Identity (Chimera v a) #-} --- | Create a stream from the unfixed monadic function.-tabulateFixM :: forall m a. Monad m => ((Word -> m a) -> Word -> m a) -> m (Chimera a)-tabulateFixM uf = bs+-- | 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]+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.+tabulateFixM+  :: forall m v a.+     (Monad m, G.Vector v a)+  => ((Word -> m a) -> Word -> m a)+  -> m (Chimera v a)+tabulateFixM f = result   where-    bs :: m (Chimera a)-    bs = do-      z  <- fix uf 0-      zs <- V.generateM bits tabulateU-      return $ Chimera $ V.singleton z `V.cons` zs+    result :: m (Chimera v a)+    result = do+      z  <- fix f 0+      zs <- V.generateM bits tabulateSubVector+      pure $ Chimera $ G.singleton z `V.cons` zs -    tabulateU :: Int -> m (V.Vector a)-    tabulateU i = vs+    tabulateSubVector :: Int -> m (v a)+    tabulateSubVector i = subResult       where-        vs = V.generateM ii (\j -> uf f (int2word (ii + j)))+        subResult      = G.generateM ii (\j -> f fixF (int2word (ii + j)))+        subResultBoxed = V.generateM ii (\j -> f fixF (int2word (ii + j)))         ii = 1 `shiftL` i-        f k = if k < int2word ii-          then flip index k <$> bs-          else flip V.unsafeIndex (word2int k - ii) <$> vs -{-# SPECIALIZE tabulateFixM :: ((Word -> Identity a) -> Word -> Identity a) -> Identity (Chimera a) #-}+        fixF :: Word -> m a+        fixF k+          | k < int2word ii+          = flip index k <$> result+          | k < int2word ii `shiftL` 1+          = (`V.unsafeIndex` (word2int k - ii)) <$> subResultBoxed+          | otherwise+          = f fixF k --- | Convert a stream back to a function.-index :: Chimera a -> Word -> a-index (Chimera vus) 0 = V.unsafeHead (V.unsafeHead vus)-index (Chimera vus) i = V.unsafeIndex (vus `V.unsafeIndex` (sgm + 1)) (word2int $ i - 1 `shiftL` sgm)+{-# SPECIALIZE tabulateFixM :: G.Vector v a => ((Word -> Identity a) -> Word -> Identity a) -> Identity (Chimera v a) #-}++-- | 'iterate' @f@ @x@ returns an infinite stream+-- of 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]+iterate :: G.Vector v a => (a -> a) -> a -> Chimera v a+iterate f = runIdentity . iterateM (pure . f)++-- | Monadic version of 'iterate'.+iterateM :: forall m v a. (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   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) #-}++-- | Index a stream in a constant time.+--+-- >>> ch = tabulate (^ 2) :: UChimera Word+-- >>> index ch 9+-- 81+index :: G.Vector v a => Chimera v a -> Word -> a+index (Chimera vs) 0 = G.unsafeHead (V.unsafeHead vs)+index (Chimera vs) i = G.unsafeIndex (vs `V.unsafeIndex` (sgm + 1)) (word2int $ i - 1 `shiftL` sgm)+  where     sgm :: Int     sgm = fbs i - 1 - word2int (clz i) --- | Map over all indices and respective elements in the stream.-mapWithKey :: (Word -> a -> b) -> Chimera a -> Chimera b-mapWithKey f = runIdentity . traverseWithKey ((return .) . f)+-- | 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]+toList :: G.Vector v a => Chimera v a -> [a]+toList (Chimera vs) = foldMap G.toList vs --- | Traverse over all indices and respective elements in the stream.-traverseWithKey :: forall m a b. Monad m => (Word -> a -> m b) -> Chimera a -> m (Chimera b)-traverseWithKey f (Chimera bs) = do-  bs' <- V.imapM g bs-  return $ Chimera bs'+-- | Return an infinite repetion 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]+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-    g :: Int -> V.Vector a -> m (V.Vector b)-    g 0         = V.imapM (f . int2word)-    g logOffset = V.imapM (f . int2word . (+ offset))-      where-        offset = 1 `shiftL` (logOffset - 1)-{-# SPECIALIZE traverseWithKey :: (Word -> a -> Identity a) -> Chimera a -> Identity (Chimera a) #-}+    l = int2word $ G.length vec --- | Zip two streams with the function, which is provided with an index and respective elements of both streams.-zipWithKey :: (Word -> a -> b -> c) -> Chimera a -> Chimera b -> Chimera c-zipWithKey f = (runIdentity .) . zipWithKeyM (((return .) .) . f)+-- | 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'.+--+-- prop> memoize f n = f n+memoize :: (Word -> a) -> (Word -> a)+memoize = index @V.Vector . tabulate --- | Zip two streams with the monadic function, which is provided with an index and respective elements of both streams.-zipWithKeyM :: forall m a b c. Monad m => (Word -> a -> b -> m c) -> Chimera a -> Chimera b -> m (Chimera c)-zipWithKeyM f (Chimera bs1) (Chimera bs2) = do-  bs' <- V.izipWithM g bs1 bs2-  return $ Chimera bs'-  where-    g :: Int -> V.Vector a -> V.Vector b -> m (V.Vector c)-    g 0         = V.izipWithM (f . int2word)-    g logOffset = V.izipWithM (f . int2word . (+ offset))-      where-        offset = 1 `shiftL` (logOffset - 1)-{-# SPECIALIZE zipWithKeyM :: (Word -> a -> a -> Identity a) -> Chimera a -> Chimera a -> Identity (Chimera a) #-}+-- | For a given @f@ memoize a recursive function 'fix' @f@,+-- caching results in 'VChimera'.+-- This is just a shortcut for 'index' '.' 'tabulateFix'.+--+-- 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 fromIntegral 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 fromIntegral n else f (n - 1) + f (n - 2)+--+-- Now we are ready to use 'memoizeFix':+--+-- >>> memoizeFix fiboF 10+-- 55+-- >>> memoizeFix fiboF 100+-- 354224848179261915075+memoizeFix :: ((Word -> a) -> Word -> a) -> (Word -> a)+memoizeFix = index @V.Vector . tabulateFix++-- | Map subvectors of a stream, using a given length-preserving function.+mapSubvectors+  :: (G.Vector u a, G.Vector v b)+  => (u a -> v b)+  -> Chimera u a+  -> Chimera v b+mapSubvectors f (Chimera bs) = Chimera (V.map f bs)++-- | Zip subvectors from two streams, using a given length-preserving function.+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 f (Chimera bs1) (Chimera bs2) = Chimera (V.zipWith f bs1 bs2)

@@ -1,297 +0,0 @@--- |--- Module:      Data.Chimera.Bool--- Copyright:   (c) 2017 Andrew Lelechenko--- Licence:     MIT--- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>------ Semilazy, infinite, compact stream of 'Bool' with O(1) indexing.--- Most useful for memoization of predicates.------ __Example 1__------ Consider following predicate:------ > isOdd :: Word -> Bool--- > isOdd 0 = False--- > isOdd n = not (isOdd (n - 1))------ Its computation is expensive, so we'd like to memoize its values into--- 'Chimera' using 'tabulate' and access this stream via 'index'--- instead of recalculation of @isOdd@:------ > isOddBS :: Chimera--- > isOddBS = tabulate isOdd--- >--- > isOdd' :: Word -> Bool--- > isOdd' = index isOddBS------ We can do even better by replacing part of recursive calls to @isOdd@--- by indexing memoized values. Write @isOddF@--- such that @isOdd = 'fix' isOddF@:------ > isOddF :: (Word -> Bool) -> Word -> Bool--- > isOddF _ 0 = False--- > isOddF f n = not (f (n - 1))------ and use 'tabulateFix':------ > isOddBS :: Chimera--- > isOddBS = tabulateFix isOddF--- >--- > isOdd' :: Word -> Bool--- > isOdd' = index isOddBS------ __Example 2__------ Define a predicate, which checks whether its argument is--- a prime number by trial division.------ > isPrime :: Word -> Bool--- > isPrime n--- >   | n < 2     = False--- >   | n < 4     = True--- >   | even n    = False--- >   | otherwise = and [ n `rem` d /= 0 | d <- [3, 5 .. ceiling (sqrt (fromIntegral n))], isPrime d]------ Convert it to unfixed form:------ > isPrimeF :: (Word -> Bool) -> Word -> Bool--- > isPrimeF f n--- >   | n < 2     = False--- >   | n < 4     = True--- >   | even n    = False--- >   | otherwise = and [ n `rem` d /= 0 | d <- [3, 5 .. ceiling (sqrt (fromIntegral n))], f d]------ Create its memoized version for faster evaluation:------ > isPrimeBS :: Chimera--- > isPrimeBS = tabulateFix isPrimeF--- >--- > isPrime' :: Word -> Bool--- > isPrime' = index isPrimeBS--{-# LANGUAGE ScopedTypeVariables #-}--{-# OPTIONS_GHC -fno-warn-unused-imports #-}--module Data.Chimera.Bool-  ( Chimera-  , index-  , trueIndices-  , falseIndices--  -- * Construction-  , tabulate-  , tabulateFix-  , tabulateM-  , tabulateFixM--  -- * Manipulation-  , mapWithKey-  , traverseWithKey-  , not-  , zipWithKey-  , zipWithKeyM-  , and-  , or-  ) where--import Prelude hiding ((^), (*), div, mod, fromIntegral, not, and, or)-import Data.Bits-import Data.Foldable hiding (and, or)-import Data.Function (fix)-import Data.Functor.Identity-import qualified Data.Vector.Unboxed as U-import qualified Data.Vector as V-import Data.Word--import Data.Chimera.Compat-import Data.Chimera.FromIntegral---- | Compact representation of an infinite stream of 'Bool', offering--- indexing via 'index' in constant time.------ It spends one bit (1/8 byte) for one 'Bool' in store.--- Compare it to at least 24 bytes per element in @[Bool]@,--- approximately 2 bytes per element in 'IntSet'--- and 1 byte per element in unboxed @Vector Bool@.------ This representation is less lazy than 'Data.Chimera.Chimera':--- Querying n-th element triggers computation--- of first @max(64, 2 ^ ceiling (logBase 2 n))@ elements.-newtype Chimera = Chimera { _unChimera :: V.Vector (U.Vector Word) }--bits :: Int-bits = fbs (0 :: Word)--bitsLog :: Int-bitsLog = bits - 1 - word2int (clz (int2word bits))---- | Create a bit stream from the predicate.--- The predicate must be well-defined for any value of argument--- and should not return 'error' / 'undefined'.-tabulate :: (Word -> Bool) -> Chimera-tabulate f = runIdentity $ tabulateM (return . f)---- | Create a bit stream from the monadic predicate.--- The predicate must be well-defined for any value of argument--- and should not return 'error' / 'undefined'.-tabulateM :: forall m. Monad m => (Word -> m Bool) -> m Chimera-tabulateM f = do-  z  <- tabulateW 0-  zs <- V.generateM (bits - bitsLog) tabulateU-  return $ Chimera $ U.singleton z `V.cons` zs-  where-    tabulateU :: Int -> m (U.Vector Word)-    tabulateU i = U.generateM ii (\j -> tabulateW (ii + j))-      where-        ii = 1 `shiftL` i--    tabulateW :: Int -> m Word-    tabulateW j = foldlM go 0 [0 .. bits - 1]-      where-        jj = j `shiftL` bitsLog-        go acc k = do-          b <- f (int2word $ jj + k)-          return $ if b then acc `setBit` k else acc-{-# SPECIALIZE tabulateM :: (Word -> Identity Bool) -> Identity Chimera #-}---- | Create a bit stream from the unfixed predicate.--- The predicate must be well-defined for any value of argument--- and should not return 'error' / 'undefined'.-tabulateFix :: ((Word -> Bool) -> Word -> Bool) -> Chimera-tabulateFix uf = runIdentity $ tabulateFixM ((return .) . uf . (runIdentity .))---- | Create a bit stream from the unfixed monadic predicate.--- The predicate must be well-defined for any value of argument--- and should not return 'error' / 'undefined'.-tabulateFixM :: forall m. Monad m => ((Word -> m Bool) -> Word -> m Bool) -> m Chimera-tabulateFixM uf = bs-  where-    bs :: m Chimera-    bs = do-      z  <- tabulateW (fix uf) 0-      zs <- V.generateM (bits - bitsLog) tabulateU-      return $ Chimera $ U.singleton z `V.cons` zs--    tabulateU :: Int -> m (U.Vector Word)-    tabulateU i = U.generateM ii (\j -> tabulateW (uf f) (ii + j))-      where-        ii = 1 `shiftL` i-        iii = ii `shiftL` bitsLog-        f k = do-          bs' <- bs-          if k < int2word iii then return (index bs' k) else uf f k--    tabulateW :: (Word -> m Bool) -> Int -> m Word-    tabulateW f j = foldlM go 0 [0 .. bits - 1]-      where-        jj = j `shiftL` bitsLog-        go acc k = do-          b <- f (int2word $ jj + k)-          return $ if b then acc `setBit` k else acc-{-# SPECIALIZE tabulateFixM :: ((Word -> Identity Bool) -> Word -> Identity Bool) -> Identity Chimera #-}---- | Convert a bit stream back to predicate.--- Indexing itself works in O(1) time, but triggers evaluation and allocation--- of surrounding elements of the stream, if they were not computed before.-index :: Chimera -> Word -> Bool-index (Chimera vus) i =-  if sgm < 0 then indexU (V.unsafeHead vus) (word2int i)-  else indexU (vus `V.unsafeIndex` (sgm + 1)) (word2int $ i - int2word bits `shiftL` sgm)-  where-    sgm :: Int-    sgm = fbs i - 1 - bitsLog - word2int (clz i)--    indexU :: U.Vector Word -> Int -> Bool-    indexU vec j = testBit (vec `U.unsafeIndex` jHi) jLo-      where-        jHi = j `shiftR` bitsLog-        jLo = j .&. (bits - 1)---- | List indices of elements equal to 'True'.-trueIndices :: Chimera -> [Word]-trueIndices bs = someIndices True bs---- | List indices of elements equal to 'False'.-falseIndices :: Chimera -> [Word]-falseIndices bs = someIndices False bs--someIndices :: Bool -> Chimera -> [Word]-someIndices bool (Chimera b) = V.ifoldr goU [] b-  where-    goU :: Int -> U.Vector Word -> [Word] -> [Word]-    goU i vec rest = U.ifoldr (\j -> goW (ii + j)) rest vec-      where-        ii = case i of-          0 -> 0-          _ -> 1 `shiftL` (i - 1)--    goW :: Int -> Word -> [Word] -> [Word]-    goW j w rest-      = map (\k -> int2word $ jj + k)-      (filter (\bt -> testBit w bt == bool) [0 .. bits - 1])-      ++ rest-      where-        jj = j `shiftL` bitsLog-{-# INLINE someIndices #-}---- | Element-wise 'not'.-not :: Chimera -> Chimera-not (Chimera vus) = Chimera $ V.map (U.map (maxBound -)) vus---- | Map over all indices and respective elements in the stream.-mapWithKey :: (Word -> Bool -> Bool) -> Chimera -> Chimera-mapWithKey f = runIdentity . traverseWithKey ((return .) . f)---- | Traverse over all indices and respective elements in the stream.-traverseWithKey :: forall m. Monad m => (Word -> Bool -> m Bool) -> Chimera -> m Chimera-traverseWithKey f (Chimera bs) = do-  bs' <- V.imapM g bs-  return $ Chimera bs'-  where-    g :: Int -> U.Vector Word -> m (U.Vector Word)-    g 0         = U.imapM h-    g logOffset = U.imapM (h . (`shiftL` bitsLog) . (+ offset))-      where-        offset = 1 `shiftL` (logOffset - 1)--    h :: Int -> Word -> m Word-    h offset w = foldlM go 0 [0 .. bits - 1]-      where-        go acc k = do-          b <- f (int2word $ offset + k) (testBit w k)-          return $ if b then acc `setBit` k else acc-{-# SPECIALIZE traverseWithKey :: (Word -> Bool -> Identity Bool) -> Chimera -> Identity Chimera #-}---- | Element-wise 'and'.-and :: Chimera -> Chimera -> Chimera-and (Chimera vus) (Chimera wus) = Chimera $ V.zipWith (U.zipWith (.&.)) vus wus---- | Element-wise 'or'.-or  :: Chimera -> Chimera -> Chimera-or (Chimera vus) (Chimera wus) = Chimera $ V.zipWith (U.zipWith (.|.)) vus wus---- | Zip two streams with the function, which is provided with an index and respective elements of both streams.-zipWithKey :: (Word -> Bool -> Bool -> Bool) -> Chimera -> Chimera -> Chimera-zipWithKey f = (runIdentity .) . zipWithKeyM (((return .) .) . f)---- | Zip two streams with the monadic function, which is provided with an index and respective elements of both streams.-zipWithKeyM :: forall m. Monad m => (Word -> Bool -> Bool -> m Bool) -> Chimera -> Chimera -> m Chimera-zipWithKeyM f (Chimera bs1) (Chimera bs2) = do-  bs' <- V.izipWithM g bs1 bs2-  return $ Chimera bs'-  where-    g :: Int -> U.Vector Word -> U.Vector Word -> m (U.Vector Word)-    g 0         = U.izipWithM h-    g logOffset = U.izipWithM (h . (`shiftL` bitsLog) . (+ offset))-      where-        offset = 1 `shiftL` (logOffset - 1)--    h :: Int -> Word -> Word -> m Word-    h offset w1 w2 = foldlM go 0 [0 .. bits - 1]-      where-        go acc k = do-          b <- f (int2word $ offset + k) (testBit w1 k) (testBit w2 k)-          return $ if b then acc `setBit` k else acc-{-# SPECIALIZE zipWithKeyM :: (Word -> Bool -> Bool -> Identity Bool) -> Chimera -> Chimera -> Identity Chimera #-}

@@ -17,7 +17,6 @@  import Data.Bits import GHC.Exts-import GHC.Prim import Unsafe.Coerce  #if __GLASGOW_HASKELL__ > 709

@@ -5,58 +5,89 @@ -- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com> -- -- Helpers for continuous mappings, useful to memoize--- predicates on 'Int' (instead of 'Word' only), and--- predicates over two, three and more arguments.+-- functions on 'Int' (instead of 'Word' only) and+-- functions over two and three arguments. ----- __ Example__+-- __Example 1__ ----- An infinite plain board of live and dead cells (common for cellular automatons,--- e. g., <https://en.wikipedia.org/wiki/Conway%27s_Game_of_Life Conway's Game of Life>)--- can be represented as a predicate @board@ :: 'Int' -> 'Int' -> 'Bool'. Assume that--- we want to convert it to memoized form. We cannot do it directly, because 'Data.Chimera.Bool.tabulate'--- accepts predicates from 'Word' to 'Bool' only.+-- 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. ----- The first step is to define:+-- 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? ----- > board'' :: Int -> Int -> Bool--- > board'' x y = board' (intToWord x) (intToWord y)--- >--- > board' :: Word -> Word -> Bool--- > board' x y = board (wordToInt x) (wordToInt y)+-- 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: ----- This is better, but @board'@ is a predicate over two arguments, and we need it to be a predicate over one.--- Conversion to Z-curve and back does the trick:+-- > step :: (Int -> Bool) -> (Int -> Bool)+-- > step current = \n -> current (n - 1) /= current (n + 1) ----- > board'' :: Int -> Int -> Bool--- > board'' x y = board1 $ toZCurve (intToWord x) (intToWord y)--- >--- > board' :: Word -> Bool--- > board' z = let (x, y) = fromZCurve z in--- >            board (wordToInt x) (wordToInt y)+-- Unfortunately, iterating @step@ would be extremely slow+-- because of branching recursion. One+-- could suggest to introduce a caching layer: ----- Now we are ready to insert memoizing layer:+-- > step :: (Int -> Bool) -> (Int -> Bool)+-- > step current = \n -> current' (n - 1) /= current' (n + 1)+-- >   where+-- >     current' = memoize (current . fromIntegral) . fromIntegral ----- > board'' :: Int -> Int -> Bool--- > board'' x y = index board' $ toZCurve (intToWord x) (intToWord y)--- >--- > board' :: Chimera--- > board' = tabulate $--- >   \z -> let (x, y) = fromZCurve z in--- >         board (wordToInt x) (wordToInt y)+-- 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 (word2int x) (word2int y)+--+-- and then back:+--+-- > uncast :: (Word -> Bool) -> (Int -> Int -> Bool)+-- > uncast g = \x y -> g (toZCurve (int2word x) (int2word y))+-- -{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# 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 Data.Word import Unsafe.Coerce  word2int :: Word -> Int@@ -65,14 +96,16 @@ int2word :: Int -> Word int2word = unsafeCoerce --- | Total map, which satisfies inequality--- abs ('intToWord' x - 'intToWord' y) ≤ 2 abs(x - y).+-- | Total map, which satisfies ----- Note that this is not the case for 'fromIntegral' :: 'Int' -> 'Word',+-- 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]+-- >>> map intToWord [-5..5]+-- [9,7,5,3,1,0,2,4,6,8,10] intToWord :: Int -> Word intToWord i   | i >= 0    = int2word        i `shiftL` 1@@ -80,8 +113,8 @@  -- | Inverse for 'intToWord'. ----- > > map wordToInt [0..10]--- > [0,-1,1,-2,2,-3,3,-4,4,-5,5]+-- >>> map wordToInt [0..10]+-- [0,-1,1,-2,2,-3,3,-4,4,-5,5] wordToInt :: Word -> Int wordToInt w   | even w    =         word2int (w `shiftR` 1)@@ -92,16 +125,16 @@ -- -- 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]+-- >>> [ 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] 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)]+-- >>> 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)] fromZCurve :: Word -> (Word, Word) fromZCurve z = (compact1by1 z, compact1by1 (z `shiftR` 1)) @@ -110,20 +143,20 @@ -- -- 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]+-- >>> [ 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] 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)]+-- >>> 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)] fromZCurve3 :: Word -> (Word, Word, Word) fromZCurve3 z = (compact1by2 z, compact1by2 (z `shiftR` 1), compact1by2 (z `shiftR` 2)) 

@@ -1,138 +0,0 @@--- |--- Module:      Data.Chimera--- Copyright:   (c) 2018 Andrew Lelechenko--- Licence:     MIT--- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>------ Semilazy, infinite stream with O(1) indexing.--{-# LANGUAGE ScopedTypeVariables #-}--{-# OPTIONS_GHC -fno-warn-unused-imports #-}--module Data.Chimera.Unboxed-  ( Chimera-  , index-  , toList--  -- * Construction-  , tabulate-  , tabulateFix-  , tabulateM-  , tabulateFixM--  -- * Manipulation-  , mapWithKey-  , traverseWithKey-  , zipWithKey-  , zipWithKeyM-  ) where--import Prelude hiding ((^), (*), div, mod, fromIntegral, not, and, or, iterate)-import Data.Bits-import Data.Foldable hiding (and, or, toList)-import Data.Function (fix)-import Data.Functor.Identity-import qualified Data.Vector as V-import qualified Data.Vector.Unboxed as U-import Data.Word--import Data.Chimera.Compat-import Data.Chimera.FromIntegral---- | Representation of an infinite stream, offering--- indexing via 'index' in constant time.------ This representation is less lazy than 'Data.Chimera.Chimera':--- Querying n-th element triggers computation--- of first @2 ^ ceiling (logBase 2 n)@ elements.-newtype Chimera a = Chimera { _unChimera :: V.Vector (U.Vector a) }--bits :: Int-bits = fbs (0 :: Word)---- | Create a stream from the function.-tabulate :: U.Unbox a => (Word -> a) -> Chimera a-tabulate f = runIdentity $ tabulateM (return . f)---- | Create a stream from the monadic function.-tabulateM :: forall m a. (Monad m, U.Unbox a) => (Word -> m a) -> m (Chimera a)-tabulateM f = do-  z  <- f 0-  zs <- V.generateM bits tabulateU-  return $ Chimera $ U.singleton z `V.cons` zs-  where-    tabulateU :: Int -> m (U.Vector a)-    tabulateU i = U.generateM ii (\j -> f (int2word (ii + j)))-      where-        ii = 1 `shiftL` i-{-# SPECIALIZE tabulateM :: U.Unbox a => (Word -> Identity a) -> Identity (Chimera a) #-}---- | Create a stream from the unfixed function.-tabulateFix :: U.Unbox a => ((Word -> a) -> Word -> a) -> Chimera a-tabulateFix uf = runIdentity $ tabulateFixM ((return .) . uf . (runIdentity .))---- | Create a stream from the unfixed monadic function.-tabulateFixM :: forall m a. (Monad m, U.Unbox a) => ((Word -> m a) -> Word -> m a) -> m (Chimera a)-tabulateFixM uf = bs-  where-    bs :: m (Chimera a)-    bs = do-      z  <- fix uf 0-      zs <- V.generateM bits tabulateU-      return $ Chimera $ U.singleton z `V.cons` zs--    tabulateU :: Int -> m (U.Vector a)-    tabulateU i = U.generateM ii (\j -> uf f (int2word (ii + j)))-      where-        ii = 1 `shiftL` i-        f k = do-          bs' <- bs-          if k < int2word ii then return (index bs' k) else uf f k-{-# SPECIALIZE tabulateFixM :: U.Unbox a => ((Word -> Identity a) -> Word -> Identity a) -> Identity (Chimera a) #-}---- | Convert a stream back to a function.-index :: U.Unbox a => Chimera a -> Word -> a-index (Chimera vus) 0 = U.unsafeHead (V.unsafeHead vus)-index (Chimera vus) i = U.unsafeIndex (vus `V.unsafeIndex` (sgm + 1)) (word2int $ i - 1 `shiftL` sgm)-  where-    sgm :: Int-    sgm = fbs i - 1 - word2int (clz i)---- | Convert a stream to a list.-toList :: U.Unbox a => Chimera a -> [a]-toList (Chimera vus) = foldMap U.toList vus---- | Map over all indices and respective elements in the stream.-mapWithKey :: (U.Unbox a, U.Unbox b) => (Word -> a -> b) -> Chimera a -> Chimera b-mapWithKey f = runIdentity . traverseWithKey ((return .) . f)---- | Traverse over all indices and respective elements in the stream.-traverseWithKey :: forall m a b. (Monad m, U.Unbox a, U.Unbox b) => (Word -> a -> m b) -> Chimera a -> m (Chimera b)-traverseWithKey f (Chimera bs) = do-  bs' <- V.imapM g bs-  return $ Chimera bs'-  where-    g :: Int -> U.Vector a -> m (U.Vector b)-    g 0         = U.imapM (f . int2word)-    g logOffset = U.imapM (f . int2word . (+ offset))-      where-        offset = 1 `shiftL` (logOffset - 1)-{-# SPECIALIZE traverseWithKey :: U.Unbox a => (Word -> a -> Identity a) -> Chimera a -> Identity (Chimera a) #-}---- | Zip two streams with the function, which is provided with an index and respective elements of both streams.-zipWithKey :: (U.Unbox a, U.Unbox b, U.Unbox c) => (Word -> a -> b -> c) -> Chimera a -> Chimera b -> Chimera c-zipWithKey f = (runIdentity .) . zipWithKeyM (((return .) .) . f)---- | Zip two streams with the monadic function, which is provided with an index and respective elements of both streams.-zipWithKeyM :: forall m a b c. (Monad m, U.Unbox a, U.Unbox b, U.Unbox c) => (Word -> a -> b -> m c) -> Chimera a -> Chimera b -> m (Chimera c)-zipWithKeyM f (Chimera bs1) (Chimera bs2) = do-  bs' <- V.izipWithM g bs1 bs2-  return $ Chimera bs'-  where-    g :: Int -> U.Vector a -> U.Vector b -> m (U.Vector c)-    g 0         = U.izipWithM (f . int2word)-    g logOffset = U.izipWithM (f . int2word . (+ offset))-      where-        offset = 1 `shiftL` (logOffset - 1)-{-# SPECIALIZE zipWithKeyM :: U.Unbox a => (Word -> a -> a -> Identity a) -> Chimera a -> Chimera a -> Identity (Chimera a) #-}

@@ -5,65 +5,70 @@ -- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com> -- -- Helpers for mapping to <http://mathworld.wolfram.com/RoughNumber.html rough numbers>--- and back. Mostly useful in number theory.+-- 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 improve performance of repetitive reevaluation by memoization:+-- Let @isPrime@ be an expensive predicate,+-- which checks whether its argument is a prime number.+-- We can memoize it as usual: ----- > isPrimeBS :: Chimera--- > isPrimeBS = tabulate isPrime+-- > isPrimeCache1 :: UChimera Bool+-- > isPrimeCache1 = tabulate isPrime -- >--- > isPrime' :: Word -> Bool--- > isPrime' = index isPrimeBS+-- > isPrime1 :: Word -> Bool+-- > isPrime1 = index isPrimeCache1 ----- However, it is well-known that the only even prime is 2.--- So we can save half of space by memoizing the predicate for odd+-- 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: ----- > isPrimeBS2 :: Chimera--- > isPrimeBS2 = tabulate (\n -> isPrime (2 * n + 1))+-- > isPrimeCache2 :: UChimera Bool+-- > isPrimeCache2 = tabulate (isPrime . (\n -> 2 * n + 1)) -- >--- > isPrime2' :: Word -> Bool--- > isPrime2' n+-- > isPrime2 :: Word -> Bool+-- > isPrime2 n -- >   | n == 2    = True -- >   | even n    = False--- >   | otherwise = index isPrimeBS2 ((n - 1) `quot` 2)+-- >   | otherwise = index isPrimeCache2 ((n - 1) `quot` 2) ----- or, using 'fromWheel2' and 'toWheel2',+-- 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'. ----- > isPrimeBS2 :: Chimera--- > isPrimeBS2 = tabulate (isPrime . fromWheel2)--- >--- > isPrime2' :: Word -> Bool--- > isPrime2' n--- >   | n == 2    = True--- >   | even n    = False--- >   | otherwise = index isPrimeBS2 (toWheel2 n)+-- 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>. ----- Well, we also know that all primes, except 2 and 3, are coprime to 6; and all primes, except 2, 3 and 5, are coprime 30. So we can save even more space by writing+-- 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 ----- > isPrimeBS6 :: Chimera--- > isPrimeBS6 = tabulate (isPrime . fromWheel6)+-- > isPrimeCache6 :: UChimera Bool+-- > isPrimeCache6 = tabulate (isPrime . fromWheel6) -- >--- > isPrime6' :: Word -> Bool--- > isPrime6' n+-- > isPrime6 :: Word -> Bool+-- > isPrime6 n -- >   | n `elem` [2, 3] = True -- >   | n `gcd` 6 /= 1  = False--- >   | otherwise       = index isPrimeBS6 (toWheel6 n)+-- >   | otherwise       = index isPrimeCache6 (toWheel6 n) ----- or+-- Thus, the wheel of 6 saves more space, improving memory locality. ----- > isPrimeBS30 :: Chimera--- > isPrimeBS30 = tabulate (isPrime . fromWheel30)--- >--- > isPrime30' :: Word -> Bool--- > isPrime30' n--- >   | n `elem` [2, 3, 5] = True--- >   | n `gcd` 30 /= 1    = False--- >   | otherwise          = index isPrimeBS30 (toWheel30 n)+-- (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 MagicHash     #-}+{-# LANGUAGE UnboxedTuples #-}+ module Data.Chimera.WheelMapping   ( fromWheel2   , toWheel2@@ -76,11 +81,11 @@   ) where  import Data.Bits-import qualified Data.Vector.Unboxed as U-import Data.Word+import Data.Chimera.Compat+import GHC.Exts -word2int :: Word -> Int-word2int = fromIntegral+bits :: Int+bits = fbs (0 :: Word)  -- | Left inverse for 'fromWheel2'. Monotonically non-decreasing function. --@@ -94,8 +99,8 @@ -- -- 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]+-- >>> map fromWheel2 [0..9]+-- [1,3,5,7,9,11,13,15,17,19] fromWheel2 :: Word -> Word fromWheel2 i = i `shiftL` 1 + 1 {-# INLINE fromWheel2 #-}@@ -104,7 +109,13 @@ -- -- prop> toWheel6 . fromWheel6 == id toWheel6 :: Word -> Word-toWheel6 i = i `quot` 3+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.@@ -112,8 +123,8 @@ -- -- 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]+-- >>> map fromWheel6 [0..9]+-- [1,5,7,11,13,17,19,23,25,29] fromWheel6 :: Word -> Word fromWheel6 i = i `shiftL` 1 + i + (i .&. 1) + 1 {-# INLINE fromWheel6 #-}@@ -122,9 +133,17 @@ -- -- prop> toWheel30 . fromWheel30 == id toWheel30 :: Word -> Word-toWheel30 i = q `shiftL` 3 + (r + r `shiftR` 4) `shiftR` 2+toWheel30 i@(W# i#) = q `shiftL` 3 + (r + r `shiftR` 4) `shiftR` 2   where-    (q, r) = i `quotRem` 30+    (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.@@ -132,8 +151,8 @@ -- -- 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]+-- >>> map fromWheel30 [0..9]+-- [1,7,11,13,17,19,23,29,31,37] fromWheel30 :: Word -> Word fromWheel30 i = ((i `shiftL` 2 - i `shiftR` 2) .|. 1)               + ((i `shiftL` 1 - i `shiftR` 1) .&. 2)@@ -143,26 +162,44 @@ -- -- prop> toWheel210 . fromWheel210 == id toWheel210 :: Word -> Word-toWheel210 i = q * 48 + fromIntegral (toWheel210Table `U.unsafeIndex` word2int r)+toWheel210 i@(W# i#) = q `shiftL` 5 + q `shiftL` 4 + W# (indexWord8OffAddr# table# (word2Int# r#))   where-    (q, r) = i `quotRem` 210-{-# INLINE toWheel210 #-}+    !(q, W# r#) = case bits of+      64 -> (q64, r64)+      _  -> i `quotRem` 210 -toWheel210Table :: U.Vector Word8-toWheel210Table = U.fromList [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]+    m# = 5621864860559101445## -- (2^69+13) / 105+    !(# z1#, _ #) = timesWord2# m# i#+    q64 = W# z1# `shiftR` 6+    r64 = i - q64 * 210 +    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]+-- >>> map fromWheel210 [0..9]+-- [1,11,13,17,19,23,29,31,37,41] fromWheel210 :: Word -> Word-fromWheel210 i = q * 210 + fromIntegral (fromWheel210Table `U.unsafeIndex` word2int r)+fromWheel210 i@(W# i#) = q * 210 + W# (indexWord8OffAddr# table# (word2Int# r#))   where-    (q, r) = i `quotRem` 48-{-# INLINE fromWheel210 #-}+    !(q, W# r#) = case bits of+      64 -> (q64, r64)+      _  -> i `quotRem` 48 -fromWheel210Table :: U.Vector Word8-fromWheel210Table = U.fromList [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]+    m# = 12297829382473034411## -- (2^65+1) / 3+    !(# z1#, _ #) = timesWord2# m# i#+    q64 = W# z1# `shiftR` 5+    r64 = i - q64 `shiftL` 5 - q64 `shiftL` 4++    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 #-}

@@ -1,81 +1,97 @@ # chimera -Lazy, infinite streams with O(1) indexing.-Most useful to memoize functions.+Lazy infinite compact streams with cache-friendly O(1) indexing+and applications for memoization. +----++Imagine having a function `f :: Word -> a`,+which is expensive to evaluate. We would like to _memoize_ it,+returning `g :: Word -> a`, which does effectively the same,+but transparently caches results to speed up repetitive+re-evaluation.++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.+  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.+ ## Example 1 -Consider following predicate:+Consider the following predicate:  ```haskell isOdd :: Word -> Bool-isOdd 0 = False-isOdd n = not (isOdd (n - 1))+isOdd n = if n == 0 then False else not (isOdd (n - 1)) ``` -Its computation is expensive, so we'd like to memoize its values into-`Chimera` using `tabulate` and access this stream via `index`-instead of recalculation of `isOdd`:+Its computation is expensive, so we'd like to memoize it:  ```haskell-isOddBS :: Chimera-isOddBS = tabulate isOdd- isOdd' :: Word -> Bool-isOdd' = index isOddBS+isOdd' = memoize isOdd ``` -We can do even better by replacing part of recursive calls to `isOdd`-by indexing memoized values. Write `isOddF`-such that `isOdd = fix isOddF`:+This is fine to avoid re-evaluation for the same arguments.+But `isOdd` does not use this cache internally, going all the way+of recursive calls to `n = 0`. We can do better,+if we rewrite `isOdd` as a `fix` point of `isOddF`:  ```haskell isOddF :: (Word -> Bool) -> Word -> Bool-isOddF _ 0 = False-isOddF f n = not (f (n - 1))+isOddF f n = if n == 0 then False else not (f (n - 1)) ``` -and use `tabulateFix`:+and invoke `tabulateFix` to pass cache into recursive calls as well:  ```haskell-isOddBS :: Chimera-isOddBS = tabulateFix isOddF- isOdd' :: Word -> Bool-isOdd' = index isOddBS+isOdd' = memoizeFix isOddF ```  ## Example 2  Define a predicate, which checks whether its argument is-a prime number by trial division.+a prime number, using trial division.  ```haskell isPrime :: Word -> Bool-isPrime n-  | n < 2     = False-  | n < 4     = True-  | even n    = False-  | otherwise = and [ n `rem` d /= 0 | d <- [3, 5 .. ceiling (sqrt (fromIntegral n))], isPrime d]+isPrime n = n > 1 && and [ n `rem` d /= 0 | d <- [2 .. floor (sqrt (fromIntegral n))], isPrime d] ``` -Convert it to unfixed form:+This is certainly an expensive recursive computation and we would like+to speed up its evaluation by wrappping into a caching layer.+Convert the predicate to an unfixed form such that `isPrime = fix isPrimeF`:  ```haskell isPrimeF :: (Word -> Bool) -> Word -> Bool-isPrimeF f n-  | n < 2     = False-  | n < 4     = True-  | even n    = False-  | otherwise = and [ n `rem` d /= 0 | d <- [3, 5 .. ceiling (sqrt (fromIntegral n))], f d]+isPrimeF f n = n > 1 && and [ n `rem` d /= 0 | d <- [2 .. floor (sqrt (fromIntegral n))], f d] ``` -Create its memoized version for faster evaluation:+Now create its memoized version for rapid evaluation:  ```haskell-isPrimeBS :: Chimera-isPrimeBS = tabulateFix isPrimeF- isPrime' :: Word -> Bool-isPrime' = index isPrimeBS+isPrime' = memoizeFix isPrimeF ```

@@ -1,126 +0,0 @@-{-# LANGUAGE DeriveFunctor        #-}-{-# LANGUAGE LambdaCase           #-}-{-# LANGUAGE UndecidableInstances #-}--module Main where--import Data.Bits-import Data.Chimera.WheelMapping--data Expr r-  = Var-  | Const  !Int-  | ShiftL !Int r-  | ShiftR !Int r-  | Add r r-  | Sub r r-  | And r r-  | Or  r r-  | Xor r r-  deriving (Eq, Ord, Functor)--instance Show r => Show (Expr r) where-  showsPrec d = \case-    Var        -> showString "i"-    Const n    -> showString (show n)-    ShiftL k r -> showParen (d > 8) $ showsPrec 9 r . showString " `shiftL` " . showsPrec 9 k-    ShiftR k r -> showParen (d > 8) $ showsPrec 9 r . showString " `shiftR` " . showsPrec 9 k-    Add r s    -> showParen (d > 6) $ showsPrec 7 r . showString " + " . showsPrec 7 s-    Sub r s    -> showParen (d > 6) $ showsPrec 7 r . showString " - " . showsPrec 7 s-    And r s    -> showParen (d > 7) $ showsPrec 8 r . showString " .&. " . showsPrec 8 s-    Or  r s    -> showParen (d > 5) $ showsPrec 6 r . showString " .|. " . showsPrec 6 s-    Xor r s    -> showParen (d > 6) $ showsPrec 7 r . showString " `xor` " . showsPrec 7 s--newtype Fix t = Fix { unFix :: t (Fix t) }--instance Eq (t (Fix t)) => Eq (Fix t) where-  (Fix r) == (Fix s) = r == s--instance Ord (t (Fix t)) => Ord (Fix t) where-  compare (Fix r) (Fix s) = compare r s--instance Show (t (Fix t)) => Show (Fix t) where-  showsPrec d (Fix t) = showsPrec d t--exprs :: [Fix Expr]-exprs = concat bucket-  where-    seed :: [Fix Expr]-    seed = Fix Var : [Fix $ Const 1, Fix $ Const 2]--    bucket = map f [0..]--    maxShift = 2--    unaries :: Fix Expr -> [Fix Expr]-    unaries e = case unFix e of-      ShiftL{} -> []-      ShiftR k _ -> [ Fix (ShiftL l e) | l <- [k .. maxShift] ]-      _ -> concat [ [Fix (ShiftL l e), Fix (ShiftR l e)] | l <- [1 .. maxShift] ]--    f :: Int -> [Fix Expr]-    f 0 = []-    f 1 = seed-    f n = concatMap unaries bucket1-        ++ concatMap (\(x, y) -> [Fix $ Add x y, Fix $ Sub x y, Fix $ And x y, Fix $ Or x y])-          [(x, y) | i <- [0..n-1], i <= n-1-i, x <- bucket !! i, y <- bucket !! (n-1-i), x /= y]-      where-        bucket1 = bucket !! (n - 1)--cata :: Functor t => (t r -> r) -> Fix t -> r-cata f (Fix t) = f (fmap (cata f) t)--eval :: Int -> Fix Expr -> Int-eval v = cata (evalF v)--evalF :: Int -> Expr Int -> Int-evalF v = \case-  Var        -> v-  Const i    -> i-  ShiftL k r -> r `shiftL` k-  ShiftR k r -> r `shiftR` k-  Add r s    -> r + s-  Sub r s    -> r - s-  And r s    -> r .&. s-  Or  r s    -> r .|. s-  Xor r s    -> r `xor` s--toWheel30' :: Int -> Int-toWheel30' = fromIntegral . toWheel30 . fromIntegral--fromWheel30' :: Int -> Int-fromWheel30' = fromIntegral . fromWheel30 . fromIntegral--toWheel210' :: Int -> Int-toWheel210' = fromIntegral . toWheel210 . fromIntegral--fromWheel210' :: Int -> Int-fromWheel210' = fromIntegral . fromWheel210 . fromIntegral--functional :: Int -> Fix Expr -> Maybe Int-functional bestKnown e = alg (1000, -1000) diffs-  where-    ys = [0..47] -- map (fromIntegral . fromWheel210) [0..47]-    diffs = zipWith (-) (map (flip eval e) ys) $ map fromWheel210' [0..47] -- (map fromWheel30' ys)--    alg :: (Int, Int) -> [Int] -> Maybe Int-    alg (currMin, currMax) [] = Just $ currMax - currMin-    alg (currMin, currMax) (x : xs) = if currMax - currMin > bestKnown-      then Nothing-      else alg (newMin, newMax) xs-      where-        newMin = currMin `min` x-        newMax = currMax `max` x--findFunctional :: [(Fix Expr, Int)]-findFunctional = f 1000 exprs-  where-    f _ [] = []-    f acc (e : exs) = case mx of-      Nothing -> f acc exs-      Just x  -> if x <= acc then (e, x) : f x exs else f acc exs-      where-        mx = functional acc e--main :: IO ()-main = mapM_ (putStrLn . show) findFunctional

@@ -1,32 +0,0 @@-{-# OPTIONS_GHC -fno-warn-unused-imports #-}--module Main where--import Gauge.Main--import Data.Chimera.WheelMapping-import Data.Word--doBench :: String -> (Word -> Word) -> Benchmark-doBench name fn = bench name $ nf (sum . (map fn))   [0..46409]--main = defaultMain-  [ bgroup "toWheel . fromWheel"-    [ doBench   "2" $ toWheel2   . fromWheel2-    , doBench   "6" $ toWheel6   . fromWheel6-    , doBench  "30" $ toWheel30  . fromWheel30-    , doBench "210" $ toWheel210 . fromWheel210-    ]-  , bgroup "toWheel"-    [ doBench   "2" $ toWheel2-    , doBench   "6" $ toWheel6-    , doBench  "30" $ toWheel30-    , doBench "210" $ toWheel210-    ]-  , bgroup "fromWheel"-    [ doBench   "2" $ fromWheel2-    , doBench   "6" $ fromWheel6-    , doBench  "30" $ fromWheel30-    , doBench "210" $ fromWheel210-    ]-  ]

@@ -1,16 +1,43 @@ name: chimera-version: 0.2.0.0+version: 0.3.0.0 cabal-version: >=1.10 build-type: Simple license: BSD3 license-file: LICENSE-copyright: 2017-2018 Bodigrim+copyright: 2017-2019 Bodigrim maintainer: andrew.lelechenko@gmail.com homepage: https://github.com/Bodigrim/chimera#readme-synopsis: Lazy, infinite streams with O(1) indexing.+category: Data+synopsis: Lazy infinite streams with O(1) indexing author: Bodigrim extra-source-files:   README.md+tested-with: GHC==8.8.1, 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:+  .+  * 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.+    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.  source-repository head   type: git@@ -18,58 +45,30 @@  library   build-depends:-    base >=4.5 && <5,-    ghc-prim,+    base >=4.9 && <5,     vector-  if impl(ghc <7.10)-    build-depends:-      transformers -any   exposed-modules:     Data.Chimera-    Data.Chimera.Bool     Data.Chimera.ContinuousMapping-    Data.Chimera.Unboxed     Data.Chimera.WheelMapping   other-modules:     Data.Chimera.Compat     Data.Chimera.FromIntegral   default-language: Haskell2010-  ghc-options: -Wall -O2+  ghc-options: -Wall  test-suite test   build-depends:     base >=4.5 && <5,-    chimera -any,+    chimera,     QuickCheck >=2.10,-    tasty -any,-    tasty-hunit -any,-    tasty-quickcheck -any,-    tasty-smallcheck -any,-    vector -any+    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 -O2--benchmark bench-  build-depends:-    base >=4.5 && <5,-    chimera -any,-    gauge -any-  type: exitcode-stdio-1.0-  main-is: Bench.hs-  default-language: Haskell2010-  hs-source-dirs: bench-  ghc-options: -O2--executable find-foo-  buildable: False-  build-depends:-    base >=4.5 && <5,-    chimera -any,-    vector -any-  main-is: find-foo.hs-  default-language: Haskell2010-  hs-source-dirs: app-  ghc-options: -Wall -O2+  ghc-options: -Wall

@@ -1,6 +1,6 @@ {-# LANGUAGE ScopedTypeVariables #-} -{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}  module Main where @@ -12,61 +12,26 @@ import Data.Bits import Data.Function (fix) import Data.List+import qualified Data.Vector.Generic as G import qualified Data.Vector.Unboxed as U-import Data.Word -import qualified Data.Chimera.Bool as BS import Data.Chimera.ContinuousMapping import Data.Chimera.WheelMapping import qualified Data.Chimera as Ch-import qualified Data.Chimera.Unboxed as ChU -instance Arbitrary BS.Chimera where-  arbitrary = BS.tabulateM (const arbitrary)--instance Arbitrary a => Arbitrary (Ch.Chimera a) where+instance (G.Vector v a, Arbitrary a) => Arbitrary (Ch.Chimera v a) where   arbitrary = Ch.tabulateM (const arbitrary) -instance (Arbitrary a, U.Unbox a) => Arbitrary (ChU.Chimera a) where-  arbitrary = ChU.tabulateM (const arbitrary)- main :: IO () main = defaultMain $ testGroup "All"-  [ bitStreamTests+  [ contMapTests+  , wheelMapTests   , chimeraTests-  , chimeraUnboxedTests   ] -bitStreamTests :: TestTree-bitStreamTests = testGroup "BitStream"-  [ QC.testProperty "index . tabulate = id" $-    \(Fun _ f) ix ->-      let jx = ix `mod` 65536 in-        f jx === BS.index (BS.tabulate f) jx-  , QC.testProperty "index . tabulateFix = fix" $-    \(Fun _ g) ix ->-      let jx = ix `mod` 65536 in-        let f = mkUnfix g in-          fix f jx === BS.index (BS.tabulateFix f) jx--  , QC.testProperty "trueIndices" $-    \(Fun _ f) ->-      take 100 (BS.trueIndices $ BS.tabulate f) === take 100 (filter f [0..])-  , QC.testProperty "falseIndices" $-    \(Fun _ f) ->-      take 100 (BS.falseIndices $ BS.tabulate f) === take 100 (filter (Prelude.not . f) [0..])--  , QC.testProperty "mapWithKey" $-    \(Blind bs) (Fun _ g) ix ->-      let jx = ix `mod` 65536 in-        g (jx, BS.index bs jx) === BS.index (BS.mapWithKey (curry g) bs) jx--  , QC.testProperty "zipWithKey" $-    \(Blind bs1) (Blind bs2) (Fun _ g) ix ->-      let jx = ix `mod` 65536 in-        g (jx, BS.index bs1 jx, BS.index bs2 jx) === BS.index (BS.zipWithKey (\i b1 b2 -> g (i, b1, b2)) bs1 bs2) jx--  , testGroup "wordToInt . intToWord"+contMapTests :: TestTree+contMapTests = testGroup "ContinuousMapping"+  [ testGroup "wordToInt . intToWord"     [ QC.testProperty "random" $ \i -> w2i_i2w i === i     , H.testCase "maxBound" $ assertEqual "should be equal" maxBound (w2i_i2w maxBound)     , H.testCase "minBound" $ assertEqual "should be equal" minBound (w2i_i2w minBound)@@ -90,8 +55,11 @@   , 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))     ]+  ] -  , testGroup "toWheel . fromWheel"+wheelMapTests :: TestTree+wheelMapTests = testGroup "WheelMapping"+  [ testGroup "toWheel . fromWheel"     [ QC.testProperty   "2" $ \(Shrink2 x) -> x < maxBound `div` 2 ==> toWheel2   (fromWheel2   x) === x     , QC.testProperty   "6" $ \(Shrink2 x) -> x < maxBound `div` 3 ==> toWheel6   (fromWheel6   x) === x     , QC.testProperty  "30" $ \(Shrink2 x) -> x < maxBound `div` 4 ==> toWheel30  (fromWheel30  x) === x@@ -104,45 +72,33 @@   [ QC.testProperty "index . tabulate = id" $     \(Fun _ (f :: Word -> Bool)) ix ->       let jx = ix `mod` 65536 in-        f jx === Ch.index (Ch.tabulate f) jx+        f jx === Ch.index (Ch.tabulate f :: Ch.Chimera U.Vector 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) jx--  , QC.testProperty "mapWithKey" $-    \(Blind bs) (Fun _ (g :: (Word, Bool) -> Bool)) ix ->-      let jx = ix `mod` 65536 in-        g (jx, Ch.index bs jx) === Ch.index (Ch.mapWithKey (curry g) bs) jx+          fix f jx === Ch.index (Ch.tabulateFix f :: Ch.Chimera U.Vector Bool) jx -  , QC.testProperty "zipWithKey" $-    \(Blind bs1) (Blind bs2) (Fun _ (g :: (Word, Bool, Bool) -> Bool)) ix ->+  , QC.testProperty "iterate" $+    \(Fun _ (f :: Word -> Word)) seed ix ->       let jx = ix `mod` 65536 in-        g (jx, Ch.index bs1 jx, Ch.index bs2 jx) === Ch.index (Ch.zipWithKey (\i b1 b2 -> g (i, b1, b2)) bs1 bs2) jx-  ]+        iterate f seed !! fromIntegral jx === Ch.index (Ch.iterate f seed :: Ch.Chimera U.Vector Word) jx -chimeraUnboxedTests :: TestTree-chimeraUnboxedTests = testGroup "Chimera Unboxed"-  [ QC.testProperty "index . tabulate = id" $-    \(Fun _ (f :: Word -> Bool)) ix ->-      let jx = ix `mod` 65536 in-        f jx === ChU.index (ChU.tabulate f) jx-  , QC.testProperty "index . tabulateFix = fix" $-    \(Fun _ g) ix ->+  , QC.testProperty "cycle" $+    \xs ix -> not (null xs) ==>       let jx = ix `mod` 65536 in-        let f = mkUnfix g in-          fix f jx === ChU.index (ChU.tabulateFix f) jx+        let vs = U.fromList xs :: U.Vector Bool in+          vs U.! (fromIntegral jx `mod` U.length vs) === Ch.index (Ch.cycle vs) jx    , QC.testProperty "mapWithKey" $-    \(Blind bs) (Fun _ (g :: (Word, Bool) -> Bool)) ix ->+    \(Blind bs) (Fun _ (g :: Word -> Word)) ix ->       let jx = ix `mod` 65536 in-        g (jx, ChU.index bs jx) === ChU.index (ChU.mapWithKey (curry g) bs) jx+        g (Ch.index bs jx) === Ch.index (Ch.mapSubvectors (G.map g) bs :: Ch.Chimera U.Vector Word) jx    , QC.testProperty "zipWithKey" $-    \(Blind bs1) (Blind bs2) (Fun _ (g :: (Word, Bool, Bool) -> Bool)) ix ->+    \(Blind bs1) (Blind bs2) (Fun _ (g :: (Word, Word) -> Word)) ix ->       let jx = ix `mod` 65536 in-        g (jx, ChU.index bs1 jx, ChU.index bs2 jx) === ChU.index (ChU.zipWithKey (\i b1 b2 -> g (i, b1, b2)) bs1 bs2) jx+        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   ]  -------------------------------------------------------------------------------