summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Data/BitStream.hs265
-rw-r--r--Data/BitStream/ContinuousMapping.hs171
-rw-r--r--Data/BitStream/WheelMapping.hs168
-rw-r--r--LICENSE30
-rw-r--r--README.md81
-rw-r--r--Setup.hs2
-rw-r--r--app/find-foo.hs126
-rw-r--r--bench/Bench.hs30
-rw-r--r--bit-stream.cabal60
-rw-r--r--test/Test.hs90
10 files changed, 1023 insertions, 0 deletions
diff --git a/Data/BitStream.hs b/Data/BitStream.hs
new file mode 100644
index 0000000..b92c34a
--- /dev/null
+++ b/Data/BitStream.hs
@@ -0,0 +1,265 @@
+-- |
+-- Module: Data.BitStream
+-- Copyright: (c) 2017 Andrew Lelechenko
+-- Licence: MIT
+-- Maintainer: Andrew Lelechenko <andrew.lelechenko@gmail.com>
+--
+-- Lazy, 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
+-- 'BitStream' using 'tabulate' and access this stream via 'index'
+-- instead of recalculation of @isOdd@:
+--
+-- > isOddBS :: BitStream
+-- > 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 :: BitStream
+-- > 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 :: BitStream
+-- > isPrimeBS = tabulateFix isPrimeF
+-- >
+-- > isPrime' :: Word -> Bool
+-- > isPrime' = index isPrimeBS
+
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Data.BitStream
+ ( BitStream
+ , tabulate
+ , tabulateFix
+ , tabulateM
+ , tabulateFixM
+ , index
+
+ , 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 Unsafe.Coerce
+
+-- | Compact representation of infinite stream of 'Bool'.
+--
+-- 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@.
+--
+-- It also offers indexing in constant time.
+-- Compare it to linear time for lists and logarithmic time for sets.
+--
+-- Moreover, it is lazy: querying n-th element triggers computation
+-- of first @max(64, 2 ^ ceiling (logBase 2 n))@ elements only. On contrary,
+-- sets and unboxed vectors are completely strict.
+newtype BitStream = BitStream { _unBitStream :: V.Vector (U.Vector Word) }
+
+word2int :: Word -> Int
+word2int = unsafeCoerce
+
+int2word :: Int -> Word
+int2word = unsafeCoerce
+
+bits :: Int
+bits = finiteBitSize (0 :: Word)
+
+bitsLog :: Int
+bitsLog = bits - 1 - countLeadingZeros (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) -> BitStream
+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 BitStream
+tabulateM f = do
+ z <- tabulateW 0
+ zs <- V.generateM (bits - bitsLog) tabulateU
+ return $ BitStream $ 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 zeroBits [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 BitStream #-}
+
+-- | 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) -> BitStream
+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 BitStream
+tabulateFixM uf = bs
+ where
+ bs :: m BitStream
+ bs = do
+ z <- tabulateW (fix uf) 0
+ zs <- V.generateM (bits - bitsLog) tabulateU
+ return $ BitStream $ 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 zeroBits [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 BitStream #-}
+
+-- | 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 :: BitStream -> Word -> Bool
+index (BitStream 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 = finiteBitSize i - 1 - bitsLog - countLeadingZeros 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)
+
+-- | Element-wise 'not'.
+not :: BitStream -> BitStream
+not (BitStream vus) = BitStream $ V.map (U.map (maxBound -)) vus
+
+-- | Map over all indices and respective elements in the stream.
+mapWithKey :: (Word -> Bool -> Bool) -> BitStream -> BitStream
+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) -> BitStream -> m BitStream
+traverseWithKey f (BitStream bs) = BitStream <$> V.imapM g 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 zeroBits [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) -> BitStream -> Identity BitStream #-}
+
+-- | Element-wise 'and'.
+and :: BitStream -> BitStream -> BitStream
+and (BitStream vus) (BitStream wus) = BitStream $ V.zipWith (U.zipWith (.&.)) vus wus
+
+-- | Element-wise 'or'.
+or :: BitStream -> BitStream -> BitStream
+or (BitStream vus) (BitStream wus) = BitStream $ 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) -> BitStream -> BitStream -> BitStream
+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) -> BitStream -> BitStream -> m BitStream
+zipWithKeyM f (BitStream bs1) (BitStream bs2) = BitStream <$> V.izipWithM g bs1 bs2
+ 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 zeroBits [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) -> BitStream -> BitStream -> Identity BitStream #-}
diff --git a/Data/BitStream/ContinuousMapping.hs b/Data/BitStream/ContinuousMapping.hs
new file mode 100644
index 0000000..f3ff4c6
--- /dev/null
+++ b/Data/BitStream/ContinuousMapping.hs
@@ -0,0 +1,171 @@
+-- |
+-- Module: Data.BitStream.ContinuousMapping
+-- Copyright: (c) 2017 Andrew Lelechenko
+-- Licence: MIT
+-- 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.
+--
+-- __ Example__
+--
+-- 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.BitStream.tabulate'
+-- accepts predicates from 'Word' to 'Bool' only.
+--
+-- The first step is to define:
+--
+-- > board'' :: Int -> Int -> Bool
+-- > board'' x y = board' (intToWord x) (intToWord y)
+-- >
+-- > board' :: Word -> Word -> Bool
+-- > board' x y = board (wordToInt x) (wordToInt y)
+--
+-- 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:
+--
+-- > 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)
+--
+-- Now we are ready to insert memoizing layer:
+--
+-- > board'' :: Int -> Int -> Bool
+-- > board'' x y = index board' $ toZCurve (intToWord x) (intToWord y)
+-- >
+-- > board' :: BitStream
+-- > board' = tabulate $
+-- > \z -> let (x, y) = fromZCurve z in
+-- > board (wordToInt x) (wordToInt y)
+
+{-# LANGUAGE BinaryLiterals #-}
+
+module Data.BitStream.ContinuousMapping
+ ( intToWord
+ , wordToInt
+ , toZCurve
+ , fromZCurve
+ , toZCurve3
+ , fromZCurve3
+ ) where
+
+import Data.Bits
+import Unsafe.Coerce
+
+word2int :: Word -> Int
+word2int = unsafeCoerce
+
+int2word :: Int -> Word
+int2word = unsafeCoerce
+
+-- | Total map, which satisfies inequality
+-- abs ('intToWord' x - 'intToWord' y) ≤ 2 abs(x - y).
+--
+-- Note that this is not the case for 'fromIntegral' :: 'Int' -> 'Word',
+-- because it has a discontinuity between −1 and 0.
+--
+-- > > 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
+ | otherwise = int2word (-1 - i) `shiftL` 1 + 1
+
+-- | Inverse for 'intToWord'.
+--
+-- > > 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)
+ | otherwise = negate (word2int (w `shiftR` 1)) - 1
+
+-- | 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]
+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)]
+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]
+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)]
+fromZCurve3 :: Word -> (Word, Word, Word)
+fromZCurve3 z = (compact1by2 z, compact1by2 (z `shiftR` 1), compact1by2 (z `shiftR` 2))
+
+-- Inspired by https://fgiesen.wordpress.com/2009/12/13/decoding-morton-codes/
+part1by1 :: Word -> Word
+part1by1 x = x5
+ where
+ x0 = x .&. 0b0000000000000000000000000000000011111111111111111111111111111111
+ x1 = (x0 `xor` (x0 `shiftL` 16)) .&. 0b0000000000000000111111111111111100000000000000001111111111111111
+ x2 = (x1 `xor` (x1 `shiftL` 8)) .&. 0b0000000011111111000000001111111100000000111111110000000011111111
+ x3 = (x2 `xor` (x2 `shiftL` 4)) .&. 0b0000111100001111000011110000111100001111000011110000111100001111
+ x4 = (x3 `xor` (x3 `shiftL` 2)) .&. 0b0011001100110011001100110011001100110011001100110011001100110011
+ x5 = (x4 `xor` (x4 `shiftL` 1)) .&. 0b0101010101010101010101010101010101010101010101010101010101010101
+
+-- Inspired by https://fgiesen.wordpress.com/2009/12/13/decoding-morton-codes/
+part1by2 :: Word -> Word
+part1by2 x = x5
+ where
+ x0 = x .&. 0b0000000000000000000000000000000011111111111111111111111111111111
+ x1 = (x0 `xor` (x0 `shiftL` 32)) .&. 0b1111111111111111000000000000000000000000000000001111111111111111
+ x2 = (x1 `xor` (x1 `shiftL` 16)) .&. 0b0000000011111111000000000000000011111111000000000000000011111111
+ x3 = (x2 `xor` (x2 `shiftL` 8)) .&. 0b1111000000001111000000001111000000001111000000001111000000001111
+ x4 = (x3 `xor` (x3 `shiftL` 4)) .&. 0b0011000011000011000011000011000011000011000011000011000011000011
+ x5 = (x4 `xor` (x4 `shiftL` 2)) .&. 0b0001001001001001001001001001001001001001001001001001001001001001
+
+-- Inspired by https://fgiesen.wordpress.com/2009/12/13/decoding-morton-codes/
+compact1by1 :: Word -> Word
+compact1by1 x = x5
+ where
+ x0 = x .&. 0b0101010101010101010101010101010101010101010101010101010101010101
+ x1 = (x0 `xor` (x0 `shiftR` 1)) .&. 0b0011001100110011001100110011001100110011001100110011001100110011
+ x2 = (x1 `xor` (x1 `shiftR` 2)) .&. 0b0000111100001111000011110000111100001111000011110000111100001111
+ x3 = (x2 `xor` (x2 `shiftR` 4)) .&. 0b0000000011111111000000001111111100000000111111110000000011111111
+ x4 = (x3 `xor` (x3 `shiftR` 8)) .&. 0b0000000000000000111111111111111100000000000000001111111111111111
+ x5 = (x4 `xor` (x4 `shiftR` 16)) .&. 0b0000000000000000000000000000000011111111111111111111111111111111
+
+-- Inspired by https://fgiesen.wordpress.com/2009/12/13/decoding-morton-codes/
+compact1by2 :: Word -> Word
+compact1by2 x = x5
+ where
+ x0 = x .&. 0b0001001001001001001001001001001001001001001001001001001001001001
+ x1 = (x0 `xor` (x0 `shiftR` 2)) .&. 0b0011000011000011000011000011000011000011000011000011000011000011
+ x2 = (x1 `xor` (x1 `shiftR` 4)) .&. 0b1111000000001111000000001111000000001111000000001111000000001111
+ x3 = (x2 `xor` (x2 `shiftR` 8)) .&. 0b0000000011111111000000000000000011111111000000000000000011111111
+ x4 = (x3 `xor` (x3 `shiftR` 16)) .&. 0b1111111111111111000000000000000000000000000000001111111111111111
+ x5 = (x4 `xor` (x4 `shiftR` 32)) .&. 0b0000000000000000000000000000000011111111111111111111111111111111
diff --git a/Data/BitStream/WheelMapping.hs b/Data/BitStream/WheelMapping.hs
new file mode 100644
index 0000000..4129f7a
--- /dev/null
+++ b/Data/BitStream/WheelMapping.hs
@@ -0,0 +1,168 @@
+-- |
+-- Module: Data.BitStream.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. Mostly useful 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:
+--
+-- > isPrimeBS :: BitStream
+-- > isPrimeBS = tabulate isPrime
+-- >
+-- > isPrime' :: Word -> Bool
+-- > isPrime' = index isPrimeBS
+--
+-- 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
+-- numbers only:
+--
+-- > isPrimeBS2 :: BitStream
+-- > isPrimeBS2 = tabulate (\n -> isPrime (2 * n + 1))
+-- >
+-- > isPrime2' :: Word -> Bool
+-- > isPrime2' n
+-- > | n == 2 = True
+-- > | even n = False
+-- > | otherwise = index isPrimeBS2 ((n - 1) `quot` 2)
+--
+-- or, using 'fromWheel2' and 'toWheel2',
+--
+-- > isPrimeBS2 :: BitStream
+-- > isPrimeBS2 = tabulate (isPrime . fromWheel2)
+-- >
+-- > isPrime2' :: Word -> Bool
+-- > isPrime2' n
+-- > | n == 2 = True
+-- > | even n = False
+-- > | otherwise = index isPrimeBS2 (toWheel2 n)
+--
+-- 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
+--
+-- > isPrimeBS6 :: BitStream
+-- > isPrimeBS6 = tabulate (isPrime . fromWheel6)
+-- >
+-- > isPrime6' :: Word -> Bool
+-- > isPrime6' n
+-- > | n `elem` [2, 3] = True
+-- > | n `gcd` 6 /= 1 = False
+-- > | otherwise = index isPrimeBS6 (toWheel6 n)
+--
+-- or
+--
+-- > isPrimeBS30 :: BitStream
+-- > 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)
+
+module Data.BitStream.WheelMapping
+ ( fromWheel2
+ , toWheel2
+ , fromWheel6
+ , toWheel6
+ , fromWheel30
+ , toWheel30
+ , fromWheel210
+ , toWheel210
+ ) where
+
+import Data.Bits
+import qualified Data.Vector.Unboxed as U
+import Data.Word
+
+word2int :: Word -> Int
+word2int = fromIntegral
+
+-- | Left inverse for 'fromWheel2'. Monotonically non-decreasing function.
+--
+-- prop> toWheel2 . fromWheel2 == id
+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]
+fromWheel2 :: Word -> Word
+fromWheel2 i = i `shiftL` 1 + 1
+{-# INLINE fromWheel2 #-}
+
+-- | Left inverse for 'fromWheel6'. Monotonically non-decreasing function.
+--
+-- prop> toWheel6 . fromWheel6 == id
+toWheel6 :: Word -> Word
+toWheel6 i = i `quot` 3
+{-# 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]
+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
+toWheel30 :: Word -> Word
+toWheel30 i = q `shiftL` 3 + (r + r `shiftR` 4) `shiftR` 2
+ where
+ (q, r) = i `quotRem` 30
+{-# 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]
+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
+toWheel210 :: Word -> Word
+toWheel210 i = q * 48 + fromIntegral (toWheel210Table `U.unsafeIndex` word2int r)
+ where
+ (q, r) = i `quotRem` 210
+{-# INLINE toWheel210 #-}
+
+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]
+
+-- | '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]
+fromWheel210 :: Word -> Word
+fromWheel210 i = q * 210 + fromIntegral (fromWheel210Table `U.unsafeIndex` word2int r)
+ where
+ (q, r) = i `quotRem` 48
+{-# INLINE fromWheel210 #-}
+
+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]
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..7e1b7f2
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright Bodigrim (c) 2017
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+
+ * Redistributions in binary form must reproduce the above
+ copyright notice, this list of conditions and the following
+ disclaimer in the documentation and/or other materials provided
+ with the distribution.
+
+ * Neither the name of Bodigrim nor the names of other
+ contributors may be used to endorse or promote products derived
+ from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. \ No newline at end of file
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..90b8daa
--- /dev/null
+++ b/README.md
@@ -0,0 +1,81 @@
+# bit-stream
+
+Lazy, infinite, compact stream of `Bool` with O(1) indexing.
+Most useful for memoization of predicates.
+
+## Example 1
+
+Consider following predicate:
+
+```haskell
+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
+`BitStream` using `tabulate` and access this stream via `index`
+instead of recalculation of `isOdd`:
+
+```haskell
+isOddBS :: BitStream
+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`:
+
+```haskell
+isOddF :: (Word -> Bool) -> Word -> Bool
+isOddF _ 0 = False
+isOddF f n = not (f (n - 1))
+```
+
+and use `tabulateFix`:
+
+```haskell
+isOddBS :: BitStream
+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.
+
+```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]
+```
+
+Convert it to unfixed form:
+
+```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]
+```
+
+Create its memoized version for faster evaluation:
+
+```haskell
+isPrimeBS :: BitStream
+isPrimeBS = tabulateFix isPrimeF
+
+isPrime' :: Word -> Bool
+isPrime' = index isPrimeBS
+```
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/app/find-foo.hs b/app/find-foo.hs
new file mode 100644
index 0000000..c73b944
--- /dev/null
+++ b/app/find-foo.hs
@@ -0,0 +1,126 @@
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Main where
+
+import Data.Bits
+import Data.BitStream.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
diff --git a/bench/Bench.hs b/bench/Bench.hs
new file mode 100644
index 0000000..c9a43aa
--- /dev/null
+++ b/bench/Bench.hs
@@ -0,0 +1,30 @@
+module Main where
+
+import Criterion.Main
+
+import Data.BitStream.WheelMapping
+
+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
+ ]
+ , doBench "toIdx" $ toIdx
+ , bgroup "fromWheel"
+ [ doBench "2" $ fromWheel2
+ , doBench "6" $ fromWheel6
+ , doBench "30" $ fromWheel30
+ , doBench "210" $ fromWheel210
+ ]
+ ]
diff --git a/bit-stream.cabal b/bit-stream.cabal
new file mode 100644
index 0000000..e0d2b60
--- /dev/null
+++ b/bit-stream.cabal
@@ -0,0 +1,60 @@
+name: bit-stream
+version: 0.1.0.0
+homepage: https://github.com/Bodigrim/bit-stream#readme
+license: BSD3
+license-file: LICENSE
+author: Bodigrim
+maintainer: andrew.lelechenko@gmail.com
+copyright: 2017 Bodigrim
+build-type: Simple
+extra-source-files: README.md
+cabal-version: >=1.10
+synopsis: Lazy, infinite, compact stream of 'Bool' with O(1) indexing.
+
+library
+ exposed-modules: Data.BitStream
+ Data.BitStream.ContinuousMapping
+ Data.BitStream.WheelMapping
+ build-depends: base >= 4.8 && < 5
+ , vector
+ default-language: Haskell2010
+ ghc-options: -Wall -O2
+
+source-repository head
+ type: git
+ location: https://github.com/Bodigrim/bit-stream
+
+test-suite test
+ type: exitcode-stdio-1.0
+ hs-source-dirs: test
+ ghc-options: -Wall -O2
+ main-is: Test.hs
+ default-language: Haskell2010
+ build-depends: base >= 4.8 && < 5
+ , bit-stream
+ , QuickCheck >= 2.10
+ , tasty
+ , tasty-hunit
+ , tasty-quickcheck
+ , tasty-smallcheck
+ , vector
+
+executable find-foo
+ buildable: False
+ main-is: find-foo.hs
+ hs-source-dirs: app
+ build-depends: base >= 4.8 && < 5
+ , bit-stream
+ , vector
+ default-language: Haskell2010
+ ghc-options: -Wall -O2
+
+benchmark bench
+ type: exitcode-stdio-1.0
+ main-is: Bench.hs
+ hs-source-dirs: bench
+ build-depends: base >= 4.8 && < 5
+ , bit-stream
+ , criterion
+ default-language: Haskell2010
+ ghc-options: -O2
diff --git a/test/Test.hs b/test/Test.hs
new file mode 100644
index 0000000..bef612f
--- /dev/null
+++ b/test/Test.hs
@@ -0,0 +1,90 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module Main where
+
+import Test.QuickCheck.Function
+import Test.Tasty
+import Test.Tasty.HUnit as H
+import Test.Tasty.QuickCheck as QC
+
+import Data.Bits
+import Data.Function (fix)
+import Data.List
+
+import Data.BitStream as BS
+import Data.BitStream.ContinuousMapping
+import Data.BitStream.WheelMapping
+
+instance Arbitrary BitStream where
+ arbitrary = tabulateM (const arbitrary)
+
+main :: IO ()
+main = defaultMain tests
+
+tests :: TestTree
+tests = testGroup "All"
+ [ QC.testProperty "index . tabulate = id" $
+ \(Fun _ f) ix ->
+ let jx = ix `mod` 65536 in
+ f jx === index (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 === index (tabulateFix f) jx
+
+ , QC.testProperty "mapWithKey" $
+ \(Blind bs) (Fun _ g) ix ->
+ let jx = ix `mod` 65536 in
+ g (jx, index bs jx) === 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, index bs1 jx, index bs2 jx) === index (BS.zipWithKey (\i b1 b2 -> g (i, b1, b2)) bs1 bs2) jx
+
+ , 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)
+ ]
+ , testGroup "intToWord . wordToInt"
+ [ QC.testProperty "random" $ \i -> i2w_w2i i === i
+ , H.testCase "maxBound" $ assertEqual "should be equal" maxBound (i2w_w2i maxBound)
+ , H.testCase "minBound" $ assertEqual "should be equal" minBound (i2w_w2i minBound)
+ ]
+
+ , testGroup "to . from Z-curve 2D"
+ [ QC.testProperty "random" $ \z -> (\(x, y) -> toZCurve x y) (fromZCurve z) === z
+ ]
+ , 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))
+ ]
+
+ , testGroup "to . from Z-curve 3D"
+ [ QC.testProperty "random" $ \t -> (\(x, y, z) -> toZCurve3 x y z) (fromZCurve3 t) === t `rem` (1 `shiftL` 63)
+ ]
+ , 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"
+ [ 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
+ , QC.testProperty "210" $ \(Shrink2 x) -> x < maxBound `div` 5 ==> toWheel210 (fromWheel210 x) === x
+ ]
+ ]
+
+w2i_i2w :: Int -> Int
+w2i_i2w = wordToInt . intToWord
+
+i2w_w2i :: Word -> Word
+i2w_w2i = intToWord . wordToInt
+
+mkUnfix :: (Word -> [Word]) -> (Word -> Bool) -> Word -> Bool
+mkUnfix splt f x
+ = foldl' (==) True
+ $ map f
+ $ takeWhile (\y -> 0 <= y && y < x)
+ $ splt x