bv-little 1.0.1 → 1.1.0

raw patch · 5 files changed

+273/−39 lines, 5 filesdep ~QuickCheckdep ~deepseqdep ~hashablePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: QuickCheck, deepseq, hashable, integer-gmp, keys, mono-traversable, mono-traversable-keys, primitive, semigroups, text-show

API changes (from Hackage documentation)

Files

• bv-little.cabal +26/−26
• changelog.md +6/−0
• src/Data/BitVector/LittleEndian.hs +191/−12
• stack.yaml +1/−1
• test/TestSuite.hs +49/−0

@@ -1,5 +1,5 @@ name:                bv-little-version:             1.0.1+version:             1.1.0 synopsis:            Efficient little-endian bit vector library category:            Data, Bit Vectors license:             BSD3@@ -38,20 +38,20 @@  library -  build-depends:      base             >= 4.5.1 && < 5-                    , deepseq-                    , hashable-                    , integer-gmp-                    , keys-                    , mono-traversable-                    , mono-traversable-keys-                    , primitive-                    , QuickCheck-                    , text-show+  build-depends:      base                  >= 4.5.1 && < 5+                    , deepseq               >= 1.4.1.1+                    , hashable              >= 1.2.3.2+                    , integer-gmp           >= 1.0+                    , keys                  >= 3.10.1+                    , mono-traversable      >= 1.0.5.0+                    , mono-traversable-keys >= 0.1.0+                    , primitive             >= 0.6.4.0+                    , QuickCheck            >= 2.8+                    , text-show             >= 3.2.1    if !impl(ghc >= 8.0) -    build-depends:    semigroups       >= 0.18  && < 0.19+    build-depends:    semigroups            >= 0.18  && < 1.0    default-language: Haskell2010 @@ -104,23 +104,23 @@    main-is:          TestSuite.hs -  build-depends:      base             >= 4.5.1 && < 5+  build-depends:      base                  >= 4.5.1 && < 5                     , bv-little-                    , deepseq-                    , hashable-                    , mono-traversable-                    , mono-traversable-keys-                    , QuickCheck-                    , smallcheck       >= 1.1.5+                    , deepseq               >= 1.4.1.1+                    , hashable              >= 1.2.3.2+                    , mono-traversable      >= 1.0.5.0+                    , mono-traversable-keys >= 0.1.0+                    , QuickCheck            >= 2.8+                    , smallcheck            >= 1.1.5                     , tasty                     , tasty-hunit                     , tasty-quickcheck                     , tasty-smallcheck-                    , text-show+                    , text-show             >= 3.2.1    if !impl(ghc >= 8.0) -    build-depends:    semigroups       >= 0.18  && < 0.19+    build-depends:    semigroups       >= 0.18  && < 1.0                     , transformers    default-language: Haskell2010@@ -142,15 +142,15 @@   build-depends:      base             >= 4.5.1 && < 5                     , bv-little                     , criterion-                    , deepseq-                    , hashable-                    , mono-traversable-                    , QuickCheck+                    , deepseq          >= 1.4.1.1+                    , hashable         >= 1.2.3.2+                    , mono-traversable >= 1.0.5.0+                    , QuickCheck       >= 2.8                     , smallcheck       >= 1.1.5    if !impl(ghc >= 8.0) -    build-depends:    semigroups       >= 0.18  && < 0.19+    build-depends:    semigroups       >= 0.18  && < 1.0    default-language: Haskell2010 

@@ -2,6 +2,11 @@    * None +### [v1.1.0][5]++  * Added `rank` and `select` functions++ ### [v1.0.1][4]    * Correcting Eq instance to test for value equality and not construction equality@@ -72,3 +77,4 @@ [2]: https://github.com/recursion-ninja/bv-little/tree/v0.1.2 [3]: https://github.com/recursion-ninja/bv-little/tree/v1.0.0 [4]: https://github.com/recursion-ninja/bv-little/tree/v1.0.1+[5]: https://github.com/recursion-ninja/bv-little/tree/v1.1.0

@@ -41,9 +41,15 @@ -- intentional! To interact with a bit vector as an 'Integral' value, -- convert the 'BitVector' using either 'toSignedNumber' or 'toUnsignedNumber'. --+-- This module defines 'rank' and 'select' operations for 'BitVector' as a+-- <https://en.wikipedia.org/wiki/Succinct_data_structure succinct data structure>.+-- These operations are not /o(1)/ so 'BitVector' is not a /true/ succinct data+-- structure. However, it could potentially be extend to support this in the+-- future. -----------------------------------------------------------------------------  {-# LANGUAGE BangPatterns       #-}+{-# LANGUAGE CPP                #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric      #-} {-# LANGUAGE MagicHash          #-}@@ -64,6 +70,9 @@   , dimension   , isZeroVector   , subRange+  -- * Rank / Select+  , rank+  , select   ) where  @@ -81,7 +90,6 @@ import Data.Ord import Data.Primitive.ByteArray import Data.Semigroup-import Data.Word import GHC.Exts import GHC.Generics import GHC.Integer.GMP.Internals@@ -97,10 +105,20 @@     = BV     { dim :: {-# UNPACK #-} !Word -- ^ The /dimension/ of a bit vector.     , nat :: !Natural             -- ^ The value of a bit vector, as a natural number.-    } deriving ( Data-               , Generic-               , Typeable-               )+    } deriving+#ifdef MIN_VERSION_GLASGOW_HASKELL+#if MIN_VERSION_GLASGOW_HASKELL(8,2,0,0)+         ( Data             -- ^ @since 0.1.0+         , Generic          -- ^ @since 0.1.0+         , Typeable         -- ^ @since 0.1.0+         )+#else+         ( Data+         , Generic+         , Typeable+         )+#endif+#endif   -- |@@ -137,7 +155,7 @@       where         allBitsOn     = genBitVector $ Just True         allBitsOff    = genBitVector $ Just False-        anyBitValue   = genBitVector $ Nothing+        anyBitValue   = genBitVector   Nothing                  boundaryValue = do             let wrdVal = maxBound :: Word@@ -308,18 +326,19 @@         f :: ByteArray -> Int         f byteArr = g 0           where-            (q, r) = x `quotRem` 64-            wMask  = complement zeroBits `xor` (2 ^ r - 1) :: Word64+            (q, r) = x `quotRem` fromEnum bitsInWord+            wMask  = complement zeroBits `xor` (2 ^ r - 1) :: Word              g :: Int -> Int             g !i               | i >= q = countTrailingZeros $ wMask .|. value               | otherwise =-                  case countTrailingZeros value of-                    64 -> 64 + g (i+1)-                    v  -> v+                  let !v = countTrailingZeros value+                  in  if v == fromEnum bitsInWord+                      then v + g (i+1)+                      else v               where-                value :: Word64+                value :: Word                 value = byteArr `indexByteArray` i  @@ -1139,6 +1158,166 @@                     m | x == maxBound = x                       | otherwise     = x + 1                 in  BV (toEnum m) $ b .&. pred (1 `shiftL` m)++++-- |+-- Determine the number of /set/ bits in the 'BitVector' up to, /but not including/, index @k@.+--+-- To determine the number of /unset/ bits in the 'BitVector`, use @k - rank bv k@.+--+-- Uses "broadword programming." Efficient on small 'BitVector's (10^3).+--+-- /Time:/ \(\, \mathcal{O} \left( \frac{n}{w} \right) \), where \(w\) is the number of bits in a 'Word'.+--+-- /Since: 1.1.0/+--+-- ==== __Examples__+--+-- >>> let bv = fromNumber 128 0 `setBit` 0 `setBit` 65+--+-- >>> rank bv   0  -- Count how many ones in the first 0 bits (always returns 0)+-- 0+--+-- >>> rank bv   1  -- Count how many ones in the first 1 bits+-- 1+--+-- >>> rank bv   2  -- Count how many ones in the first 2 bits+-- 1+--+-- >>> rank bv  65  -- Count how many ones in the first 65 bits+-- 1+--+-- >>> rank bv  66  -- Count how many ones in the first 66 bits+-- 1+--+-- >>> rank bv 128  -- Count how many ones in all 128 bits+-- 2+--+-- >>> rank bv 129  -- Out-of-bounds, fails gracefully+-- 2+rank+  :: BitVector+  -> Word -- ^ \(k\), the rank index +  -> Word -- ^ Set bits within the rank index+rank             _ 0 = 0 -- There can be no set bits /before/ the 0-th bit+rank (BV 0      _) _ = 0 -- There can be no set bits in a bit-vector of length 0+rank (BV w natVal) k =+    let j = min k w+    in  case natVal of+          NatS#      v  -> wordRank (W# v) j+          NatJ# (BN# v) -> f (ByteArray v) j+  where+    f :: ByteArray -> Word -> Word+    f byteArr x = g x 0+      where+        g :: Word -> Int -> Word+        g !j !i+          | j < bitsInWord = wordRank value j+          | otherwise = let !v = toEnum $ popCount value+                        in   v + g (j - bitsInWord) (i+1)+          where+            value :: Word+            value = byteArr `indexByteArray` i+++-- |+-- Find the index of the k-th set bit in the 'BitVector'.+--+-- To find the index of the k-th /unset/ bit in the 'BitVector`, use @select (complement bv) k@.+--+-- Uses "broadword programming." Efficient on small 'BitVector's (10^3).+--+-- /Time:/ \(\, \mathcal{O} \left( \frac{n}{w} \right) \), where \(w\) is the number of bits in a 'Word'.+--+-- /Since: 1.1.0/+--+-- ==== __Examples__+--+-- >>> let bv = fromNumber 128 0 `setBit` 0 `setBit` 65+--+-- >>> select bv 0  -- Find the 0-indexed position of the first one bit+-- Just 0+--+-- >>> select bv 1  -- Find the 0-indexed position of the second one bit+-- Just 65+--+-- >>> select bv 2  -- There is no 3rd set bit, `select` fails+-- Nothing+select+  :: BitVector+  -> Word        -- ^ \(k\), the select index +  -> Maybe Word  -- ^ index of the k-th set bit+select (BV 0      _) _ = Nothing -- There can be no set bits in a bit-vector of length 0+select (BV w natVal) k =+    case natVal of+      NatS#      v  -> let !u = W# v+                       in  if toEnum (popCount u) <= k+                           then Nothing+                           else Just $ wordSelect u k+      NatJ# (BN# v) -> f (ByteArray v) k+  where+    f :: ByteArray -> Word -> Maybe Word+    f byteArr x = g x 0+      where+        g :: Word -> Int -> Maybe Word+        g !j !i+          | toEnum i * bitsInWord >= w = Nothing+          | j < ones  = Just $ wordSelect value j+          | otherwise = (bitsInWord +) <$> g (j - ones) (i+1)+          where+            ones = toEnum $ popCount value+            value :: Word+            value = byteArr `indexByteArray` i+++-- |+-- Number of bits in a 'Word'.+--+-- Used for "broadword programming."+{-# INLINE bitsInWord #-}+bitsInWord :: Word+bitsInWord = toEnum $ finiteBitSize (undefined :: Word)+++-- |+-- Clever use of 'popCount' and masking to get the number of set bits up to,+-- /but not including/,  index "k."+wordRank+  :: Word -- ^ Input 'Word'+  -> Word -- ^ Index k, upt to which we count all set bits, k in range [ 0, finiteBitCount - 1 ]+  -> Word -- ^ THe number of bits set within index "k."+wordRank v x = toEnum . popCount $ suffixOnes .&. v+  where+    suffixOnes = (1 `shiftL` fromEnum x) - 1+++-- |+-- Perform binary search with 'popCount' to locate the k-th set bit+wordSelect+  :: Word -- ^ Input 'Word'+  -> Word -- ^ Find the k-th set bit, k in range [ 0, finiteBitCount - 1 ]+  -> Word -- ^ The index of the k-th set bit+wordSelect v = go 0 63+  where+    go :: Word -> Word -> Word -> Word+    go  lb ub x+      | lb + 1 == ub = if x == 0 && v `testBit` fromEnum lb then lb else ub+      | otherwise =+          let !lowOnes =  toEnum . popCount $ lowMask .&. v+          in  if lowOnes > x+              then go lb mb x+              else go (mb + 1) ub (x - lowOnes)+      where+        mb = ((ub - lb) `div` 2) + lb+        lowMask = makeMask lb mb++        makeMask i j = wideMask `xor` thinMask+          where+            thinMask = (1 `shiftL` fromEnum i) - 1+            wideMask+              | j == bitsInWord - 1 = maxBound :: Word+              | otherwise = (1 `shiftL` (fromEnum j + 1)) - 1   toInt :: Word -> Maybe Int

@@ -3,4 +3,4 @@ extra-deps:  - mono-traversable-keys-0.1.0 -resolver: lts-11.0+resolver: lts-13.28

@@ -16,6 +16,7 @@ import           Data.Functor.Identity import           Data.Hashable import           Data.List.NonEmpty (NonEmpty(..))+import           Data.Maybe import           Data.Monoid () import           Data.MonoTraversable import           Data.MonoTraversable.Keys@@ -62,6 +63,7 @@     , showProperties     , textshowProperties     , bitVectorProperties+    , bitVectorRankSelect     , monoFunctorEquivelence     , monoFoldableEquivelence     , monoZipEquivelence@@ -655,6 +657,53 @@         lower = toEnum lowerI         upper = toEnum upperI ++bitVectorRankSelect :: TestTree+bitVectorRankSelect = testGroup "BitVector rank/select"+    [ QC.testProperty "select (bit i) 0 === i" selectBitValue+    , QC.testProperty "select (bit x .|. bit y) 0 === min (select (bit x) 0) (select (bit y) 0)" selectBitOr+    , QC.testProperty "rank (bit x .|. bit y) (max x y + 1) === rank (bit x) (x+1) + rank (bit y) (y+1)" rankBitOr+    , QC.testProperty "rank (bit i) (i+1) === i" rankBitValue+    , QC.testProperty "rank <$> id <*> dimension === popCount" rankPopCount+    , QC.testProperty "rank bv i === length . filter id . take i . toBits bv" rankToBits+    , QC.testProperty "rank bv (select bv i) === i" rankSelectMinDef+    ]+  where+    selectBitValue :: NonNegative Int -> Property+    selectBitValue (NonNegative x) =+        select (bit x) 0 === Just (toEnum x)++    selectBitOr :: NonNegative Int -> NonNegative Int -> Property+    selectBitOr (NonNegative x) (NonNegative y) =+        select (bit x .|. bit y) 0 === min (select (bit x) 0) (select (bit y) 0)++    rankBitValue :: NonNegative Word -> Property+    rankBitValue (NonNegative x) =+        rank (bit (fromEnum x)) (x+1) === 1++    rankBitOr :: NonNegative Int -> NonNegative Int -> Property+    rankBitOr (NonNegative x) (NonNegative y) =+        x /= y ==>+          rank (bit x .|. bit y) z' === rank (bit x) (x'+1) + rank (bit y) (y'+1)+      where+        x' = toEnum x+        y' = toEnum y+        z' = max x' y' + 1++    rankPopCount :: BitVector -> Property+    rankPopCount bv =+        (rank <$> id <*> dimension) bv === toEnum (popCount bv)++    rankToBits :: BitVector -> NonNegative Word -> Property+    rankToBits bv (NonNegative x) =+        rank bv x === (toEnum . length . filter id . take (fromEnum x) . toBits) bv++    rankSelectMinDef :: BitVector -> NonNegative Word -> Property+    rankSelectMinDef bv (NonNegative x) =+        let idx = select bv x+            k   = fromJust idx+        in  idx === Nothing .||. rank bv k === x+          monoFunctorEquivelence :: TestTree monoFunctorEquivelence = testGroup "Equivelence of a MonoFunctor"