hw-rankselect-base 0.3.0.0 → 0.3.1.0
raw patch · 7 files changed
+239/−222 lines, 7 filesdep ~bits-extradep ~hw-bitsdep ~hw-primPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependency ranges changed: bits-extra, hw-bits, hw-prim
API changes (from Hackage documentation)
- HaskellWorks.Data.RankSelect.Base.Select1: instance HaskellWorks.Data.RankSelect.Base.Select1.Select1 [GHC.Types.Bool]
- HaskellWorks.Data.RankSelect.Base.Select1: instance HaskellWorks.Data.RankSelect.Base.Select1.Select1 [GHC.Word.Word16]
- HaskellWorks.Data.RankSelect.Base.Select1: instance HaskellWorks.Data.RankSelect.Base.Select1.Select1 [GHC.Word.Word32]
- HaskellWorks.Data.RankSelect.Base.Select1: instance HaskellWorks.Data.RankSelect.Base.Select1.Select1 [GHC.Word.Word64]
- HaskellWorks.Data.RankSelect.Base.Select1: instance HaskellWorks.Data.RankSelect.Base.Select1.Select1 [GHC.Word.Word8]
+ HaskellWorks.Data.RankSelect.Base.Select1: instance (HaskellWorks.Data.Bits.PopCount.PopCount1.PopCount1 w, HaskellWorks.Data.RankSelect.Base.Select1.Select1 w, Data.Bits.BitSize.BitSize w) => HaskellWorks.Data.RankSelect.Base.Select1.Select1 [w]
+ HaskellWorks.Data.RankSelect.Base.Select1: instance HaskellWorks.Data.RankSelect.Base.Select1.Select1 GHC.Types.Bool
Files
- hw-rankselect-base.cabal +11/−11
- src/HaskellWorks/Data/RankSelect/Base/Select1.hs +17/−47
- test/HaskellWorks/Data/RankSelect/Base/InternalSpec.hs +3/−3
- test/HaskellWorks/Data/RankSelect/Base/Rank0Spec.hs +49/−38
- test/HaskellWorks/Data/RankSelect/Base/Rank1Spec.hs +49/−37
- test/HaskellWorks/Data/RankSelect/Base/Select0Spec.hs +53/−41
- test/HaskellWorks/Data/RankSelect/Base/Select1Spec.hs +57/−45
hw-rankselect-base.cabal view
@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: e621f9ce4411c3740727c5167f0f6488c0a25514832ad5d6359e86474477c5ff+-- hash: 1503b4be7853227912b197998c9832b625fa280dfd157c26f2112deae20aba36 name: hw-rankselect-base-version: 0.3.0.0+version: 0.3.1.0 synopsis: Rank-select base description: Please see README.md category: Data@@ -37,10 +37,10 @@ ghc-options: -Wall -O2 -msse4.2 build-depends: base >=4 && <5- , bits-extra- , hw-bits >=0.4.0.0+ , bits-extra >=0.0.0.3+ , hw-bits >=0.7.0.2 , hw-int >=0.0.0.1- , hw-prim >=0.4.0.0+ , hw-prim >=0.5.0.5 , hw-string-parse >=0.0.0.2 , safe , vector@@ -69,13 +69,13 @@ build-depends: QuickCheck , base >=4 && <5- , bits-extra+ , bits-extra >=0.0.0.3 , hedgehog , hspec- , hw-bits >=0.4.0.0+ , hw-bits >=0.7.0.2 , hw-hedgehog , hw-hspec-hedgehog- , hw-prim >=0.4.0.0+ , hw-prim >=0.5.0.5 , hw-rankselect-base , vector if (flag(bmi2)) && (impl(ghc >=8.4.1))@@ -98,10 +98,10 @@ ghc-options: -Wall -O2 -msse4.2 build-depends: base >=4 && <5- , bits-extra+ , bits-extra >=0.0.0.3 , criterion- , hw-bits >=0.4.0.0- , hw-prim >=0.4.0.0+ , hw-bits >=0.7.0.2+ , hw-prim >=0.5.0.5 , hw-rankselect-base , vector if (flag(bmi2)) && (impl(ghc >=8.4.1))
src/HaskellWorks/Data/RankSelect/Base/Select1.hs view
@@ -1,11 +1,13 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} module HaskellWorks.Data.RankSelect.Base.Select1 ( Select1(..) ) where +import Data.Bits.BitSize import Data.Word import HaskellWorks.Data.AtIndex import HaskellWorks.Data.Bits.BitShown@@ -72,53 +74,10 @@ select1 = select1Word64 {-# INLINE select1 #-} -instance Select1 [Bool] where- select1 = go 0- where go r _ 0 = r- go r (True :bs) c = go (r + 1) bs (c - 1)- go r (False:bs) c = go (r + 1) bs c- go _ [] _ = error "Out of range"- {-# INLINE select1 #-}--instance Select1 [Word8] where- select1 v c = go v c 0- where go :: [Word8] -> Count -> Count -> Count- go _ 0 acc = acc- go u d acc = let w = head u in- case popCount1 w of- pc | d <= pc -> select1 w d + acc- pc -> go (tail u) (d - pc) (acc + elemFixedBitSize u)- {-# INLINE select1 #-}--instance Select1 [Word16] where- select1 v c = go v c 0- where go :: [Word16] -> Count -> Count -> Count- go _ 0 acc = acc- go u d acc = let w = head u in- case popCount1 w of- pc | d <= pc -> select1 w d + acc- pc -> go (tail u) (d - pc) (acc + elemFixedBitSize u)- {-# INLINE select1 #-}--instance Select1 [Word32] where- select1 v c = go v c 0- where go :: [Word32] -> Count -> Count -> Count- go _ 0 acc = acc- go u d acc = let w = head u in- case popCount1 w of- pc | d <= pc -> select1 w d + acc- pc -> go (tail u) (d - pc) (acc + elemFixedBitSize u)- {-# INLINE select1 #-}--instance Select1 [Word64] where- select1 v c = go v c 0- where go :: [Word64] -> Count -> Count -> Count- go _ 0 acc = acc- go u d acc = let w = head u in- case popCount1 w of- pc | d <= pc -> select1 w d + acc- pc -> go (tail u) (d - pc) (acc + elemFixedBitSize u)- {-# INLINE select1 #-}+instance Select1 Bool where+ select1 b c = if c == 1+ then if b then 1 else 0+ else 0 instance Select1 (DVS.Vector Word8) where select1 v c = go 0 c 0@@ -190,4 +149,15 @@ case popCount1 w of pc | d <= pc -> select1 w d + acc pc -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)+ {-# INLINE select1 #-}++instance (PopCount1 w, Select1 w, BitSize w) => Select1 [w] where+ select1 v c = go v c 0+ where go _ 0 acc = acc+ go u d acc = case u of+ w:ws -> let pc = popCount1 w in+ if d <= pc+ then select1 w d + acc+ else go ws (d - pc) (acc + bitCount w)+ [] -> acc {-# INLINE select1 #-}
test/HaskellWorks/Data/RankSelect/Base/InternalSpec.hs view
@@ -12,17 +12,17 @@ import qualified Hedgehog.Gen as G import qualified Hedgehog.Range as R -{-# ANN module ("HLint: ignore Redundant do" :: String) #-}+{-# ANN module ("HLint: ignore Redundant do" :: String) #-} {-# ANN module ("HLint: ignore Reduce duplication" :: String) #-} spec :: Spec spec = describe "HaskellWorks.Data.RankSelect.Base.InternalSpec" $ do describe "Bmi2 and broadword implementations match" $ do- it "64-bit" $ require $ property $ do+ it "64-bit" $ requireProperty $ do s <- forAll $ mfilter (/= 0) (G.word64 R.constantBounded) r <- forAll $ G.word64 (R.linear 0 (fromIntegral (popCount s))) select1Word64Broadword s r === select1Word64Bmi2 s r- it "32-bit" $ require $ property $ do+ it "32-bit" $ requireProperty $ do s <- forAll $ mfilter (/= 0) (G.word32 R.constantBounded) r <- forAll $ G.word64 (R.linear 0 (fromIntegral (popCount s))) select1Word32Broadword s r === select1Word32Bmi2 s r
test/HaskellWorks/Data/RankSelect/Base/Rank0Spec.hs view
@@ -7,37 +7,41 @@ , spec ) where -import Data.Maybe-import Data.Typeable-import qualified Data.Vector as DV-import qualified Data.Vector.Storable as DVS-import Data.Word-import HaskellWorks.Data.Bits.BitRead-import HaskellWorks.Data.Bits.BitWise-import HaskellWorks.Data.Bits.PopCount.PopCount0-import HaskellWorks.Data.Positioning-import HaskellWorks.Data.RankSelect.Base.Rank0-import HaskellWorks.Data.RankSelect.Base.Select0-import Test.Hspec-import Test.QuickCheck+import Control.Monad+import Data.Maybe+import Data.Typeable+import Data.Word+import HaskellWorks.Data.Bits.BitRead+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Bits.PopCount.PopCount0+import HaskellWorks.Data.RankSelect.Base.Rank0+import HaskellWorks.Data.RankSelect.Base.Select0+import HaskellWorks.Hspec.Hedgehog+import Hedgehog+import Test.Hspec -{-# ANN module ("HLint: ignore Redundant do" :: String) #-}+import qualified Data.Vector as DV+import qualified Data.Vector.Storable as DVS+import qualified Hedgehog.Gen as G+import qualified Hedgehog.Range as R++{-# ANN module ("HLint: ignore Redundant do" :: String) #-} {-# ANN module ("HLint: ignore Reduce duplication" :: String) #-} genRank0UpTo8Spec :: forall s. (Typeable s, BitRead s, Rank0 s) => s -> Spec genRank0UpTo8Spec _ = describe ("Generically up to 8 bits for " ++ show (typeOf (undefined :: s))) $ do- it "rank0 10010010 over [0..8] should be 001223445" $ do+ it "rank0 10010010 over [0..8] should be 001223445" $ requireProperty $ do let bs = fromJust (bitRead "10010010") :: s- fmap (rank0 bs) [0..8] `shouldBe` [0, 0, 1, 2, 2, 3, 4, 4, 5]+ fmap (rank0 bs) [0..8] === [0, 0, 1, 2, 2, 3, 4, 4, 5] genRank0UpTo16Spec :: forall s. (Typeable s, BitRead s, Rank0 s) => s -> Spec genRank0UpTo16Spec _ = describe ("Generically up to 16 bits for " ++ show (typeOf (undefined :: s))) $ do- it "rank0 11011010 00000000 over [0..16]" $ do+ it "rank0 11011010 00000000 over [0..16]" $ requireProperty $ do let bs = fromJust $ bitRead "11011010 00000000" :: s- fmap (rank0 bs) [0..16] `shouldBe` [0, 0, 0, 1, 1, 1, 2, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11]- it "rank0 11011010 10000000 over [0..16]" $ do+ fmap (rank0 bs) [0..16] === [0, 0, 0, 1, 1, 1, 2, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11]+ it "rank0 11011010 10000000 over [0..16]" $ requireProperty $ do let bs = fromJust $ bitRead "11011010 10000000" :: s- fmap (rank0 bs) [0..16] `shouldBe` [0, 0, 0, 1, 1, 1, 2, 2, 3, 3, 4, 5, 6, 7, 8, 9, 10]+ fmap (rank0 bs) [0..16] === [0, 0, 0, 1, 1, 1, 2, 2, 3, 3, 4, 5, 6, 7, 8, 9, 10] spec :: Spec spec = describe "HaskellWorks.Data.RankSelect.InternalSpec" $ do@@ -70,21 +74,28 @@ genRank0UpTo8Spec (undefined :: DVS.Vector Word64) genRank0UpTo16Spec (undefined :: DVS.Vector Word64) describe "Different word sizes give the same rank0" $ do- it "when comparing Word16 and Word64 over bits 0-7" $- forAll (choose (0, 8 :: Count)) $ \(i :: Count) (w :: Word8) ->- rank0 w i == rank0 (fromIntegral w :: Word64) i- it "when comparing Word16 and Word64 over bits 0-15" $ property $- forAll (choose (0, 16 :: Count)) $ \(i :: Count) (w :: Word16) ->- rank0 w i == rank0 (fromIntegral w :: Word64) i- it "when comparing Word32 and Word64 over bits 0-31" $ property $- forAll (choose (0, 32 :: Count)) $ \(i :: Count) (w :: Word32) ->- rank0 w i == rank0 (fromIntegral w :: Word64) i- it "when comparing Word32 and Word64 over bits 32-64" $ property $- forAll (choose (0, 32 :: Count)) $ \(i :: Count) (v :: Word32) (w :: Word32) ->- let v64 = fromIntegral v :: Word64 in- let w64 = fromIntegral w :: Word64 in- rank0 v i + popCount0 w == rank0 ((v64 .<. 32) .|. w64) (i + 32)- it "when comparing select1 for Word64 form a galois connection" $ property $- forAll (choose (0, 32 :: Count)) $ \(i :: Count) (w :: Word32) ->- 1 <= i && i <= popCount0 w ==>- rank0 w (select0 w i) == i && select0 w (rank0 w (fromIntegral i)) <= fromIntegral i+ it "when comparing Word16 and Word64 over bits 0-7" $ requireProperty $ do+ i <- forAll $ G.word64 (R.linear 0 8)+ w <- forAll $ G.word8 R.constantBounded+ rank0 w i === rank0 (fromIntegral w :: Word64) i+ it "when comparing Word16 and Word64 over bits 0-15" $ requireProperty $ do+ i <- forAll $ G.word64 (R.linear 0 16)+ w <- forAll $ G.word16 R.constantBounded+ rank0 w i === rank0 (fromIntegral w :: Word64) i+ it "when comparing Word32 and Word64 over bits 0-31" $ requireProperty $ do+ i <- forAll $ G.word64 (R.linear 0 32)+ w <- forAll $ G.word32 R.constantBounded+ rank0 w i === rank0 (fromIntegral w :: Word64) i+ it "when comparing Word32 and Word64 over bits 32-64" $ requireProperty $ do+ i <- forAll $ G.word64 (R.linear 0 32)+ v <- forAll $ G.word32 R.constantBounded+ w <- forAll $ G.word32 R.constantBounded+ let v64 = fromIntegral v :: Word64+ let w64 = fromIntegral w :: Word64+ rank0 v i + popCount0 w === rank0 ((v64 .<. 32) .|. w64) (i + 32)+ it "when comparing select1 for Word64 form a galois connection" $ requireProperty $ do+ i <- forAll $ G.word64 (R.linear 0 32)+ w <- forAll $ G.word32 R.constantBounded+ when (1 <= i && i <= popCount0 w) $ do+ rank0 w (select0 w i) === i+ (select0 w (rank0 w (fromIntegral i)) <= fromIntegral i) === True
test/HaskellWorks/Data/RankSelect/Base/Rank1Spec.hs view
@@ -7,37 +7,41 @@ , spec ) where -import Data.Maybe-import Data.Typeable-import qualified Data.Vector as DV-import qualified Data.Vector.Storable as DVS-import Data.Word-import HaskellWorks.Data.Bits.BitRead-import HaskellWorks.Data.Bits.BitWise-import HaskellWorks.Data.Bits.PopCount.PopCount1-import HaskellWorks.Data.Positioning-import HaskellWorks.Data.RankSelect.Base.Rank1-import HaskellWorks.Data.RankSelect.Base.Select1-import Test.Hspec-import Test.QuickCheck+import Control.Monad+import Data.Maybe+import Data.Typeable+import Data.Word+import HaskellWorks.Data.Bits.BitRead+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Bits.PopCount.PopCount1+import HaskellWorks.Data.RankSelect.Base.Rank1+import HaskellWorks.Data.RankSelect.Base.Select1+import HaskellWorks.Hspec.Hedgehog+import Hedgehog+import Test.Hspec -{-# ANN module ("HLint: ignore Redundant do" :: String) #-}+import qualified Data.Vector as DV+import qualified Data.Vector.Storable as DVS+import qualified Hedgehog.Gen as G+import qualified Hedgehog.Range as R++{-# ANN module ("HLint: ignore Redundant do" :: String) #-} {-# ANN module ("HLint: ignore Reduce duplication" :: String) #-} genRank1UpTo8Spec :: forall s. (Typeable s, BitRead s, Rank1 s) => s -> Spec genRank1UpTo8Spec _ = describe ("Generically up to 8 bits for " ++ show (typeOf (undefined :: s))) $ do- it "rank1 10010010 over [0..8] should be 011122233" $ do+ it "rank1 10010010 over [0..8] should be 011122233" $ requireProperty $ do let bs = fromJust (bitRead "10010010") :: s- fmap (rank1 bs) [0..8] `shouldBe` [0, 1, 1, 1, 2, 2, 2, 3, 3]+ fmap (rank1 bs) [0..8] === [0, 1, 1, 1, 2, 2, 2, 3, 3] genRank1UpTo16Spec :: forall s. (Typeable s, BitRead s, Rank1 s) => s -> Spec genRank1UpTo16Spec _ = describe ("Generically up to 16 bits for " ++ show (typeOf (undefined :: s))) $ do- it "rank1 11011010 00000000 over [0..9]" $ do+ it "rank1 11011010 00000000 over [0..9]" $ requireProperty $ do let bs = fromJust $ bitRead "11011010 00000000" :: s- fmap (rank1 bs) [0..16] `shouldBe` [0, 1, 2, 2, 3, 4, 4, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5]- it "rank1 11011010 10000000 over [0..9]" $ do+ fmap (rank1 bs) [0..16] === [0, 1, 2, 2, 3, 4, 4, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5]+ it "rank1 11011010 10000000 over [0..9]" $ requireProperty $ do let bs = fromJust $ bitRead "11011010 10000000" :: s- fmap (rank1 bs) [0..16] `shouldBe` [0, 1, 2, 2, 3, 4, 4, 5, 5, 6, 6, 6, 6, 6, 6, 6, 6]+ fmap (rank1 bs) [0..16] === [0, 1, 2, 2, 3, 4, 4, 5, 5, 6, 6, 6, 6, 6, 6, 6, 6] spec :: Spec spec = describe "HaskellWorks.Data.RankSelect.InternalSpec" $ do@@ -70,20 +74,28 @@ genRank1UpTo8Spec (undefined :: DVS.Vector Word64) genRank1UpTo16Spec (undefined :: DVS.Vector Word64) describe "For Word8-Word64" $ do- it "rank1 for Word16 and Word64 should give same answer for bits 0-7" $- forAll (choose (0, 8)) $ \(i :: Count) (w :: Word8) ->- rank1 w i == rank1 (fromIntegral w :: Word64) i- it "rank1 for Word16 and Word64 should give same answer for bits 0-15" $- forAll (choose (0, 16)) $ \(i :: Count) (w :: Word16) ->- rank1 w i == rank1 (fromIntegral w :: Word64) i- it "rank1 for Word32 and Word64 should give same answer for bits 0-31" $- forAll (choose (0, 32)) $ \(i :: Count) (w :: Word32) ->- rank1 w i == rank1 (fromIntegral w :: Word64) i- it "rank1 for Word32 and Word64 should give same answer for bits 32-64" $- forAll (choose (0, 32)) $ \(i :: Count) (v :: Word32) (w :: Word32) ->- let v64 = fromIntegral v :: Word64 in- let w64 = fromIntegral w :: Word64 in- rank1 v i + popCount1 w == rank1 ((v64 .<. 32) .|. w64) (i + 32)- it "rank1 and select1 for Word64 form a galois connection" $- forAll (choose (0, 32)) $ \(i :: Count) (w :: Word32) -> 1 <= i && i <= popCount1 w ==>- rank1 w (select1 w i) == i && select1 w (rank1 w (fromIntegral i)) <= fromIntegral i+ it "rank1 for Word16 and Word64 should give same answer for bits 0-7" $ requireProperty $ do+ i <- forAll $ G.word64 (R.linear 0 8)+ w <- forAll $ G.word8 R.constantBounded+ rank1 w i === rank1 (fromIntegral w :: Word64) i+ it "rank1 for Word16 and Word64 should give same answer for bits 0-15" $ requireProperty $ do+ i <- forAll $ G.word64 (R.linear 0 16)+ w <- forAll $ G.word16 R.constantBounded+ rank1 w i === rank1 (fromIntegral w :: Word64) i+ it "rank1 for Word32 and Word64 should give same answer for bits 0-31" $ requireProperty $ do+ i <- forAll $ G.word64 (R.linear 0 32)+ w <- forAll $ G.word32 R.constantBounded+ rank1 w i === rank1 (fromIntegral w :: Word64) i+ it "rank1 for Word32 and Word64 should give same answer for bits 32-64" $ requireProperty $ do+ i <- forAll $ G.word64 (R.linear 0 32)+ v <- forAll $ G.word32 R.constantBounded+ w <- forAll $ G.word32 R.constantBounded+ let v64 = fromIntegral v :: Word64+ let w64 = fromIntegral w :: Word64+ rank1 v i + popCount1 w === rank1 ((v64 .<. 32) .|. w64) (i + 32)+ it "rank1 and select1 for Word64 form a galois connection" $ requireProperty $ do+ i <- forAll $ G.word64 (R.linear 0 32)+ w <- forAll $ G.word32 R.constantBounded+ when (1 <= i && i <= popCount1 w) $ do+ rank1 w (select1 w i) === i+ (select1 w (rank1 w (fromIntegral i)) <= fromIntegral i) === True
test/HaskellWorks/Data/RankSelect/Base/Select0Spec.hs view
@@ -8,43 +8,47 @@ , spec ) where -import Data.Maybe-import Data.Typeable-import qualified Data.Vector as DV-import qualified Data.Vector.Storable as DVS-import Data.Word-import HaskellWorks.Data.Bits.BitRead-import HaskellWorks.Data.Bits.BitWise-import HaskellWorks.Data.Bits.PopCount.PopCount0-import HaskellWorks.Data.Positioning-import HaskellWorks.Data.RankSelect.Base.Rank0-import HaskellWorks.Data.RankSelect.Base.Select0-import Test.Hspec-import Test.QuickCheck+import Control.Monad+import Data.Maybe+import Data.Typeable+import Data.Word+import HaskellWorks.Data.Bits.BitRead+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Bits.PopCount.PopCount0+import HaskellWorks.Data.RankSelect.Base.Rank0+import HaskellWorks.Data.RankSelect.Base.Select0+import HaskellWorks.Hspec.Hedgehog+import Hedgehog+import Test.Hspec -{-# ANN module ("HLint: ignore Redundant do" :: String) #-}+import qualified Data.Vector as DV+import qualified Data.Vector.Storable as DVS+import qualified Hedgehog.Gen as G+import qualified Hedgehog.Range as R++{-# ANN module ("HLint: ignore Redundant do" :: String) #-} {-# ANN module ("HLint: ignore Reduce duplication" :: String) #-} genSelect0UpTo8Spec :: forall s. (Typeable s, BitRead s, Select0 s) => s -> Spec genSelect0UpTo8Spec _ = describe ("Generically up to 8 bits for " ++ show (typeOf (undefined :: s))) $ do- it "select0 10010010 over [0..5] should be 023568" $ do+ it "select0 10010010 over [0..5] should be 023568" $ requireProperty $ do let bs = fromJust $ bitRead "10010010" :: Word8- fmap (select0 bs) [0..5] `shouldBe` [0, 2, 3, 5, 6, 8]+ fmap (select0 bs) [0..5] === [0, 2, 3, 5, 6, 8] genSelect0UpTo16Spec :: forall s. (Typeable s, BitRead s, Select0 s) => s -> Spec genSelect0UpTo16Spec _ = describe ("Generically up to 16 bits for " ++ show (typeOf (undefined :: s))) $ do- it "select0 11011010 00 over [0..5]" $- let bs = fromJust $ bitRead "1101101 000" :: [Bool] in- fmap (select0 bs) [0..5] `shouldBe` [0, 3, 6, 8, 9, 10]- it "select0 11011010 00000000 over [0..5]" $ do+ it "select0 11011010 00 over [0..5]" $ requireProperty $ do+ let bs = fromJust $ bitRead "1101101 000" :: [Bool]+ fmap (select0 bs) [0..5] === [0, 3, 6, 8, 9, 10]+ it "select0 11011010 00000000 over [0..5]" $ requireProperty $ do let bs = fromJust $ bitRead "11011010 00000000" :: Word32- fmap (select0 bs) [0..11] `shouldBe` [0, 3, 6, 8, 9, 10, 11, 12, 13, 14, 15, 16]+ fmap (select0 bs) [0..11] === [0, 3, 6, 8, 9, 10, 11, 12, 13, 14, 15, 16] genSelect0UpTo32Spec :: forall s. (Typeable s, BitRead s, Select0 s) => s -> Spec genSelect0UpTo32Spec _ = describe ("Generically up to 16 bits for " ++ show (typeOf (undefined :: s))) $ do- it "select0 11000001 10000000 01000000 over [0..5] should be 023568" $- let bs = fromJust $ bitRead "11000001 10000000 01000000" :: s in- fmap (select0 bs) [0..19] `shouldBe` [0, 3, 4, 5, 6, 7, 10, 11, 12, 13, 14, 15, 16, 17, 19, 20, 21, 22, 23, 24]+ it "select0 11000001 10000000 01000000 over [0..5] should be 023568" $ requireProperty $ do+ let bs = fromJust $ bitRead "11000001 10000000 01000000" :: s+ fmap (select0 bs) [0..19] === [0, 3, 4, 5, 6, 7, 10, 11, 12, 13, 14, 15, 16, 17, 19, 20, 21, 22, 23, 24] spec :: Spec spec = describe "HaskellWorks.Data.RankSelect.InternalSpec" $ do@@ -97,20 +101,28 @@ genSelect0UpTo16Spec (undefined :: DVS.Vector Word64) genSelect0UpTo32Spec (undefined :: DVS.Vector Word64) describe "For Word8-Word64" $ do- it "rank0 for Word16 and Word64 should give same answer for bits 0-7" $- forAll (choose (0, 8)) $ \(i :: Count) (w :: Word8) ->- rank0 w i == rank0 (fromIntegral w :: Word64) i- it "rank0 for Word16 and Word64 should give same answer for bits 0-15" $- forAll (choose (0, 16)) $ \(i :: Count) (w :: Word16) ->- rank0 w i == rank0 (fromIntegral w :: Word64) i- it "rank0 for Word32 and Word64 should give same answer for bits 0-31" $- forAll (choose (0, 32)) $ \(i :: Count) (w :: Word32) ->- rank0 w i == rank0 (fromIntegral w :: Word64) i- it "rank0 for Word32 and Word64 should give same answer for bits 32-64" $- forAll (choose (0, 32)) $ \(i :: Count) (v :: Word32) (w :: Word32) ->- let v64 = fromIntegral v :: Word64 in- let w64 = fromIntegral w :: Word64 in- rank0 v i + popCount0 w == rank0 ((v64 .<. 32) .|. w64) (i + 32)- it "rank0 and select0 for Word64 form a galois connection" $ property $- forAll (choose (0, 32)) $ \(i :: Count) (w :: Word32) -> 1 <= i && i <= popCount0 w ==>- rank0 w (select0 w i) == i && select0 w (rank0 w (fromIntegral i)) <= fromIntegral i+ it "rank0 for Word16 and Word64 should give same answer for bits 0-7" $ requireProperty $ do+ i <- forAll $ G.word64 (R.linear 0 8)+ w <- forAll $ G.word8 R.constantBounded+ rank0 w i === rank0 (fromIntegral w :: Word64) i+ it "rank0 for Word16 and Word64 should give same answer for bits 0-15" $ requireProperty $ do+ i <- forAll $ G.word64 (R.linear 0 16)+ w <- forAll $ G.word16 R.constantBounded+ rank0 w i === rank0 (fromIntegral w :: Word64) i+ it "rank0 for Word32 and Word64 should give same answer for bits 0-31" $ requireProperty $ do+ i <- forAll $ G.word64 (R.linear 0 32)+ w <- forAll $ G.word32 R.constantBounded+ rank0 w i === rank0 (fromIntegral w :: Word64) i+ it "rank0 for Word32 and Word64 should give same answer for bits 32-64" $ requireProperty $ do+ i <- forAll $ G.word64 (R.linear 0 32)+ v <- forAll $ G.word32 R.constantBounded+ w <- forAll $ G.word32 R.constantBounded+ let v64 = fromIntegral v :: Word64+ let w64 = fromIntegral w :: Word64+ rank0 v i + popCount0 w === rank0 ((v64 .<. 32) .|. w64) (i + 32)+ it "rank0 and select0 for Word64 form a galois connection" $ requireProperty $ do+ i <- forAll $ G.word64 (R.linear 0 32)+ w <- forAll $ G.word32 R.constantBounded+ when (1 <= i && i <= popCount0 w) $ do+ rank0 w (select0 w i) === i+ (select0 w (rank0 w (fromIntegral i)) <= fromIntegral i) === True
test/HaskellWorks/Data/RankSelect/Base/Select1Spec.hs view
@@ -8,49 +8,53 @@ , spec ) where -import Data.Maybe-import Data.Typeable-import qualified Data.Vector as DV-import qualified Data.Vector.Storable as DVS-import Data.Word-import HaskellWorks.Data.Bits.BitRead-import HaskellWorks.Data.Bits.BitWise-import HaskellWorks.Data.Bits.PopCount.PopCount1-import HaskellWorks.Data.Positioning-import HaskellWorks.Data.RankSelect.Base.Rank1-import HaskellWorks.Data.RankSelect.Base.Select1-import Test.Hspec-import Test.QuickCheck+import Control.Monad+import Data.Maybe+import Data.Typeable+import Data.Word+import HaskellWorks.Data.Bits.BitRead+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Bits.PopCount.PopCount1+import HaskellWorks.Data.RankSelect.Base.Rank1+import HaskellWorks.Data.RankSelect.Base.Select1+import HaskellWorks.Hspec.Hedgehog+import Hedgehog+import Test.Hspec -{-# ANN module ("HLint: ignore Redundant do" :: String) #-}+import qualified Data.Vector as DV+import qualified Data.Vector.Storable as DVS+import qualified Hedgehog.Gen as G+import qualified Hedgehog.Range as R++{-# ANN module ("HLint: ignore Redundant do" :: String) #-} {-# ANN module ("HLint: ignore Reduce duplication" :: String) #-} genSelect1UpTo8Spec :: forall s. (Typeable s, BitRead s, Select1 s) => s -> Spec genSelect1UpTo8Spec _ = describe ("Generically up to 8 bits for " ++ show (typeOf (undefined :: s))) $ do- it "select1 10010010 over [0..3] should be 0147" $ do+ it "select1 10010010 over [0..3] should be 0147" $ requireProperty $ do let bs = fromJust $ bitRead "10010010" :: s- fmap (select1 bs) [0..3] `shouldBe` [0, 1, 4, 7]+ fmap (select1 bs) [0..3] === [0, 1, 4, 7] genSelect1UpTo16Spec :: forall s. (Typeable s, BitRead s, Select1 s) => s -> Spec genSelect1UpTo16Spec _ = describe ("Generically up to 16 bits for " ++ show (typeOf (undefined :: s))) $ do- it "select1 11011010 00 over [0..5]" $- let bs = fromJust $ bitRead "11011010 00" :: s in- fmap (select1 bs) [0..5] `shouldBe` [0, 1, 2, 4, 5, 7]- it "select1 11011010 00000000 over [0..5]" $ do+ it "select1 11011010 00 over [0..5]" $ requireProperty $ do+ let bs = fromJust $ bitRead "11011010 00" :: s+ fmap (select1 bs) [0..5] === [0, 1, 2, 4, 5, 7]+ it "select1 11011010 00000000 over [0..5]" $ requireProperty $ do let bs = fromJust $ bitRead "11011010 00000000" :: s- fmap (select1 bs) [0..5] `shouldBe` [0, 1, 2, 4, 5, 7]- it "select 01000000 00000100 over [0..2]" $ do+ fmap (select1 bs) [0..5] === [0, 1, 2, 4, 5, 7]+ it "select 01000000 00000100 over [0..2]" $ requireProperty $ do let bs = fromJust $ bitRead "01000000 00000100" :: s- fmap (select1 bs) [0..2] `shouldBe` [0, 2, 14]+ fmap (select1 bs) [0..2] === [0, 2, 14] genSelect1UpTo32Spec :: forall s. (Typeable s, BitRead s, Select1 s) => s -> Spec genSelect1UpTo32Spec _ = describe ("Generically up to 16 bits for " ++ show (typeOf (undefined :: s))) $ do- it "select1 11000001 10000000 01000000 over [0..5] should be 023568" $- let bs = fromJust $ bitRead "11000001 10000000 01000000" :: s in- fmap (select1 bs) [0..5] `shouldBe` [0, 1, 2, 8, 9, 18]- it "select 10000010 00000000 00100000 00010000 over [0..4]" $ do+ it "select1 11000001 10000000 01000000 over [0..5] should be 023568" $ requireProperty $ do+ let bs = fromJust $ bitRead "11000001 10000000 01000000" :: s+ fmap (select1 bs) [0..5] === [0, 1, 2, 8, 9, 18]+ it "select 10000010 00000000 00100000 00010000 over [0..4]" $ requireProperty $ do let bs = fromJust $ bitRead "10000010 00000000 00100000 00010000" :: s- fmap (select1 bs) [0..4] `shouldBe` [0, 1, 7, 19, 28]+ fmap (select1 bs) [0..4] === [0, 1, 7, 19, 28] spec :: Spec spec = describe "HaskellWorks.Data.RankSelect.InternalSpec" $ do@@ -103,20 +107,28 @@ genSelect1UpTo16Spec (undefined :: DVS.Vector Word64) genSelect1UpTo32Spec (undefined :: DVS.Vector Word64) describe "For Word64" $ do- it "rank1 for Word16 and Word64 should give same answer for bits 0-7" $ property $- forAll (choose (0, 8)) $ \(i :: Count) (w :: Word8) ->- rank1 w i == rank1 (fromIntegral w :: Word64) i- it "rank1 for Word16 and Word64 should give same answer for bits 0-15" $ property $- forAll (choose (0, 16)) $ \(i :: Count) (w :: Word16) ->- rank1 w i == rank1 (fromIntegral w :: Word64) i- it "rank1 for Word32 and Word64 should give same answer for bits 0-31" $ property $- forAll (choose (0, 32)) $ \(i :: Count) (w :: Word32) ->- rank1 w i == rank1 (fromIntegral w :: Word64) i- it "rank1 for Word32 and Word64 should give same answer for bits 32-64" $ property $- forAll (choose (0, 32)) $ \(i :: Count) (v :: Word32) (w :: Word32) ->- let v64 = fromIntegral v :: Word64 in- let w64 = fromIntegral w :: Word64 in- rank1 v i + popCount1 w == rank1 ((v64 .<. 32) .|. w64) (i + 32)- it "rank1 and select1 for Word64 form a galois connection" $ property $- forAll (choose (0, 32)) $ \(i :: Count) (w :: Word32) -> 1 <= i && i <= popCount1 w ==>- rank1 w (select1 w i) == i && select1 w (rank1 w (fromIntegral i)) <= fromIntegral i+ it "rank1 for Word16 and Word64 should give same answer for bits 0-7" $ requireProperty $ do+ i <- forAll $ G.word64 (R.linear 0 8)+ w <- forAll $ G.word8 R.constantBounded+ rank1 w i === rank1 (fromIntegral w :: Word64) i+ it "rank1 for Word16 and Word64 should give same answer for bits 0-15" $ requireProperty $ do+ i <- forAll $ G.word64 (R.linear 0 16)+ w <- forAll $ G.word16 R.constantBounded+ rank1 w i === rank1 (fromIntegral w :: Word64) i+ it "rank1 for Word32 and Word64 should give same answer for bits 0-31" $ requireProperty $ do+ i <- forAll $ G.word64 (R.linear 0 32)+ w <- forAll $ G.word32 R.constantBounded+ rank1 w i === rank1 (fromIntegral w :: Word64) i+ it "rank1 for Word32 and Word64 should give same answer for bits 32-64" $ requireProperty $ do+ i <- forAll $ G.word64 (R.linear 0 32)+ v <- forAll $ G.word32 R.constantBounded+ w <- forAll $ G.word32 R.constantBounded+ let v64 = fromIntegral v :: Word64+ let w64 = fromIntegral w :: Word64+ rank1 v i + popCount1 w === rank1 ((v64 .<. 32) .|. w64) (i + 32)+ it "rank1 and select1 for Word64 form a galois connection" $ requireProperty $ do+ i <- forAll $ G.word64 (R.linear 0 32)+ w <- forAll $ G.word32 R.constantBounded+ when (1 <= i && i <= popCount1 w) $ do+ rank1 w (select1 w i) === i+ (select1 w (rank1 w (fromIntegral i)) <= fromIntegral i) === True