diff --git a/bv-little.cabal b/bv-little.cabal --- a/bv-little.cabal +++ b/bv-little.cabal @@ -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 diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -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 diff --git a/src/Data/BitVector/LittleEndian.hs b/src/Data/BitVector/LittleEndian.hs --- a/src/Data/BitVector/LittleEndian.hs +++ b/src/Data/BitVector/LittleEndian.hs @@ -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 +-- . +-- 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 diff --git a/stack.yaml b/stack.yaml --- a/stack.yaml +++ b/stack.yaml @@ -3,4 +3,4 @@ extra-deps: - mono-traversable-keys-0.1.0 -resolver: lts-11.0 +resolver: lts-13.28 diff --git a/test/TestSuite.hs b/test/TestSuite.hs --- a/test/TestSuite.hs +++ b/test/TestSuite.hs @@ -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"