diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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 +``` diff --git a/hw-rankselect.cabal b/hw-rankselect.cabal --- a/hw-rankselect.cabal +++ b/hw-rankselect.cabal @@ -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 diff --git a/src/HaskellWorks/Data/Succinct/BalancedParens/Simple.hs b/src/HaskellWorks/Data/Succinct/BalancedParens/Simple.hs --- a/src/HaskellWorks/Data/Succinct/BalancedParens/Simple.hs +++ b/src/HaskellWorks/Data/Succinct/BalancedParens/Simple.hs @@ -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) diff --git a/src/HaskellWorks/Data/Succinct/RankSelect/Binary/CsPoppy.hs b/src/HaskellWorks/Data/Succinct/RankSelect/Binary/CsPoppy.hs new file mode 100644 --- /dev/null +++ b/src/HaskellWorks/Data/Succinct/RankSelect/Binary/CsPoppy.hs @@ -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)) diff --git a/src/HaskellWorks/Data/Succinct/RankSelect/Binary/CsPoppy2.hs b/src/HaskellWorks/Data/Succinct/RankSelect/Binary/CsPoppy2.hs new file mode 100644 --- /dev/null +++ b/src/HaskellWorks/Data/Succinct/RankSelect/Binary/CsPoppy2.hs @@ -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)) diff --git a/src/HaskellWorks/Data/Succinct/RankSelect/Binary/Poppy512.hs b/src/HaskellWorks/Data/Succinct/RankSelect/Binary/Poppy512.hs --- a/src/HaskellWorks/Data/Succinct/RankSelect/Binary/Poppy512.hs +++ b/src/HaskellWorks/Data/Succinct/RankSelect/Binary/Poppy512.hs @@ -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) diff --git a/src/HaskellWorks/Data/Succinct/RankSelect/Binary/Poppy512S.hs b/src/HaskellWorks/Data/Succinct/RankSelect/Binary/Poppy512S.hs new file mode 100644 --- /dev/null +++ b/src/HaskellWorks/Data/Succinct/RankSelect/Binary/Poppy512S.hs @@ -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 diff --git a/test/HaskellWorks/Data/Succinct/RankSelect/Binary/BasicGen.hs b/test/HaskellWorks/Data/Succinct/RankSelect/Binary/BasicGen.hs --- a/test/HaskellWorks/Data/Succinct/RankSelect/Binary/BasicGen.hs +++ b/test/HaskellWorks/Data/Succinct/RankSelect/Binary/BasicGen.hs @@ -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 diff --git a/test/HaskellWorks/Data/Succinct/RankSelect/Binary/CsPoppy2Spec.hs b/test/HaskellWorks/Data/Succinct/RankSelect/Binary/CsPoppy2Spec.hs new file mode 100644 --- /dev/null +++ b/test/HaskellWorks/Data/Succinct/RankSelect/Binary/CsPoppy2Spec.hs @@ -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] diff --git a/test/HaskellWorks/Data/Succinct/RankSelect/Binary/CsPoppySpec.hs b/test/HaskellWorks/Data/Succinct/RankSelect/Binary/CsPoppySpec.hs new file mode 100644 --- /dev/null +++ b/test/HaskellWorks/Data/Succinct/RankSelect/Binary/CsPoppySpec.hs @@ -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] diff --git a/test/HaskellWorks/Data/Succinct/RankSelect/Binary/Poppy512SSpec.hs b/test/HaskellWorks/Data/Succinct/RankSelect/Binary/Poppy512SSpec.hs new file mode 100644 --- /dev/null +++ b/test/HaskellWorks/Data/Succinct/RankSelect/Binary/Poppy512SSpec.hs @@ -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] diff --git a/test/HaskellWorks/Data/Succinct/RankSelect/Binary/Poppy512Spec.hs b/test/HaskellWorks/Data/Succinct/RankSelect/Binary/Poppy512Spec.hs --- a/test/HaskellWorks/Data/Succinct/RankSelect/Binary/Poppy512Spec.hs +++ b/test/HaskellWorks/Data/Succinct/RankSelect/Binary/Poppy512Spec.hs @@ -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]