hw-rankselect 0.0.0.5 → 0.0.0.6

raw patch · 12 files changed

+643/−11 lines, 12 filesdep ~hw-bitsPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

Dependency ranges changed: hw-bits

API changes (from Hackage documentation)

Files

• README.md +5/−0
• hw-rankselect.cabal +8/−2
• src/HaskellWorks/Data/Succinct/BalancedParens/Simple.hs +15/−0
• src/HaskellWorks/Data/Succinct/RankSelect/Binary/CsPoppy.hs +115/−0
• src/HaskellWorks/Data/Succinct/RankSelect/Binary/CsPoppy2.hs +106/−0
• src/HaskellWorks/Data/Succinct/RankSelect/Binary/Poppy512.hs +14/−2
• src/HaskellWorks/Data/Succinct/RankSelect/Binary/Poppy512S.hs +73/−0
• test/HaskellWorks/Data/Succinct/RankSelect/Binary/BasicGen.hs +17/−7
• test/HaskellWorks/Data/Succinct/RankSelect/Binary/CsPoppy2Spec.hs +93/−0
• test/HaskellWorks/Data/Succinct/RankSelect/Binary/CsPoppySpec.hs +93/−0
• test/HaskellWorks/Data/Succinct/RankSelect/Binary/Poppy512SSpec.hs +93/−0
• test/HaskellWorks/Data/Succinct/RankSelect/Binary/Poppy512Spec.hs +11/−0

@@ -2,3 +2,8 @@ [![0.0-branch](https://circleci.com/gh/haskell-works/hw-rankselect/tree/0.0-branch.svg?style=svg)](https://circleci.com/gh/haskell-works/hw-rankselect/tree/0.0-branch)  Rank and select operations.++```+cabal repl hw-rankselect-test+λ> :trace main+```

@@ -1,5 +1,5 @@ name:                   hw-rankselect-version:                0.0.0.5+version:                0.0.0.6 synopsis:               Conduits for tokenizing streams. description:            Please see README.md homepage:               http://github.com/haskell-works/hw-rankselect#readme@@ -34,7 +34,10 @@                       , HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1                       , HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select0                       , HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1+                      , HaskellWorks.Data.Succinct.RankSelect.Binary.CsPoppy+                      , HaskellWorks.Data.Succinct.RankSelect.Binary.CsPoppy2                       , HaskellWorks.Data.Succinct.RankSelect.Binary.Poppy512+                      , HaskellWorks.Data.Succinct.RankSelect.Binary.Poppy512S                       , HaskellWorks.Data.Succinct.RankSelect.Internal   build-depends:        base                          >= 4          && < 5                       , hw-bits@@ -54,12 +57,15 @@                       , HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select0Spec                       , HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1Spec                       , HaskellWorks.Data.Succinct.RankSelect.Binary.BasicGen+                      , HaskellWorks.Data.Succinct.RankSelect.Binary.CsPoppySpec+                      , HaskellWorks.Data.Succinct.RankSelect.Binary.CsPoppy2Spec                       , HaskellWorks.Data.Succinct.RankSelect.Binary.Poppy512Spec+                      , HaskellWorks.Data.Succinct.RankSelect.Binary.Poppy512SSpec                       , HaskellWorks.Data.Succinct.RankSelect.InternalSpec                       , HaskellWorks.Data.Succinct.SimpleSpec   build-depends:        base                          >= 4          && < 5                       , hspec-                      , hw-bits+                      , hw-bits                       >= 0.0.0.8                       , hw-prim                       >= 0.0.3                       , hw-rankselect                       , QuickCheck

@@ -22,6 +22,7 @@ import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1 import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select0 import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Poppy512 import           Prelude                                                    as P  newtype SimpleBalancedParens a = SimpleBalancedParens a@@ -119,6 +120,20 @@   {-# INLINABLE parent      #-}  instance BalancedParens (SimpleBalancedParens (DVS.Vector Word64)) where+  findOpen    v p = if v `openAt`  p then Just p else findOpen'  (Count 0) v (p - 1)+  findClose   v p = if v `closeAt` p then Just p else findClose' (Count 0) v (p + 1)+  enclose         = findOpen' (Count 1)+  firstChild  v p = if openAt v p && openAt v (p + 1)   then Just (p + 1) else Nothing+  nextSibling v p = if closeAt v p then Nothing else openAt v `mfilter` (findClose v p >>= (\q -> if p /= q then return (q + 1) else Nothing))+  parent      v p = enclose   v p >>= (\r -> if r >= 1 then return r       else Nothing)+  {-# INLINABLE findOpen    #-}+  {-# INLINABLE findClose   #-}+  {-# INLINABLE enclose     #-}+  {-# INLINABLE firstChild  #-}+  {-# INLINABLE nextSibling #-}+  {-# INLINABLE parent      #-}++instance BalancedParens (SimpleBalancedParens Poppy512) where   findOpen    v p = if v `openAt`  p then Just p else findOpen'  (Count 0) v (p - 1)   findClose   v p = if v `closeAt` p then Just p else findClose' (Count 0) v (p + 1)   enclose         = findOpen' (Count 1)

@@ -0,0 +1,115 @@+module HaskellWorks.Data.Succinct.RankSelect.Binary.CsPoppy+    ( CsPoppy(..)+    , Rank1(..)+    , makeCsPoppy+    , sampleRange+    ) where++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.Search+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1+import           HaskellWorks.Data.Vector.VectorLike++data CsPoppy = CsPoppy+  { csPoppyBits     :: DVS.Vector Word64+  , csPoppy512Index :: DVS.Vector Word64+  , csPoppyLayer0   :: DVS.Vector Word64+  , csPoppyLayer1   :: DVS.Vector Word64+  , csPoppyLayerS   :: DVS.Vector Word64 -- Sampling position of each 8192 1-bit+  } deriving (Eq, Show)++popCount1Range :: (DVS.Storable a, PopCount1 a) => Int -> Int -> DVS.Vector a -> Count+popCount1Range start len = popCount1 . DVS.take len . DVS.drop start++makeCsPoppy :: DVS.Vector Word64 -> CsPoppy+makeCsPoppy v = CsPoppy+  { csPoppyBits     = v+  , csPoppy512Index = DVS.constructN (((DVS.length v +           8 - 1) `div`           8) + 1) gen512Index+  , csPoppyLayer0   = DVS.constructN (((DVS.length v + 0x100000000 - 1) `div` 0x100000000) + 1) genLayer0+  , csPoppyLayer1   = DVS.constructN (((DVS.length v +          32 - 1) `div`          32) + 1) genLayer1+  , csPoppyLayerS   = DVS.unfoldrN (fromIntegral (popCount1 v `div` 8192) + 1) genS (0, 0)+  }+  where csPoppyCum2048  = DVS.constructN (((DVS.length v +          32 - 1) `div`          32) + 1) genCum2048+        gen512Index u = let indexN = DVS.length u - 1 in+          if indexN == -1+            then 0+            else getCount (popCount1Range (indexN *           8)           8 v) + DVS.last u+        genCum2048 u = let indexN = DVS.length u in+          if indexN .&. 0xffffffff == 0+            then 0+            else getCount (popCount1Range ((indexN - 1) *    32)          32 v) + DVS.last u+        genLayer0 u = let indexN = DVS.length u in+          if indexN == 0+            then 0+            else getCount (popCount1Range (indexN * 0x100000000) 0x100000000 v) + DVS.last u+        genLayer1 u = let indexN = DVS.length u in+          let cum = if indexN == 0 -- TODO Check boundary at 4G???+              then  0+              else  csPoppyCum2048 !!! fromIntegral indexN in+          let a = getCount (popCount1Range (indexN * 32 +  0)  8 v) in+          let b = getCount (popCount1Range (indexN * 32 +  8)  8 v) in+          let c = getCount (popCount1Range (indexN * 32 + 16)  8 v) in+          (   ( cum       .&. 0x00000000ffffffff)+          .|. ((a .<. 32) .&. 0x000003ff00000000)+          .|. ((b .<. 42) .&. 0x000ffc0000000000)+          .|. ((c .<. 52) .&. 0x3ff0000000000000)) -- zhou-sea2013 fig 5 (c)+        genS :: (Count, Position) -> Maybe (Word64, (Count, Position))+        genS (pca, n) = if n < vEnd v+          then  let w = v !!! n in+                let pcz = pca + popCount1 w in+                if (8192 - 1 + pca) `div` 8192 /= (8192 - 1 + pcz) `div` 8192+                  then Just (fromIntegral n * 64 + fromIntegral (select1 w (fromIntegral (8192 - (pca `mod` 8192)))), (pcz, n + 1))+                  else genS (pcz, n + 1)+          else Nothing++instance TestBit CsPoppy where+  (.?.) = (.?.) . csPoppyBits+  {-# INLINE (.?.) #-}++instance BitRead CsPoppy where+  bitRead = fmap makeCsPoppy . bitRead++instance Rank1 CsPoppy where+  rank1 (CsPoppy v _ layer0 layer1 _) p = rankPrior + rankInBasicBlock+    where rankLayer0              = layer0  !!! toPosition (p `div` 0x100000000)+          rankLayer1Word          = layer1  !!! toPosition (p `div` 2048)+          rankLayer1A             =  rankLayer1Word .&. 0x00000000ffffffff+          rankLayer1B             = (rankLayer1Word .&. 0x000003ff00000000) .>. 32+          rankLayer1C             = (rankLayer1Word .&. 0x000ffc0000000000) .>. 42+          rankLayer1D             = (rankLayer1Word .&. 0x3ff0000000000000) .>. 52+          q                       = (p `div` 512) `mod` 4 -- quarter+          rankLayer1  | q == 0    = rankLayer1A+                      | q == 1    = rankLayer1A + rankLayer1B+                      | q == 2    = rankLayer1A + rankLayer1B + rankLayer1C+                      | q == 3    = rankLayer1A + rankLayer1B + rankLayer1C + rankLayer1D+                      | otherwise = undefined+          rankPrior               = Count (rankLayer0 + rankLayer1)+          rankInBasicBlock        = rank1 (DVS.drop (fromIntegral p `div` 512) v) (p `mod` 512)++instance Select1 CsPoppy where+  select1 iv@(CsPoppy v i _ _ _) p = if DVS.length v /= 0+      then toCount q * 512 + select1 (DVS.drop (fromIntegral q * 8) v) (p - s)+      else 0+    where q = binarySearch (fromIntegral p) wordAt iMin iMax+          s = Count (i !!! q)+          wordAt = (i !!!)+          (sampleMin, sampleMax) = sampleRange iv p+          iMin = fromIntegral $  (sampleMin - 1) `div` 512      :: Position+          iMax = fromIntegral $ ((sampleMax - 1) `div` 512) + 1 :: Position++sampleRange :: CsPoppy -> Count -> (Word64, Word64)+sampleRange (CsPoppy _ index _ _ samples) p =+  let j = (fromIntegral p - 1) `div` 8192 in+  if 0 <= j && j < DVS.length samples+    then  let pa = samples DVS.! j                in+          if j + 1 < DVS.length samples+            then  let pz = samples DVS.! (j + 1)          in+                  (pa, pz)+            else (pa, fromIntegral (DVS.length index - 1))+    else (1, fromIntegral (DVS.length index - 1))

@@ -0,0 +1,106 @@+module HaskellWorks.Data.Succinct.RankSelect.Binary.CsPoppy2+    ( CsPoppy2(..)+    , Rank1(..)+    , makeCsPoppy2+    , sampleRange+    ) where++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.Search+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1+import           HaskellWorks.Data.Vector.VectorLike++data CsPoppy2 = CsPoppy2+  { csPoppy2Bits     :: DVS.Vector Word64+  , csPoppy2512Index :: DVS.Vector Word64+  , csPoppy2Layer0   :: DVS.Vector Word64+  , csPoppy2Layer1   :: DVS.Vector Word64+  , csPoppy2LayerS   :: DVS.Vector Word64 -- Sampling position of each 8192 1-bit+  } deriving (Eq, Show)++popCount1Range :: (DVS.Storable a, PopCount1 a) => Int -> Int -> DVS.Vector a -> Count+popCount1Range start len = popCount1 . DVS.take len . DVS.drop start++makeCsPoppy2 :: DVS.Vector Word64 -> CsPoppy2+makeCsPoppy2 v = CsPoppy2+  { csPoppy2Bits     = v+  , csPoppy2512Index = DVS.constructN (((DVS.length v +           8 - 1) `div`           8) + 1) gen512Index+  , csPoppy2Layer0   = DVS.constructN (((DVS.length v + 0x100000000 - 1) `div` 0x100000000) + 1) genLayer0+  , csPoppy2Layer1   = DVS.constructN (((DVS.length v +          32 - 1) `div`          32) + 1) genLayer1+  , csPoppy2LayerS   = DVS.unfoldrN (fromIntegral (popCount1 v `div` 8192) + 1) genS (0, 0)+  }+  where csPoppy2Cum2048  = DVS.constructN (((DVS.length v +          32 - 1) `div`          32) + 1) genCum2048+        gen512Index u = let indexN = DVS.length u - 1 in+          if indexN == -1+            then 0+            else getCount (popCount1Range (indexN *           8)           8 v) + DVS.last u+        genCum2048 u = let indexN = DVS.length u in+          if indexN .&. 0xffffffff == 0+            then 0+            else getCount (popCount1Range ((indexN - 1) *    32)          32 v) + DVS.last u+        genLayer0 u = let indexN = DVS.length u in+          if indexN == 0+            then 0+            else getCount (popCount1Range (indexN * 0x100000000) 0x100000000 v) + DVS.last u+        genLayer1 u = let indexN = DVS.length u in+          let cum = if indexN == 0 -- TODO Check boundary at 4G???+              then  0+              else  csPoppy2Cum2048 !!! fromIntegral indexN in+          let a = getCount (popCount1Range (indexN * 32 +  0)  8 v) in+          let b = getCount (popCount1Range (indexN * 32 +  8)  8 v) in+          let c = getCount (popCount1Range (indexN * 32 + 16)  8 v) in+          (   ( cum       .&. 0x00000000ffffffff)+          .|. ((a .<. 32) .&. 0x000003ff00000000)+          .|. ((b .<. 42) .&. 0x000ffc0000000000)+          .|. ((c .<. 52) .&. 0x3ff0000000000000)) -- zhou-sea2013 fig 5 (c)+        genS :: (Count, Position) -> Maybe (Word64, (Count, Position))+        genS (pca, n) = if n < vEnd v+          then  let w = v !!! n in+                let pcz = pca + popCount1 w in+                if (8192 - 1 + pca) `div` 8192 /= (8192 - 1 + pcz) `div` 8192+                  then Just (fromIntegral n * 64 + fromIntegral (select1 w (fromIntegral (8192 - (pca `mod` 8192)))), (pcz, n + 1))+                  else genS (pcz, n + 1)+          else Nothing++instance BitRead CsPoppy2 where+  bitRead = fmap makeCsPoppy2 . bitRead++instance Rank1 CsPoppy2 where+  rank1 (CsPoppy2 v _ layer0 layer1 _) p = rankPrior + rankInBasicBlock+    where rankLayer0              = layer0  !!! toPosition (p `div` 0x100000000)+          rankLayer1Word          = layer1  !!! toPosition (p `div` 2048)+          rankLayer1A             =  rankLayer1Word .&. 0x00000000ffffffff+          rankLayer1B             = (rankLayer1Word .&. 0x000003ff00000000) .>. 32+          rankLayer1C             = (rankLayer1Word .&. 0x000ffc0000000000) .>. 42+          rankLayer1D             = (rankLayer1Word .&. 0x3ff0000000000000) .>. 52+          q                       = (p `div` 512) `mod` 4 -- quarter+          rankLayer1  | q == 0    = rankLayer1A+                      | q == 1    = rankLayer1A + rankLayer1B+                      | q == 2    = rankLayer1A + rankLayer1B + rankLayer1C+                      | q == 3    = rankLayer1A + rankLayer1B + rankLayer1C + rankLayer1D+                      | otherwise = undefined+          rankPrior               = Count (rankLayer0 + rankLayer1)+          rankInBasicBlock        = rank1 (DVS.drop (fromIntegral p `div` 512) v) (p `mod` 512)++instance Select1 CsPoppy2 where+  select1 (CsPoppy2 v i _ _ _) p = toCount q * 512 + select1 (DVS.drop (fromIntegral q * 8) v) (p - s)+    where q = binarySearch (fromIntegral p) wordAt 0 (fromIntegral $ DVS.length i - 1)+          s = Count (i !!! q)+          wordAt = (i !!!)++sampleRange :: CsPoppy2 -> Count -> (Word64, Word64)+sampleRange (CsPoppy2 _ index _ _ samples) p =+  let j = (fromIntegral p - 1) `div` 8192 in+  if 0 <= j && j < DVS.length samples+    then  let pa = samples DVS.! j                in+          if j + 1 < DVS.length samples+            then  let pz = samples DVS.! (j + 1)          in+                  (pa, pz)+            else (pa, fromIntegral (DVS.length index - 1))+    else (1, fromIntegral (DVS.length index - 1))

@@ -1,3 +1,5 @@+{-# LANGUAGE TypeFamilies #-}+ module HaskellWorks.Data.Succinct.RankSelect.Binary.Poppy512     ( Poppy512(..)     , Rank1(..)@@ -6,7 +8,9 @@  import qualified Data.Vector.Storable                                       as DVS import           Data.Word+import           HaskellWorks.Data.Bits.BitLength import           HaskellWorks.Data.Bits.BitRead+import           HaskellWorks.Data.Bits.BitWise import           HaskellWorks.Data.Bits.PopCount.PopCount1 import           HaskellWorks.Data.Positioning import           HaskellWorks.Data.Search@@ -31,16 +35,24 @@             then 0             else getCount (popCount1 (DVS.take 8 (DVS.drop (indexN * 8) v))) + DVS.last u +instance BitLength Poppy512 where+  bitLength v = vLength (poppy512Bits v) * bitLength (poppy512Bits v !!! 0)+  {-# INLINABLE bitLength #-}++instance TestBit Poppy512 where+  (.?.) = (.?.) . poppy512Bits+  {-# INLINE (.?.) #-}+ instance BitRead Poppy512 where   bitRead = fmap makePoppy512 . bitRead  instance Rank1 Poppy512 where   rank1 (Poppy512 v i) p =-    Count (i !!! toPosition (p `div` 512)) + rank1 (DVS.drop (fromIntegral p `div` 512) v) (p `mod` 512)+    Count (i !!! toPosition (p `div` 512)) + rank1 (DVS.drop ((fromIntegral p `div` 512) * 8) v) (p `mod` 512)  instance Rank0 Poppy512 where   rank0 (Poppy512 v i) p =-    p `div` 512 * 512 - Count (i !!! toPosition (p `div` 512)) + rank0 (DVS.drop (fromIntegral p `div` 512) v) (p `mod` 512)+    p `div` 512 * 512 - Count (i !!! toPosition (p `div` 512)) + rank0 (DVS.drop ((fromIntegral p `div` 512) * 8) v) (p `mod` 512)  instance Select1 Poppy512 where   select1 (Poppy512 v i) p = toCount q * 512 + select1 (DVS.drop (fromIntegral q * 8) v) (p - s)

@@ -0,0 +1,73 @@+module HaskellWorks.Data.Succinct.RankSelect.Binary.Poppy512S+    ( Poppy512S(..)+    , Rank1(..)+    , makePoppy512S+    , sampleRange+    ) where++import qualified Data.Vector.Storable                                       as DVS+import           Data.Word+import           HaskellWorks.Data.Bits.BitRead+import           HaskellWorks.Data.Bits.PopCount.PopCount1+import           HaskellWorks.Data.Positioning+import           HaskellWorks.Data.Search+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1+import           HaskellWorks.Data.Vector.VectorLike++data Poppy512S = Poppy512S+  { csPoppyBits     :: DVS.Vector Word64+  , csPoppy512Index :: DVS.Vector Word64+  , csPoppySamples  :: DVS.Vector Word64 -- Sampling position of each 8192 1-bit+  } deriving (Eq, Show)++popCount1Range :: (DVS.Storable a, PopCount1 a) => Int -> Int -> DVS.Vector a -> Count+popCount1Range start len = popCount1 . DVS.take len . DVS.drop start++makePoppy512S :: DVS.Vector Word64 -> Poppy512S+makePoppy512S v = Poppy512S+  { csPoppyBits     = v+  , csPoppy512Index = DVS.constructN (((DVS.length v +           8 - 1) `div`           8) + 1) gen512Index+  , csPoppySamples  = DVS.unfoldrN (fromIntegral (popCount1 v `div` 8192) + 1) genS (0, 0)+  }+  where gen512Index u = let indexN = DVS.length u - 1 in+          if indexN == -1+            then 0+            else getCount (popCount1Range (indexN *           8)           8 v) + DVS.last u+        genS :: (Count, Position) -> Maybe (Word64, (Count, Position))+        genS (pca, n) = if n < vEnd v+          then  let w = v !!! n in+                let pcz = pca + popCount1 w in+                if (8192 - 1 + pca) `div` 8192 /= (8192 - 1 + pcz) `div` 8192+                  then Just (fromIntegral n * 64 + fromIntegral (select1 w (fromIntegral (8192 - (pca `mod` 8192)))), (pcz, n + 1))+                  else genS (pcz, n + 1)+          else Nothing++instance BitRead Poppy512S where+  bitRead = fmap makePoppy512S . bitRead++instance Rank1 Poppy512S where+  rank1 (Poppy512S v i _) p =+    Count (i !!! toPosition (p `div` 512)) + rank1 (DVS.drop (fromIntegral p `div` 512) v) (p `mod` 512)++sampleRange :: Poppy512S -> Count -> (Word64, Word64)+sampleRange (Poppy512S _ index samples) p =+  let j = (fromIntegral p - 1) `div` 8192 in+  if 0 <= j && j < DVS.length samples+    then  let pa = samples DVS.! j                in+          if j + 1 < DVS.length samples+            then  let pz = samples DVS.! (j + 1)          in+                  (pa, pz)+            else (pa, fromIntegral (DVS.length index - 1))+    else (1, fromIntegral (DVS.length index - 1))++instance Select1 Poppy512S where+  select1 iv@(Poppy512S v i _) p = if DVS.length v /= 0+      then toCount q * 512 + select1 (DVS.drop (fromIntegral q * 8) v) (p - s)+      else 0+    where q = binarySearch (fromIntegral p) wordAt iMin iMax+          s = Count (i !!! q)+          wordAt = (i !!!)+          (sampleMin, sampleMax) = sampleRange iv p+          iMin = fromIntegral $  (sampleMin - 1) `div` 512      :: Position+          iMax = fromIntegral $ ((sampleMax - 1) `div` 512) + 1 :: Position

@@ -3,6 +3,8 @@  module HaskellWorks.Data.Succinct.RankSelect.Binary.BasicGen   ( genBinaryRankSelectSpec+  , genBinaryRank0Select0Spec+  , genBinaryRank1Select1Spec   ) where  import           Data.Typeable@@ -17,15 +19,23 @@ import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1Spec hiding (spec) import           Test.Hspec -genBinaryRankSelectSpec :: forall s. (Typeable s, BitRead s, Rank0 s, Rank1 s, Select0 s, Select1 s) => s -> Spec-genBinaryRankSelectSpec s = describe "Generically" $ do-  genRank0UpTo8Spec     s-  genRank0UpTo16Spec    s+genBinaryRank1Select1Spec :: forall s. (Typeable s, BitRead s, Rank1 s, Select1 s) => s -> Spec+genBinaryRank1Select1Spec s = describe "For Rank 1" $ do   genRank1UpTo8Spec     s   genRank1UpTo16Spec    s-  genSelect0UpTo8Spec   s-  genSelect0UpTo16Spec  s-  genSelect0UpTo32Spec  s   genSelect1UpTo8Spec   s   genSelect1UpTo16Spec  s   genSelect1UpTo32Spec  s++genBinaryRank0Select0Spec :: forall s. (Typeable s, BitRead s, Rank0 s, Select0 s) => s -> Spec+genBinaryRank0Select0Spec s = describe "For Rank 0" $ do+  genRank0UpTo8Spec     s+  genRank0UpTo16Spec    s+  genSelect0UpTo8Spec   s+  genSelect0UpTo16Spec  s+  genSelect0UpTo32Spec  s++genBinaryRankSelectSpec :: forall s. (Typeable s, BitRead s, Rank0 s, Rank1 s, Select0 s, Select1 s) => s -> Spec+genBinaryRankSelectSpec s = describe "Generically" $ do+  genBinaryRank1Select1Spec    s+  genBinaryRank0Select0Spec    s

@@ -0,0 +1,93 @@+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}+{-# LANGUAGE GeneralizedNewtypeDeriving       #-}+{-# LANGUAGE ScopedTypeVariables              #-}++module HaskellWorks.Data.Succinct.RankSelect.Binary.CsPoppy2Spec (spec) where++import           GHC.Exts+import           Data.Maybe+import qualified Data.Vector.Storable                                       as DVS+import           Data.Word+import           HaskellWorks.Data.Bits.BitRead+import           HaskellWorks.Data.Bits.BitShow+import           HaskellWorks.Data.Bits.PopCount.PopCount1+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1+import           HaskellWorks.Data.Succinct.RankSelect.Binary.BasicGen+import           HaskellWorks.Data.Succinct.RankSelect.Binary.CsPoppy2+import           HaskellWorks.Data.Vector.VectorLike+import           Test.Hspec+import           Test.QuickCheck++{-# ANN module ("HLint: ignore Redundant do" :: String) #-}+{-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}++newtype ShowVector a = ShowVector a deriving (Eq, BitShow)++instance BitShow a => Show (ShowVector a) where+  show = bitShow++vectorSizedBetween :: Int -> Int -> Gen (ShowVector (DVS.Vector Word64))+vectorSizedBetween a b = do+  n   <- choose (a, b)+  xs  <- sequence [ arbitrary | _ <- [1 .. n] ]+  return $ ShowVector (fromList xs)++spec :: Spec+spec = describe "HaskellWorks.Data.Succinct.RankSelect.Binary.CsPoppy2.Rank1Spec" $ do+  genBinaryRank1Select1Spec (undefined :: CsPoppy2)+  describe "rank1 for Vector Word64 is equivalent to rank1 for CsPoppy2" $ do+    it "on empty bitvector" $+      let v = DVS.empty in+      let w = makeCsPoppy2 v in+      let i = 0 in+      rank1 v i === rank1 w i+    it "on one basic block" $+      forAll (vectorSizedBetween 1 8) $ \(ShowVector v) ->+      forAll (choose (0, vLength v * 8)) $ \i ->+      let w = makeCsPoppy2 v in+      rank1 v i === rank1 w i+    it "on two basic blocks" $+      forAll (vectorSizedBetween 9 16) $ \(ShowVector v) ->+      forAll (choose (0, vLength v * 8)) $ \i ->+      let w = makeCsPoppy2 v in+      rank1 v i === rank1 w i+    it "on three basic blocks" $+      forAll (vectorSizedBetween 17 24) $ \(ShowVector v) ->+      forAll (choose (0, vLength v * 8)) $ \i ->+      let w = makeCsPoppy2 v in+      rank1 v i === rank1 w i+  describe "select1 for Vector Word64 is equivalent to select1 for CsPoppy2" $ do+    it "on empty bitvector" $+      let v = DVS.empty in+      let w = makeCsPoppy2 v in+      let i = 0 in+      select1 v i === select1 w i+    it "on one full zero basic block" $+      let v = fromList [0, 0, 0, 0, 0, 0, 0, 0] :: DVS.Vector Word64 in+      let w = makeCsPoppy2 v in+      select1 v 0 === select1 w 0+    it "on one basic block" $+      forAll (vectorSizedBetween 1 8) $ \(ShowVector v) ->+      forAll (choose (0, popCount1 v)) $ \i ->+      let w = makeCsPoppy2 v in+      select1 v i === select1 w i+    it "on two basic blocks" $+      forAll (vectorSizedBetween 9 16) $ \(ShowVector v) ->+      forAll (choose (0, popCount1 v)) $ \i ->+      let w = makeCsPoppy2 v in+      select1 v i === select1 w i+    it "on three basic blocks" $+      forAll (vectorSizedBetween 17 24) $ \(ShowVector v) ->+      forAll (choose (0, popCount1 v)) $ \i ->+      let w = makeCsPoppy2 v in+      select1 v i === select1 w i+  describe "Rank select over large buffer" $ do+    it "Rank works" $ do+      let cs = fromJust (bitRead (take 4096 (cycle "10"))) :: DVS.Vector Word64+      let ps = makeCsPoppy2 cs+      (rank1 ps `map` [1 .. 4096]) `shouldBe` [(x - 1) `div` 2 + 1 | x <- [1 .. 4096]]+    it "Select works" $ do+      let cs = fromJust (bitRead (take 4096 (cycle "10"))) :: DVS.Vector Word64+      let ps = makeCsPoppy2 cs+      (select1 ps `map` [1 .. 2048]) `shouldBe` [1, 3 .. 4096]

@@ -0,0 +1,93 @@+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE ScopedTypeVariables        #-}++module HaskellWorks.Data.Succinct.RankSelect.Binary.CsPoppySpec (spec) where++import           GHC.Exts+import           Data.Maybe+import qualified Data.Vector.Storable                                       as DVS+import           Data.Word+import           HaskellWorks.Data.Bits.BitRead+import           HaskellWorks.Data.Bits.BitShow+import           HaskellWorks.Data.Bits.PopCount.PopCount1+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1+import           HaskellWorks.Data.Succinct.RankSelect.Binary.BasicGen+import           HaskellWorks.Data.Succinct.RankSelect.Binary.CsPoppy+import           HaskellWorks.Data.Vector.VectorLike+import           Test.Hspec+import           Test.QuickCheck++{-# ANN module ("HLint: ignore Redundant do" :: String) #-}+{-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}++newtype ShowVector a = ShowVector a deriving (Eq, BitShow)++instance BitShow a => Show (ShowVector a) where+  show = bitShow++vectorSizedBetween :: Int -> Int -> Gen (ShowVector (DVS.Vector Word64))+vectorSizedBetween a b = do+  n   <- choose (a, b)+  xs  <- sequence [ arbitrary | _ <- [1 .. n] ]+  return $ ShowVector (fromList xs)++spec :: Spec+spec = describe "HaskellWorks.Data.Succinct.RankSelect.Binary.CsPoppy.Rank1Spec" $ do+  genBinaryRank1Select1Spec (undefined :: CsPoppy)+  describe "rank1 for Vector Word64 is equivalent to rank1 for CsPoppy" $ do+    it "on empty bitvector" $+      let v = DVS.empty in+      let w = makeCsPoppy v in+      let i = 0 in+      rank1 v i === rank1 w i+    it "on one basic block" $+      forAll (vectorSizedBetween 1 8) $ \(ShowVector v) ->+      forAll (choose (0, vLength v * 8)) $ \i ->+      let w = makeCsPoppy v in+      rank1 v i === rank1 w i+    it "on two basic blocks" $+      forAll (vectorSizedBetween 9 16) $ \(ShowVector v) ->+      forAll (choose (0, vLength v * 8)) $ \i ->+      let w = makeCsPoppy v in+      rank1 v i === rank1 w i+    it "on three basic blocks" $+      forAll (vectorSizedBetween 17 24) $ \(ShowVector v) ->+      forAll (choose (0, vLength v * 8)) $ \i ->+      let w = makeCsPoppy v in+      rank1 v i === rank1 w i+  describe "select1 for Vector Word64 is equivalent to select1 for CsPoppy" $ do+    it "on empty bitvector" $+      let v = DVS.empty in+      let w = makeCsPoppy v in+      let i = 0 in+      select1 v i === select1 w i+    it "on one full zero basic block" $+      let v = fromList [0, 0, 0, 0, 0, 0, 0, 0] :: DVS.Vector Word64 in+      let w = makeCsPoppy v in+      select1 v 0 === select1 w 0+    it "on one basic block" $+      forAll (vectorSizedBetween 1 8) $ \(ShowVector v) ->+      forAll (choose (0, popCount1 v)) $ \i ->+      let w = makeCsPoppy v in+      select1 v i === select1 w i+    it "on two basic blocks" $+      forAll (vectorSizedBetween 9 16) $ \(ShowVector v) ->+      forAll (choose (0, popCount1 v)) $ \i ->+      let w = makeCsPoppy v in+      select1 v i === select1 w i+    it "on three basic blocks" $+      forAll (vectorSizedBetween 17 24) $ \(ShowVector v) ->+      forAll (choose (0, popCount1 v)) $ \i ->+      let w = makeCsPoppy v in+      select1 v i === select1 w i+  describe "Rank select over large buffer" $ do+    it "Rank works" $ do+      let cs = fromJust (bitRead (take 4096 (cycle "10"))) :: DVS.Vector Word64+      let ps = makeCsPoppy cs+      (rank1 ps `map` [1 .. 4096]) `shouldBe` [(x - 1) `div` 2 + 1 | x <- [1 .. 4096]]+    it "Select works" $ do+      let cs = fromJust (bitRead (take 4096 (cycle "10"))) :: DVS.Vector Word64+      let ps = makeCsPoppy cs+      (select1 ps `map` [1 .. 2048]) `shouldBe` [1, 3 .. 4096]

@@ -0,0 +1,93 @@+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}+{-# LANGUAGE GeneralizedNewtypeDeriving       #-}+{-# LANGUAGE ScopedTypeVariables              #-}++module HaskellWorks.Data.Succinct.RankSelect.Binary.Poppy512SSpec (spec) where++import           GHC.Exts+import           Data.Maybe+import qualified Data.Vector.Storable                                       as DVS+import           Data.Word+import           HaskellWorks.Data.Bits.BitRead+import           HaskellWorks.Data.Bits.BitShow+import           HaskellWorks.Data.Bits.PopCount.PopCount1+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1+import           HaskellWorks.Data.Succinct.RankSelect.Binary.BasicGen+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Poppy512S+import           HaskellWorks.Data.Vector.VectorLike+import           Test.Hspec+import           Test.QuickCheck++{-# ANN module ("HLint: ignore Redundant do" :: String) #-}+{-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}++newtype ShowVector a = ShowVector a deriving (Eq, BitShow)++instance BitShow a => Show (ShowVector a) where+  show = bitShow++vectorSizedBetween :: Int -> Int -> Gen (ShowVector (DVS.Vector Word64))+vectorSizedBetween a b = do+  n   <- choose (a, b)+  xs  <- sequence [ arbitrary | _ <- [1 .. n] ]+  return $ ShowVector (fromList xs)++spec :: Spec+spec = describe "HaskellWorks.Data.Succinct.RankSelect.Binary.Poppy512S.Rank1Spec" $ do+  genBinaryRank1Select1Spec (undefined :: Poppy512S)+  describe "rank1 for Vector Word64 is equivalent to rank1 for Poppy512S" $ do+    it "on empty bitvector" $+      let v = DVS.empty in+      let w = makePoppy512S v in+      let i = 0 in+      rank1 v i === rank1 w i+    it "on one basic block" $+      forAll (vectorSizedBetween 1 8) $ \(ShowVector v) ->+      forAll (choose (0, vLength v * 8)) $ \i ->+      let w = makePoppy512S v in+      rank1 v i === rank1 w i+    it "on two basic blocks" $+      forAll (vectorSizedBetween 9 16) $ \(ShowVector v) ->+      forAll (choose (0, vLength v * 8)) $ \i ->+      let w = makePoppy512S v in+      rank1 v i === rank1 w i+    it "on three basic blocks" $+      forAll (vectorSizedBetween 17 24) $ \(ShowVector v) ->+      forAll (choose (0, vLength v * 8)) $ \i ->+      let w = makePoppy512S v in+      rank1 v i === rank1 w i+  describe "select1 for Vector Word64 is equivalent to select1 for Poppy512S" $ do+    it "on empty bitvector" $+      let v = DVS.empty in+      let w = makePoppy512S v in+      let i = 0 in+      select1 v i === select1 w i+    it "on one full zero basic block" $+      let v = fromList [0, 0, 0, 0, 0, 0, 0, 0] :: DVS.Vector Word64 in+      let w = makePoppy512S v in+      select1 v 0 === select1 w 0+    it "on one basic block" $+      forAll (vectorSizedBetween 1 8) $ \(ShowVector v) ->+      forAll (choose (0, popCount1 v)) $ \i ->+      let w = makePoppy512S v in+      select1 v i === select1 w i+    it "on two basic blocks" $+      forAll (vectorSizedBetween 9 16) $ \(ShowVector v) ->+      forAll (choose (0, popCount1 v)) $ \i ->+      let w = makePoppy512S v in+      select1 v i === select1 w i+    it "on three basic blocks" $+      forAll (vectorSizedBetween 17 24) $ \(ShowVector v) ->+      forAll (choose (0, popCount1 v)) $ \i ->+      let w = makePoppy512S v in+      select1 v i === select1 w i+  describe "Rank select over large buffer" $ do+    it "Rank works" $ do+      let cs = fromJust (bitRead (take 4096 (cycle "10"))) :: DVS.Vector Word64+      let ps = makePoppy512S cs+      (rank1 ps `map` [1 .. 4096]) `shouldBe` [(x - 1) `div` 2 + 1 | x <- [1 .. 4096]]+    it "Select works" $ do+      let cs = fromJust (bitRead (take 4096 (cycle "10"))) :: DVS.Vector Word64+      let ps = makePoppy512S cs+      (select1 ps `map` [1 .. 2048]) `shouldBe` [1, 3 .. 4096]

@@ -5,8 +5,10 @@ module HaskellWorks.Data.Succinct.RankSelect.Binary.Poppy512Spec (spec) where  import           GHC.Exts+import           Data.Maybe import qualified Data.Vector.Storable                                       as DVS import           Data.Word+import           HaskellWorks.Data.Bits.BitRead import           HaskellWorks.Data.Bits.BitShow import           HaskellWorks.Data.Bits.PopCount.PopCount0 import           HaskellWorks.Data.Bits.PopCount.PopCount1@@ -129,3 +131,12 @@       forAll (choose (0, popCount1 v)) $ \i ->       let w = makePoppy512 v in       select1 v i === select1 w i+  describe "Rank select over large buffer" $ do+    it "Rank works" $ do+      let cs = fromJust (bitRead (take 4096 (cycle "10"))) :: DVS.Vector Word64+      let ps = makePoppy512 cs+      (rank1 ps `map` [1 .. 4096]) `shouldBe` [(x - 1) `div` 2 + 1 | x <- [1 .. 4096]]+    it "Select works" $ do+      let cs = fromJust (bitRead (take 4096 (cycle "10"))) :: DVS.Vector Word64+      let ps = makePoppy512 cs+      (select1 ps `map` [1 .. 2048]) `shouldBe` [1, 3 .. 4096]