diff --git a/app/Main.hs b/app/Main.hs deleted file mode 100644 --- a/app/Main.hs +++ /dev/null @@ -1,4 +0,0 @@ -module Main where - -main :: IO () -main = putStrLn "Hello world" diff --git a/bench/Main.hs b/bench/Main.hs deleted file mode 100644 --- a/bench/Main.hs +++ /dev/null @@ -1,76 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Main where - -import Criterion.Main -import qualified Data.Vector.Storable as DVS -import Data.Word -import HaskellWorks.Data.Bits.Broadword -import HaskellWorks.Data.Bits.FromBitTextByteString -import HaskellWorks.Data.Naive -import HaskellWorks.Data.RankSelect.Base -import HaskellWorks.Data.Succinct.BalancedParens.FindClose -import HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax - -setupEnvVector :: Int -> IO (DVS.Vector Word64) -setupEnvVector n = return $ DVS.fromList (take n (cycle [maxBound, 0])) - -setupEnvRmmVector :: Int -> IO (RangeMinMax (DVS.Vector Word64)) -setupEnvRmmVector n = return $ mkRangeMinMax $ DVS.fromList (take n (cycle [maxBound, 0])) - -setupEnvBP2 :: IO Word64 -setupEnvBP2 = return $ DVS.head (fromBitTextByteString "10") - -setupEnvBP4 :: IO Word64 -setupEnvBP4 = return $ DVS.head (fromBitTextByteString "1100") - -setupEnvBP8 :: IO Word64 -setupEnvBP8 = return $ DVS.head (fromBitTextByteString "11101000") - -setupEnvBP16 :: IO Word64 -setupEnvBP16 = return $ DVS.head (fromBitTextByteString "11111000 11100000") - -setupEnvBP32 :: IO Word64 -setupEnvBP32 = return $ DVS.head (fromBitTextByteString "11111000 11101000 11101000 11100000") - -setupEnvBP64 :: IO Word64 -setupEnvBP64 = return $ DVS.head (fromBitTextByteString "11111000 11101000 11101000 11101000 11101000 11101000 11101000 11100000") - -benchRankSelect :: [Benchmark] -benchRankSelect = - [ env setupEnvBP2 $ \w -> bgroup "FindClose 2-bit" - [ bench "Broadword" (whnf (findClose (Broadword w)) 1) - , bench "Naive" (whnf (findClose (Naive w)) 1) - ] - , env setupEnvBP4 $ \w -> bgroup "FindClose 4-bit" - [ bench "Broadword" (whnf (findClose (Broadword w)) 1) - , bench "Naive" (whnf (findClose (Naive w)) 1) - ] - , env setupEnvBP8 $ \w -> bgroup "FindClose 8-bit" - [ bench "Broadword" (whnf (findClose (Broadword w)) 1) - , bench "Naive" (whnf (findClose (Naive w)) 1) - ] - , env setupEnvBP16 $ \w -> bgroup "FindClose 16-bit" - [ bench "Broadword" (whnf (findClose (Broadword w)) 1) - , bench "Naive" (whnf (findClose (Naive w)) 1) - ] - , env setupEnvBP32 $ \w -> bgroup "FindClose 32-bit" - [ bench "Broadword" (whnf (findClose (Broadword w)) 1) - , bench "Naive" (whnf (findClose (Naive w)) 1) - ] - , env setupEnvBP64 $ \w -> bgroup "FindClose 64-bit" - [ bench "Broadword" (whnf (findClose (Broadword w)) 1) - , bench "Naive" (whnf (findClose (Naive w)) 1) - ] - , env (setupEnvVector 1000000) $ \bv -> bgroup "RangeMinMax" - [ bench "findClose" (nf (map (findClose bv)) [0, 1000..10000000]) - ] - , env (setupEnvVector 1000000) $ \bv -> bgroup "Rank" - [ bench "Rank - Once" (whnf (rank1 bv) 1) - , bench "Select - Once" (whnf (select1 bv) 1) - , bench "Rank - Many" (nf (map (rank1 bv)) [0, 1000..10000000]) - ] - ] - -main :: IO () -main = defaultMain benchRankSelect 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.5.0.0 +version: 0.6.0.0 synopsis: Conduits for tokenizing streams. description: Please see README.md homepage: http://github.com/haskell-works/hw-rankselect#readme @@ -13,39 +13,14 @@ extra-source-files: README.md cabal-version: >= 1.22 -executable hw-rankselect-example - hs-source-dirs: app - main-is: Main.hs - ghc-options: -threaded -rtsopts -with-rtsopts=-N -O2 -Wall -msse4.2 - build-depends: base >= 4 && < 5 - , hw-rankselect - default-language: Haskell2010 - library hs-source-dirs: src - exposed-modules: HaskellWorks.Data.Succinct.BalancedParens - , HaskellWorks.Data.Succinct.BalancedParens.BalancedParens - , HaskellWorks.Data.Succinct.BalancedParens.Broadword - , HaskellWorks.Data.Succinct.BalancedParens.CloseAt - , HaskellWorks.Data.Succinct.BalancedParens.Enclose - , HaskellWorks.Data.Succinct.BalancedParens.FindClose - , HaskellWorks.Data.Succinct.BalancedParens.FindCloseN - , HaskellWorks.Data.Succinct.BalancedParens.FindOpen - , HaskellWorks.Data.Succinct.BalancedParens.FindOpenN - , HaskellWorks.Data.Succinct.BalancedParens.NewCloseAt - , HaskellWorks.Data.Succinct.BalancedParens.NewOpenAt - , HaskellWorks.Data.Succinct.BalancedParens.OpenAt - , HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax - , HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax2 - , HaskellWorks.Data.Succinct.BalancedParens.Simple - , HaskellWorks.Data.Succinct.EliasFano64 - , HaskellWorks.Data.Succinct.EliasFano64.Internal - , HaskellWorks.Data.Succinct.NearestNeighbour - , HaskellWorks.Data.Succinct.RankSelect.Binary.CsPoppy - , HaskellWorks.Data.Succinct.RankSelect.Binary.CsPoppy2 - , HaskellWorks.Data.Succinct.RankSelect.Binary.Poppy512 - , HaskellWorks.Data.Succinct.RankSelect.Binary.Poppy512S + exposed-modules: HaskellWorks.Data.RankSelect.CsPoppy + , HaskellWorks.Data.RankSelect.CsPoppy2 + , HaskellWorks.Data.RankSelect.Poppy512 + , HaskellWorks.Data.RankSelect.Poppy512S build-depends: base >= 4 && < 5 + , hw-balancedparens >= 0.0.0.1 , hw-bits >= 0.3.0.0 , hw-excess >= 0.0.0.1 , hw-prim >= 0.3.0.5 @@ -61,18 +36,13 @@ type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Spec.hs - other-modules: HaskellWorks.Data.Succinct.BalancedParens.Internal.BroadwordSpec - , HaskellWorks.Data.Succinct.BalancedParens.RangeMinMaxSpec - , HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax2Spec - , HaskellWorks.Data.Succinct.BalancedParens.SimpleSpec - , HaskellWorks.Data.Succinct.EliasFano64Spec - , 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 + other-modules: HaskellWorks.Data.RankSelect.BasicGen + , HaskellWorks.Data.RankSelect.CsPoppySpec + , HaskellWorks.Data.RankSelect.CsPoppy2Spec + , HaskellWorks.Data.RankSelect.Poppy512Spec + , HaskellWorks.Data.RankSelect.Poppy512SSpec + , HaskellWorks.Data.RankSelect.InternalSpec + , HaskellWorks.Data.RankSelect.SimpleSpec build-depends: base >= 4 && < 5 , hspec , hw-bits >= 0.3.0.0 @@ -87,20 +57,3 @@ source-repository head type: git location: https://github.com/haskell-works/hw-rankselect - -benchmark bench - Type: exitcode-stdio-1.0 - HS-Source-Dirs: bench - Main-Is: Main.hs - GHC-Options: -O2 -Wall -msse4.2 - Default-Language: Haskell2010 - Build-Depends: base >= 4 && < 5 - , bytestring - , conduit - , criterion - , hw-bits >= 0.3.0.0 - , hw-prim >= 0.3.0.5 - , hw-rankselect - , hw-rankselect-base >= 0.1.0.0 - , mmap - , vector diff --git a/src/HaskellWorks/Data/RankSelect/CsPoppy.hs b/src/HaskellWorks/Data/RankSelect/CsPoppy.hs new file mode 100644 --- /dev/null +++ b/src/HaskellWorks/Data/RankSelect/CsPoppy.hs @@ -0,0 +1,120 @@ +module HaskellWorks.Data.RankSelect.CsPoppy + ( CsPoppy(..) + , Rank1(..) + , makeCsPoppy + , sampleRange + ) where + +import qualified Data.Vector.Storable as DVS +import Data.Word +import HaskellWorks.Data.AtIndex +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 HaskellWorks.Data.Search +import HaskellWorks.Data.Vector.AsVector64 + +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) + +instance AsVector64 CsPoppy where + asVector64 = asVector64 . csPoppyBits + {-# INLINE asVector64 #-} + +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 popCount1Range (indexN * 8) 8 v + DVS.last u + genCum2048 u = let indexN = DVS.length u in + if indexN .&. 0xffffffff == 0 + then 0 + else popCount1Range ((indexN - 1) * 32) 32 v + DVS.last u + genLayer0 u = let indexN = DVS.length u in + if indexN == 0 + then 0 + else 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 = popCount1Range (indexN * 32 + 0) 8 v in + let b = popCount1Range (indexN * 32 + 8) 8 v in + let c = 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 < end 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 = (rankLayer0 + rankLayer1) :: Count + 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 = (i !!! q) :: Count + 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/RankSelect/CsPoppy2.hs b/src/HaskellWorks/Data/RankSelect/CsPoppy2.hs new file mode 100644 --- /dev/null +++ b/src/HaskellWorks/Data/RankSelect/CsPoppy2.hs @@ -0,0 +1,111 @@ +module HaskellWorks.Data.RankSelect.CsPoppy2 + ( CsPoppy2(..) + , Rank1(..) + , makeCsPoppy2 + , sampleRange + ) where + +import qualified Data.Vector.Storable as DVS +import Data.Word +import HaskellWorks.Data.AtIndex +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 HaskellWorks.Data.Search +import HaskellWorks.Data.Vector.AsVector64 + +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) + +instance AsVector64 CsPoppy2 where + asVector64 = asVector64 . csPoppy2Bits + {-# INLINE asVector64 #-} + +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 popCount1Range (indexN * 8) 8 v + DVS.last u + genCum2048 u = let indexN = DVS.length u in + if indexN .&. 0xffffffff == 0 + then 0 + else popCount1Range ((indexN - 1) * 32) 32 v + DVS.last u + genLayer0 u = let indexN = DVS.length u in + if indexN == 0 + then 0 + else 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 = popCount1Range (indexN * 32 + 0) 8 v in + let b = popCount1Range (indexN * 32 + 8) 8 v in + let c = 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 < end 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 = (rankLayer0 + rankLayer1) :: Count + 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 = (i !!! q) :: Count + 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/RankSelect/Poppy512.hs b/src/HaskellWorks/Data/RankSelect/Poppy512.hs new file mode 100644 --- /dev/null +++ b/src/HaskellWorks/Data/RankSelect/Poppy512.hs @@ -0,0 +1,122 @@ +{-# LANGUAGE TypeFamilies #-} + +module HaskellWorks.Data.RankSelect.Poppy512 + ( Poppy512(..) + , Rank1(..) + , makePoppy512 + ) where + +import qualified Data.Vector.Storable as DVS +import Data.Word +import HaskellWorks.Data.AtIndex +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.RankSelect.Base.Rank0 +import HaskellWorks.Data.RankSelect.Base.Rank1 +import HaskellWorks.Data.RankSelect.Base.Select0 +import HaskellWorks.Data.RankSelect.Base.Select1 +import HaskellWorks.Data.Search +import HaskellWorks.Data.BalancedParens.BalancedParens +import HaskellWorks.Data.BalancedParens.CloseAt +import HaskellWorks.Data.BalancedParens.Enclose +import HaskellWorks.Data.BalancedParens.FindClose +import HaskellWorks.Data.BalancedParens.FindOpen +import HaskellWorks.Data.BalancedParens.FindCloseN +import HaskellWorks.Data.BalancedParens.FindOpenN +import HaskellWorks.Data.BalancedParens.NewCloseAt +import HaskellWorks.Data.BalancedParens.OpenAt +import HaskellWorks.Data.Vector.AsVector64 +import Prelude hiding (length) + +data Poppy512 = Poppy512 + { poppy512Bits :: DVS.Vector Word64 + , poppy512Index :: DVS.Vector Word64 + } deriving (Eq, Show) + +instance AsVector64 Poppy512 where + asVector64 = asVector64 . poppy512Bits + {-# INLINE asVector64 #-} + +makePoppy512 :: DVS.Vector Word64 -> Poppy512 +makePoppy512 v = Poppy512 + { poppy512Bits = v + , poppy512Index = DVS.constructN (((DVS.length v + 7) `div` 8) + 1) gen512Index + } + where gen512Index u = let indexN = DVS.length u - 1 in + if indexN == -1 + then 0 + else popCount1 (DVS.take 8 (DVS.drop (indexN * 8) v)) + DVS.last u + +instance BitLength Poppy512 where + bitLength v = length (poppy512Bits v) * bitLength (poppy512Bits v !!! 0) + {-# INLINE bitLength #-} + +instance TestBit Poppy512 where + (.?.) = (.?.) . poppy512Bits + {-# INLINE (.?.) #-} + +instance BitRead Poppy512 where + bitRead = fmap makePoppy512 . bitRead + +instance Rank1 Poppy512 where + rank1 (Poppy512 v i) p = + (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 - (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) + where q = binarySearch (fromIntegral p) wordAt 0 (fromIntegral $ DVS.length i - 1) + s = (i !!! q) :: Count + wordAt = (i !!!) + +instance Select0 Poppy512 where + select0 (Poppy512 v i) p = toCount q * 512 + select0 (DVS.drop (fromIntegral q * 8) v) (p - s) + where q = binarySearch (fromIntegral p) wordAt 0 (fromIntegral $ DVS.length i - 1) + s = (fromIntegral q * 512 - (i !!! q)) :: Count + wordAt o = fromIntegral o * 512 - (i !!! o) + +instance OpenAt Poppy512 where + openAt = openAt . poppy512Bits + {-# INLINE openAt #-} + +instance CloseAt Poppy512 where + closeAt = closeAt . poppy512Bits + {-# INLINE closeAt #-} + +instance FindOpenN Poppy512 where + findOpenN = findOpenN . poppy512Bits + {-# INLINE findOpenN #-} + +instance FindCloseN Poppy512 where + findCloseN = findCloseN . poppy512Bits + {-# INLINE findCloseN #-} + +instance FindOpen Poppy512 where + findOpen = findOpen . poppy512Bits + {-# INLINE findOpen #-} + +instance FindClose Poppy512 where + findClose = findClose . poppy512Bits + {-# INLINE findClose #-} + +instance NewCloseAt Poppy512 where + newCloseAt = newCloseAt . poppy512Bits + {-# INLINE newCloseAt #-} + +instance Enclose Poppy512 where + enclose = enclose . poppy512Bits + {-# INLINE enclose #-} + +instance BalancedParens Poppy512 where + firstChild = firstChild . poppy512Bits + nextSibling = nextSibling . poppy512Bits + parent = parent . poppy512Bits + {-# INLINE firstChild #-} + {-# INLINE nextSibling #-} + {-# INLINE parent #-} diff --git a/src/HaskellWorks/Data/RankSelect/Poppy512S.hs b/src/HaskellWorks/Data/RankSelect/Poppy512S.hs new file mode 100644 --- /dev/null +++ b/src/HaskellWorks/Data/RankSelect/Poppy512S.hs @@ -0,0 +1,143 @@ +module HaskellWorks.Data.RankSelect.Poppy512S + ( Poppy512S(..) + , Rank1(..) + , makePoppy512S + , sampleRange + ) where + +import qualified Data.Vector.Storable as DVS +import Data.Word +import HaskellWorks.Data.AtIndex +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.RankSelect.Base.Rank0 +import HaskellWorks.Data.RankSelect.Base.Rank1 +import HaskellWorks.Data.RankSelect.Base.Select1 +import HaskellWorks.Data.Search +import HaskellWorks.Data.BalancedParens.BalancedParens +import HaskellWorks.Data.BalancedParens.CloseAt +import HaskellWorks.Data.BalancedParens.Enclose +import HaskellWorks.Data.BalancedParens.FindClose +import HaskellWorks.Data.BalancedParens.FindCloseN +import HaskellWorks.Data.BalancedParens.FindOpen +import HaskellWorks.Data.BalancedParens.FindOpenN +import HaskellWorks.Data.BalancedParens.NewCloseAt +import HaskellWorks.Data.BalancedParens.OpenAt +import HaskellWorks.Data.Vector.AsVector64 +import Prelude hiding (length) + +data Poppy512S = Poppy512S + { poppy512SBits :: DVS.Vector Word64 + , poppy512Index :: DVS.Vector Word64 + , poppy512Samples :: DVS.Vector Word64 -- Sampling position of each 8192 1-bit + } deriving (Eq, Show) + +instance AsVector64 Poppy512S where + asVector64 = asVector64 . poppy512SBits + {-# INLINE asVector64 #-} + +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 + { poppy512SBits = v + , poppy512Index = DVS.constructN (((DVS.length v + 8 - 1) `div` 8) + 1) gen512Index + , poppy512Samples = 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 popCount1Range (indexN * 8) 8 v + DVS.last u + genS :: (Count, Position) -> Maybe (Word64, (Count, Position)) + genS (pca, n) = if n < end 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 BitLength Poppy512S where + bitLength v = length (poppy512SBits v) * bitLength (poppy512SBits v !!! 0) + {-# INLINE bitLength #-} + +instance TestBit Poppy512S where + (.?.) = (.?.) . poppy512SBits + {-# INLINE (.?.) #-} + +instance BitRead Poppy512S where + bitRead = fmap makePoppy512S . bitRead + +instance Rank1 Poppy512S where + rank1 (Poppy512S v i _) p = + (i !!! toPosition (p `div` 512)) + rank1 (DVS.drop ((fromIntegral p `div` 512) * 8) v) (p `mod` 512) + +instance Rank0 Poppy512S where + rank0 (Poppy512S v i _) p = + p `div` 512 * 512 - (i !!! toPosition (p `div` 512)) + rank0 (DVS.drop ((fromIntegral p `div` 512) * 8) 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 = (i !!! q) :: Count + wordAt = (i !!!) + (sampleMin, sampleMax) = sampleRange iv p + iMin = fromIntegral $ (sampleMin - 1) `div` 512 :: Position + iMax = fromIntegral $ ((sampleMax - 1) `div` 512) + 1 :: Position + +instance OpenAt Poppy512S where + openAt = openAt . poppy512SBits + {-# INLINE openAt #-} + +instance CloseAt Poppy512S where + closeAt = closeAt . poppy512SBits + {-# INLINE closeAt #-} + +instance NewCloseAt Poppy512S where + newCloseAt = newCloseAt . poppy512SBits + {-# INLINE newCloseAt #-} + +instance FindOpenN Poppy512S where + findOpenN = findOpenN . poppy512SBits + {-# INLINE findOpenN #-} + +instance FindOpen Poppy512S where + findOpen = findOpen . poppy512SBits + {-# INLINE findOpen #-} + +instance FindClose Poppy512S where + findClose = findClose . poppy512SBits + {-# INLINE findClose #-} + +instance FindCloseN Poppy512S where + findCloseN = findCloseN . poppy512SBits + {-# INLINE findCloseN #-} + +instance Enclose Poppy512S where + enclose = enclose . poppy512SBits + {-# INLINE enclose #-} + +instance BalancedParens Poppy512S where + firstChild = firstChild . poppy512SBits + nextSibling = nextSibling . poppy512SBits + parent = parent . poppy512SBits + {-# INLINE firstChild #-} + {-# INLINE nextSibling #-} + {-# INLINE parent #-} diff --git a/src/HaskellWorks/Data/Succinct/BalancedParens.hs b/src/HaskellWorks/Data/Succinct/BalancedParens.hs deleted file mode 100644 --- a/src/HaskellWorks/Data/Succinct/BalancedParens.hs +++ /dev/null @@ -1,13 +0,0 @@ -module HaskellWorks.Data.Succinct.BalancedParens - ( module X - ) where - -import HaskellWorks.Data.Succinct.BalancedParens.BalancedParens as X -import HaskellWorks.Data.Succinct.BalancedParens.CloseAt as X -import HaskellWorks.Data.Succinct.BalancedParens.Enclose as X -import HaskellWorks.Data.Succinct.BalancedParens.FindClose as X -import HaskellWorks.Data.Succinct.BalancedParens.FindCloseN as X -import HaskellWorks.Data.Succinct.BalancedParens.FindOpen as X -import HaskellWorks.Data.Succinct.BalancedParens.FindOpenN as X -import HaskellWorks.Data.Succinct.BalancedParens.OpenAt as X -import HaskellWorks.Data.Succinct.BalancedParens.Simple as X diff --git a/src/HaskellWorks/Data/Succinct/BalancedParens/BalancedParens.hs b/src/HaskellWorks/Data/Succinct/BalancedParens/BalancedParens.hs deleted file mode 100644 --- a/src/HaskellWorks/Data/Succinct/BalancedParens/BalancedParens.hs +++ /dev/null @@ -1,65 +0,0 @@ -{-# LANGUAGE FlexibleInstances #-} - -module HaskellWorks.Data.Succinct.BalancedParens.BalancedParens - ( BalancedParens(..) - , depth - , subtreeSize - ) where - -import Control.Monad -import qualified Data.Vector.Storable as DVS -import Data.Word -import HaskellWorks.Data.Naive -import HaskellWorks.Data.Positioning -import HaskellWorks.Data.RankSelect.Base.Rank0 -import HaskellWorks.Data.RankSelect.Base.Rank1 -import HaskellWorks.Data.Succinct.BalancedParens.CloseAt -import HaskellWorks.Data.Succinct.BalancedParens.Enclose -import HaskellWorks.Data.Succinct.BalancedParens.FindClose -import HaskellWorks.Data.Succinct.BalancedParens.FindOpen -import HaskellWorks.Data.Succinct.BalancedParens.OpenAt - -class (OpenAt v, CloseAt v, FindOpen v, FindClose v, Enclose v) => BalancedParens v where - -- TODO Second argument should be Int - firstChild :: v -> Count -> Maybe Count - nextSibling :: v -> Count -> Maybe Count - parent :: v -> Count -> Maybe Count - 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) - {-# INLINE firstChild #-} - {-# INLINE nextSibling #-} - {-# INLINE parent #-} - -depth :: (BalancedParens v, Rank0 v, Rank1 v) => v -> Count -> Maybe Count -depth v p = (\q -> rank1 v q - rank0 v q) <$> findOpen v p -{-# INLINE depth #-} - -subtreeSize :: BalancedParens v => v -> Count -> Maybe Count -subtreeSize v p = (\q -> (q - p + 1) `quot` 2) <$> findClose v p -{-# INLINE subtreeSize #-} - -instance BalancedParens [Bool] - -instance BalancedParens (DVS.Vector Word8) - -instance BalancedParens (DVS.Vector Word16) - -instance BalancedParens (DVS.Vector Word32) - -instance BalancedParens (DVS.Vector Word64) - -instance BalancedParens Word8 - -instance BalancedParens Word16 - -instance BalancedParens Word32 - -instance BalancedParens Word64 - -instance BalancedParens (Naive Word64) diff --git a/src/HaskellWorks/Data/Succinct/BalancedParens/Broadword.hs b/src/HaskellWorks/Data/Succinct/BalancedParens/Broadword.hs deleted file mode 100644 --- a/src/HaskellWorks/Data/Succinct/BalancedParens/Broadword.hs +++ /dev/null @@ -1,199 +0,0 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE InstanceSigs #-} -{-# LANGUAGE ScopedTypeVariables #-} - -module HaskellWorks.Data.Succinct.BalancedParens.Broadword - ( findCloseW64 - , ocCalc8 - , ocCalc64 - , showPadded - , kkBitDiffPos - , kkBitDiff - , kkBitDiffSimple - ) where - -import qualified Data.Bits as DB -import Data.Int -import Data.Word -import Debug.Trace -import HaskellWorks.Data.Bits.BitShown -import HaskellWorks.Data.Bits.BitWise -import HaskellWorks.Data.Bits.Broadword - -traceW :: String -> Word64 -> Word64 -traceW s w = trace (s ++ ": " ++ show (BitShown w) ++ " : " ++ show w ++ ", " ++ show (fromIntegral w :: Int64)) w - -findCloseW64 :: Word64 -> Word64 -findCloseW64 x = -- let !_ = traceW "x00" x in - let !b00 = x - ((x .&. 0xaaaaaaaaaaaaaaaa) .>. 1) in -- let !_ = traceW "b00" b00 in - let !b01 = (b00 .&. 0x3333333333333333) + ((b00 .>. 2) .&. 0x3333333333333333) in -- let !_ = traceW "b01" b01 in - let !b02 = (b01 + (b01 .>. 4)) .&. 0x0f0f0f0f0f0f0f0f in -- let !_ = traceW "b02" b02 in - let !b03 = (b02 * 0x0101010101010101) .<. 1 in -- let !_ = traceW "b03" b03 in - let !b04 = kBitDiffUnsafe 8 (h 8 .|. 0x4038302820181008) b03 in -- let !_ = traceW "b04" b04 in - let !u00 = (((((b04 .|. h 8) - l 8) .>. 7) .&. l 8) .|. h 8) - l 8 in -- let !_ = traceW "u00" u00 in - let !z00 = ((h 8 .>. 1) .|. (l 8 * 7)) .&. u00 in -- let !_ = traceW "z00" z00 in - -- let !_ = trace "" False in - let !d10 = (l 8 * 2 - (((x .>. 6) .&. (l 8 .<. 1)) + ((x .>. 5) .&. (l 8 .<. 1)))) in -- let !_ = traceW "d10" d10 in - let !b10 = b04 - d10 in -- let !_ = traceW "b10" b10 in - let !u10 = (((((b10 .|. h 8) - l 8) .>. 7) .&. l 8) .|. h 8) - l 8 in -- let !_ = traceW "u10" u10 in - let !z10 = (z00 .&. comp u10) .|. (((h 8 .>. 1) .|. (l 8 * 5)) .&. u10) in -- let !_ = traceW "z10" z10 in - -- let !_ = trace "" False in - let !d20 = (l 8 * 2 - (((x .>. 4) .&. (l 8 .<. 1)) + ((x .>. 3) .&. (l 8 .<. 1)))) in -- let !_ = traceW "d20" d20 in - let !b20 = b10 - d20 in -- let !_ = traceW "b20" b20 in - let !u20 = (((((b20 .|. h 8) - l 8) .>. 7) .&. l 8) .|. h 8) - l 8 in -- let !_ = traceW "u20" u20 in - let !z20 = (z10 .&. comp u20) .|. (((h 8 .>. 1) .|. (l 8 * 3)) .&. u20) in -- let !_ = traceW "z20" z20 in - -- let !_ = trace "" False in - let !d30 = (l 8 * 2 - (((x .>. 2) .&. (l 8 .<. 1)) + ((x .>. 1) .&. (l 8 .<. 1)))) in -- let !_ = traceW "d30" d30 in - let !b30 = b20 - d30 in -- let !_ = traceW "b30" b30 in - let !u30 = (((((b30 .|. h 8) - l 8) .>. 7) .&. l 8) .|. h 8) - l 8 in -- let !_ = traceW "u30" u30 in - let !z30 = (z20 .&. comp u30) .|. (((h 8 .>. 1) .|. l 8 ) .&. u30) in -- let !_ = traceW "z30" z30 in - - let !p00 = lsb (z30 .>. 6 .&. l 8) in -- let !_ = traceW "p00" p00 in - let !r00 = ((p00 + ((z30 .>. fromIntegral p00) .&. 0x3f)) .|. (p00 .>. 8)) .&. 0x7f in -- let !_ = traceW "r00" r00 in - r00 -{-# INLINE findCloseW64 #-} - --- µ0 :: Word64 --- µ0 = 0x5555555555555555 - -µ1 :: Word64 -µ1 = 0x3333333333333333 - -µ2 :: Word64 -µ2 = 0x0F0F0F0F0F0F0F0F - -µ3 :: Word64 -µ3 = 0x00FF00FF00FF00FF - -µ4 :: Word64 -µ4 = 0x0000FFFF0000FFFF - -µ5 :: Word64 -µ5 = 0x00000000FFFFFFFF - -ocCalc64 :: Word64 -> (Word64, Word64) -ocCalc64 x = - let b0 = x .&. 0x5555555555555555 in let !_ = traceW "b0 " b0 in - let b1 = (x .&. 0xAAAAAAAAAAAAAAAA) .>. 1 in let !_ = traceW "b1 " b1 in - let ll = (b0 .^. b1) .&. b1 in let !_ = traceW "ll " ll in - let o1 = (b0 .&. b1) .<. 1 .|. ll in let !_ = traceW "o1 " o1 in - let c1 = ((b0 .|. b1) .^. 0x5555555555555555) .<. 1 .|. ll in let !_ = traceW "c1 " c1 in - - let eo1 = o1 .&. µ1 in let !_ = traceW "eo1" eo1 in - let ec1 = ((c1 .&. µ1) .<. 2) .>. 2 in let !_ = traceW "ec1" ec1 in - let o2 = (((o1 .&. µ1) .<. 2) .>. 2) + kBitDiffPos 8 eo1 ec1 in let !_ = traceW "o2 " o2 in - let c2 = (c1 .&. µ1) + kBitDiffPos 8 ec1 eo1 in let !_ = traceW "c2 " c2 in - - let eo2 = o2 .&. µ2 in let !_ = traceW "eo2" eo2 in - let ec2 = ((c2 .&. µ2) .<. 4) .>. 4 in let !_ = traceW "ec2" ec2 in - let o3 = (((o2 .&. µ2) .<. 4) .>. 4) + kBitDiffPos 8 eo2 ec2 in let !_ = traceW "o3 " o3 in - let c3 = (c2 .&. µ2) + kBitDiffPos 8 ec2 eo2 in let !_ = traceW "c3 " c3 in - - let eo3 = o3 .&. µ3 in let !_ = traceW "eo3" eo3 in - let ec3 = ((c3 .&. µ3) .<. 8) .>. 8 in let !_ = traceW "ec3" ec3 in - let o4 = (((o3 .&. µ3) .<. 8) .>. 8) + kBitDiffPos 8 eo3 ec3 in let !_ = traceW "o4 " o4 in - let c4 = (c3 .&. µ3) + kBitDiffPos 8 ec3 eo3 in let !_ = traceW "c4 " c4 in - - let eo4 = o4 .&. µ4 in let !_ = traceW "eo4" eo4 in - let ec4 = ((c4 .&. µ4) .<. 16) .>. 16 in let !_ = traceW "ec4" ec4 in - let o5 = (((o4 .&. µ4) .<. 16) .>. 16) + kBitDiffPos 8 eo4 ec4 in let !_ = traceW "o5 " o5 in - let c5 = (c4 .&. µ4) + kBitDiffPos 8 ec4 eo4 in let !_ = traceW "c5 " c5 in - - let eo5 = o5 .&. µ5 in let !_ = traceW "eo5" eo5 in - let ec5 = ((c5 .&. µ5) .<. 32) .>. 32 in let !_ = traceW "ec5" ec5 in - let o6 = (((o5 .&. µ5) .<. 32) .>. 32) + kBitDiffPos 8 eo5 ec5 in let !_ = traceW "o6 " o6 in - let c6 = (c5 .&. µ5) + kBitDiffPos 8 ec5 eo5 in let !_ = traceW "c6 " c6 in - - (o6, c6) - --- µµ0 :: Word8 --- µµ0 = 0x55 - -µµ1 :: Word8 -µµ1 = 0x33 - -µµ2 :: Word8 -µµ2 = 0x0F - -hh :: Int -> Word8 -hh 2 = 0xaa -hh 4 = 0x88 -hh 8 = 0x80 -hh 16 = 0x80 -hh 32 = 0x80 -hh 64 = 0x80 -hh k = error ("Invalid h k where k = " ++ show k) -{-# INLINE hh #-} - -kkBitDiff :: Int -> Word8 -> Word8 -> Word8 -kkBitDiff k x y = ((x .|. hh k) - (y .&. comp (hh k))) .^. ((x .^. comp y) .&. hh k) -{-# INLINE kkBitDiff #-} - -kkBitDiffSimple :: Int -> Word8 -> Word8 -> Word8 -kkBitDiffSimple k x y = ((x .|. hh k) - y) .^. hh k -{-# INLINE kkBitDiffSimple #-} - -kkBitDiffPos :: Int -> Word8 -> Word8 -> Word8 -kkBitDiffPos k x y = let d = kkBitDiff k x y in d .&. kkBitDiff k (d .>. fromIntegral (k - 1)) 1 -{-# INLINE kkBitDiffPos #-} - -showPadded :: Show a => Int -> a -> String -showPadded n a = reverse (take n (reverse (show a) ++ [' ', ' ' ..])) - -traceWW :: String -> Word8 -> Word8 -traceWW s w = trace (s ++ ": " ++ show (BitShown w) ++ " : " ++ showPadded 3 w ++ ", " ++ showPadded 3 (fromIntegral w :: Int8)) w - -(.>+.) :: Word8 -> Int -> Word8 -(.>+.) w n = fromIntegral ((fromIntegral w :: Int8) `DB.shift` (-n)) - --- import qualified Data.Vector.Storable as DVS --- import HaskellWorks.Data.Bits.FromBitTextByteString --- import Data.Word --- import HaskellWorks.Data.Succinct.BalancedParens.Broadword - -ocCalc8 :: Word8 -> Word8 -> Word8 -ocCalc8 p x = - let b0 = x .&. 0x55 in let !_ = traceWW "b0 " b0 in - let b1 = (x .&. 0xAA) .>. 1 in let !_ = traceWW "b1 " b1 in - let ll = (b0 .^. b1) .&. b1 in let !_ = traceWW "ll " ll in - let o1 = (b0 .&. b1) .<. 1 .|. ll in let !_ = traceWW "o1 " o1 in - let c1 = ((b0 .|. b1) .^. 0x55) .<. 1 .|. ll in let !_ = traceWW "c1 " c1 in - - -- arithmetic operators come first, ordered in the standard way - -- followed by shifts - -- .&. - -- .^. - -- .|. - let eo1 = o1 .&. µµ1 in let !_ = traceWW "eo1" eo1 in - let ec1 = (c1 .&. (µµ1 .<. 2)) .>. 2 in let !_ = traceWW "ec1" ec1 in - let o2 = ((o1 .&. (µµ1 .<. 2)) .>. 2) + kkBitDiffPos 4 eo1 ec1 in let !_ = traceWW "o2 " o2 in -- <- Should this be 8 or 4? - let !_ = traceWW "xxx" (kkBitDiffPos 4 ec1 eo1) in - let !_ = traceWW "yyy" (c1 .&. µµ1) in - let c2 = (c1 .&. µµ1) + kkBitDiffPos 4 ec1 eo1 in let !_ = traceWW "c2 " c2 in - - let eo2 = o2 .&. µµ2 in let !_ = traceWW "eo2" eo2 in - let ec2 = (c2 .&. (µµ2 .<. 4)) .>. 4 in let !_ = traceWW "ec2" ec2 in - let o3 = ((o2 .&. (µµ2 .<. 4)) .>. 4) + kkBitDiffPos 8 eo2 ec2 in let !_ = traceWW "o3 " o3 in - let c3 = (c2 .&. µµ2) + kkBitDiffPos 8 ec2 eo2 in let !_ = traceWW "c3 " c3 in - - let nnn = ((c2 .>. 0) .&. 15) in let !_ = traceWW "nnn" nnn in - let qqq = (((c2 .>. 0) .&. 15) - p) in let !_ = traceWW "qqq" qqq in - let bb2 = ((((c2 .>. 0) .&. 15) - p) .>+. 7) in let !_ = traceWW "bb2" bb2 in - let mm2 = bb2 .&. 15 in let !_ = traceWW "mm2" mm2 in - let pa2 = p - (c2 .&. mm2) in let !_ = traceWW "pa2" pa2 in - let pb2 = pa2 + (o2 .&. mm2) in let !_ = traceWW "pb2" pb2 in - let ss2 = 4 .&. bb2 in let !_ = traceWW "ss2" ss2 in - - -- let nnn = ((c1 .>. fromIntegral ss2) .&. 3) in let !_ = traceWW "nnn" nnn in - -- let qqq = (((c1 .>. fromIntegral ss2) .&. 3) - pb2) in let !_ = traceWW "qqq" qqq in - let bb1 = ((((c1 .>. fromIntegral ss2) .&. 3) - pb2) .>+. 7) in let !_ = traceWW "bb1" bb1 in - let mm1 = bb1 .&. 3 in let !_ = traceWW "mm1" mm1 in - let pa1 = pa2 - (c1 .&. mm1) in let !_ = traceWW "pa1" pa1 in - let pb1 = pa1 + (o1 .&. mm1) in let !_ = traceWW "pb1" pb1 in - let ss1 = ss2 + (2 .&. bb1) in let !_ = traceWW "ss1" ss1 in - - let rrr = ss1 + pb1 + (((x .>. fromIntegral ss1) .&. ((pb1 .<. 1) .|. 1)) .<. 1) in let !_ = traceWW "rrr" rrr in - - rrr diff --git a/src/HaskellWorks/Data/Succinct/BalancedParens/CloseAt.hs b/src/HaskellWorks/Data/Succinct/BalancedParens/CloseAt.hs deleted file mode 100644 --- a/src/HaskellWorks/Data/Succinct/BalancedParens/CloseAt.hs +++ /dev/null @@ -1,73 +0,0 @@ -{-# LANGUAGE FlexibleInstances #-} - -module HaskellWorks.Data.Succinct.BalancedParens.CloseAt - ( CloseAt(..) - ) where - -import Data.Vector.Storable as DVS -import Data.Word -import HaskellWorks.Data.Bits.BitLength -import HaskellWorks.Data.Bits.BitWise -import HaskellWorks.Data.Bits.BitShown -import HaskellWorks.Data.Bits.Broadword -import HaskellWorks.Data.Positioning -import HaskellWorks.Data.Naive - -closeAt' :: TestBit a => a -> Count -> Bool -closeAt' v c = not (v .?. toPosition (c - 1)) -{-# INLINE closeAt' #-} - -class CloseAt v where - closeAt :: v -> Count -> Bool - -instance (BitLength a, TestBit a) => CloseAt (BitShown a) where - closeAt = closeAt' . bitShown - {-# INLINE closeAt #-} - -instance CloseAt [Bool] where - closeAt = closeAt' - {-# INLINE closeAt #-} - -instance CloseAt (DVS.Vector Word8) where - closeAt = closeAt' - {-# INLINE closeAt #-} - - -instance CloseAt (DVS.Vector Word16) where - closeAt = closeAt' - {-# INLINE closeAt #-} - - -instance CloseAt (DVS.Vector Word32) where - closeAt = closeAt' - {-# INLINE closeAt #-} - - -instance CloseAt (DVS.Vector Word64) where - closeAt = closeAt' - {-# INLINE closeAt #-} - - -instance CloseAt Word8 where - closeAt = closeAt' - {-# INLINE closeAt #-} - -instance CloseAt Word16 where - closeAt = closeAt' - {-# INLINE closeAt #-} - -instance CloseAt Word32 where - closeAt = closeAt' - {-# INLINE closeAt #-} - -instance CloseAt Word64 where - closeAt = closeAt' - {-# INLINE closeAt #-} - -instance CloseAt (Naive Word64) where - closeAt = closeAt' - {-# INLINE closeAt #-} - -instance CloseAt (Broadword Word64) where - closeAt = closeAt . broadword - {-# INLINE closeAt #-} diff --git a/src/HaskellWorks/Data/Succinct/BalancedParens/Enclose.hs b/src/HaskellWorks/Data/Succinct/BalancedParens/Enclose.hs deleted file mode 100644 --- a/src/HaskellWorks/Data/Succinct/BalancedParens/Enclose.hs +++ /dev/null @@ -1,59 +0,0 @@ -{-# LANGUAGE FlexibleInstances #-} - -module HaskellWorks.Data.Succinct.BalancedParens.Enclose - ( Enclose(..) - ) where - -import qualified Data.Vector.Storable as DVS -import Data.Word -import HaskellWorks.Data.Bits.BitShown -import HaskellWorks.Data.Naive -import HaskellWorks.Data.Positioning -import HaskellWorks.Data.Succinct.BalancedParens.FindOpenN - -class Enclose v where - enclose :: v -> Count -> Maybe Count - -instance (Enclose a) => Enclose (BitShown a) where - enclose = enclose . bitShown - {-# INLINE enclose #-} - -instance Enclose [Bool] where - enclose v = findOpenN v 1 - {-# INLINE enclose #-} - -instance Enclose (DVS.Vector Word8) where - enclose v = findOpenN v 1 - {-# INLINE enclose #-} - -instance Enclose (DVS.Vector Word16) where - enclose v = findOpenN v 1 - {-# INLINE enclose #-} - -instance Enclose (DVS.Vector Word32) where - enclose v = findOpenN v 1 - {-# INLINE enclose #-} - -instance Enclose (DVS.Vector Word64) where - enclose v = findOpenN v 1 - {-# INLINE enclose #-} - -instance Enclose Word8 where - enclose v = findOpenN v 1 - {-# INLINE enclose #-} - -instance Enclose Word16 where - enclose v = findOpenN v 1 - {-# INLINE enclose #-} - -instance Enclose Word32 where - enclose v = findOpenN v 1 - {-# INLINE enclose #-} - -instance Enclose Word64 where - enclose v = findOpenN v 1 - {-# INLINE enclose #-} - -instance Enclose (Naive Word64) where - enclose v = findOpenN v 1 - {-# INLINE enclose #-} diff --git a/src/HaskellWorks/Data/Succinct/BalancedParens/FindClose.hs b/src/HaskellWorks/Data/Succinct/BalancedParens/FindClose.hs deleted file mode 100644 --- a/src/HaskellWorks/Data/Succinct/BalancedParens/FindClose.hs +++ /dev/null @@ -1,70 +0,0 @@ -{-# LANGUAGE FlexibleInstances #-} - -module HaskellWorks.Data.Succinct.BalancedParens.FindClose - ( FindClose(..) - ) where - -import qualified Data.Vector.Storable as DVS -import Data.Word -import HaskellWorks.Data.Bits.BitShown -import HaskellWorks.Data.Bits.BitWise -import HaskellWorks.Data.Bits.Broadword -import HaskellWorks.Data.Naive -import HaskellWorks.Data.Positioning -import HaskellWorks.Data.Succinct.BalancedParens.Broadword -import HaskellWorks.Data.Succinct.BalancedParens.CloseAt -import HaskellWorks.Data.Succinct.BalancedParens.FindCloseN - -class FindClose v where - findClose :: v -> Count -> Maybe Count - -instance (FindClose a) => FindClose (BitShown a) where - findClose = findClose . bitShown - {-# INLINE findClose #-} - -instance FindClose [Bool] where - findClose v p = if v `closeAt` p then Just p else findCloseN v 1 (p + 1) - {-# INLINE findClose #-} - -instance FindClose (DVS.Vector Word8) where - findClose v p = if v `closeAt` p then Just p else findCloseN v 1 (p + 1) - {-# INLINE findClose #-} - -instance FindClose (DVS.Vector Word16) where - findClose v p = if v `closeAt` p then Just p else findCloseN v 1 (p + 1) - {-# INLINE findClose #-} - -instance FindClose (DVS.Vector Word32) where - findClose v p = if v `closeAt` p then Just p else findCloseN v 1 (p + 1) - {-# INLINE findClose #-} - -instance FindClose (DVS.Vector Word64) where - findClose v p = if v `closeAt` p then Just p else findCloseN v 1 (p + 1) - {-# INLINE findClose #-} - -instance FindClose Word8 where - findClose v p = if v `closeAt` p then Just p else findCloseN v 1 (p + 1) - {-# INLINE findClose #-} - -instance FindClose Word16 where - findClose v p = if v `closeAt` p then Just p else findCloseN v 1 (p + 1) - {-# INLINE findClose #-} - -instance FindClose Word32 where - findClose v p = if v `closeAt` p then Just p else findCloseN v 1 (p + 1) - {-# INLINE findClose #-} - -instance FindClose Word64 where - findClose = findClose . Broadword - {-# INLINE findClose #-} - -instance FindClose (Naive Word64) where - findClose v p = if v `closeAt` p then Just p else findCloseN v 1 (p + 1) - {-# INLINE findClose #-} - -instance FindClose (Broadword Word64) where - findClose (Broadword w) p = let x = w .>. (p - 1) in - case negate (x .&. 1) .&. findCloseW64 x of - 127 -> Nothing - r -> let r' = fromIntegral r + p in if r' > 64 then Nothing else Just r' - {-# INLINE findClose #-} diff --git a/src/HaskellWorks/Data/Succinct/BalancedParens/FindCloseN.hs b/src/HaskellWorks/Data/Succinct/BalancedParens/FindCloseN.hs deleted file mode 100644 --- a/src/HaskellWorks/Data/Succinct/BalancedParens/FindCloseN.hs +++ /dev/null @@ -1,71 +0,0 @@ -{-# LANGUAGE FlexibleInstances #-} - -module HaskellWorks.Data.Succinct.BalancedParens.FindCloseN - ( FindCloseN(..) - ) where - -import qualified Data.Vector.Storable as DVS -import Data.Word -import HaskellWorks.Data.Bits.BitLength -import HaskellWorks.Data.Bits.BitShown -import HaskellWorks.Data.Bits.BitWise -import HaskellWorks.Data.Naive -import HaskellWorks.Data.Positioning -import HaskellWorks.Data.Succinct.BalancedParens.CloseAt - -class FindCloseN v where - findCloseN :: v -> Count -> Count -> Maybe Count - -findClose' :: (BitLength a, CloseAt a, TestBit a) => a -> Count -> Count -> Maybe Count -findClose' v c p = if 0 < p && p <= bitLength v - then if v `closeAt` p - then if c <= 1 - then Just p - else findClose' v (c - 1) (p + 1) - else findClose' v (c + 1) (p + 1) - else Nothing -{-# INLINE findClose' #-} - -instance (CloseAt a, TestBit a, BitLength a) => FindCloseN (BitShown a) where - findCloseN = findClose' . bitShown - {-# INLINE findCloseN #-} - -instance FindCloseN [Bool] where - findCloseN = findClose' - {-# INLINE findCloseN #-} - -instance FindCloseN (DVS.Vector Word8) where - findCloseN = findClose' - {-# INLINE findCloseN #-} - -instance FindCloseN (DVS.Vector Word16) where - findCloseN = findClose' - {-# INLINE findCloseN #-} - -instance FindCloseN (DVS.Vector Word32) where - findCloseN = findClose' - {-# INLINE findCloseN #-} - -instance FindCloseN (DVS.Vector Word64) where - findCloseN = findClose' - {-# INLINE findCloseN #-} - -instance FindCloseN Word8 where - findCloseN = findClose' - {-# INLINE findCloseN #-} - -instance FindCloseN Word16 where - findCloseN = findClose' - {-# INLINE findCloseN #-} - -instance FindCloseN Word32 where - findCloseN = findClose' - {-# INLINE findCloseN #-} - -instance FindCloseN Word64 where - findCloseN = findClose' - {-# INLINE findCloseN #-} - -instance FindCloseN (Naive Word64) where - findCloseN = findClose' - {-# INLINE findCloseN #-} diff --git a/src/HaskellWorks/Data/Succinct/BalancedParens/FindOpen.hs b/src/HaskellWorks/Data/Succinct/BalancedParens/FindOpen.hs deleted file mode 100644 --- a/src/HaskellWorks/Data/Succinct/BalancedParens/FindOpen.hs +++ /dev/null @@ -1,60 +0,0 @@ -{-# LANGUAGE FlexibleInstances #-} - -module HaskellWorks.Data.Succinct.BalancedParens.FindOpen - ( FindOpen(..) - ) where - -import qualified Data.Vector.Storable as DVS -import Data.Word -import HaskellWorks.Data.Bits.BitShown -import HaskellWorks.Data.Naive -import HaskellWorks.Data.Positioning -import HaskellWorks.Data.Succinct.BalancedParens.FindOpenN -import HaskellWorks.Data.Succinct.BalancedParens.OpenAt - -class FindOpen v where - findOpen :: v -> Count -> Maybe Count - -instance (FindOpen a) => FindOpen (BitShown a) where - findOpen = findOpen . bitShown - {-# INLINE findOpen #-} - -instance FindOpen [Bool] where - findOpen v p = if v `openAt` p then Just p else findOpenN v 0 (p - 1) - {-# INLINE findOpen #-} - -instance FindOpen (DVS.Vector Word8) where - findOpen v p = if v `openAt` p then Just p else findOpenN v 0 (p - 1) - {-# INLINE findOpen #-} - -instance FindOpen (DVS.Vector Word16) where - findOpen v p = if v `openAt` p then Just p else findOpenN v 0 (p - 1) - {-# INLINE findOpen #-} - -instance FindOpen (DVS.Vector Word32) where - findOpen v p = if v `openAt` p then Just p else findOpenN v 0 (p - 1) - {-# INLINE findOpen #-} - -instance FindOpen (DVS.Vector Word64) where - findOpen v p = if v `openAt` p then Just p else findOpenN v 0 (p - 1) - {-# INLINE findOpen #-} - -instance FindOpen Word8 where - findOpen v p = if v `openAt` p then Just p else findOpenN v 0 (p - 1) - {-# INLINE findOpen #-} - -instance FindOpen Word16 where - findOpen v p = if v `openAt` p then Just p else findOpenN v 0 (p - 1) - {-# INLINE findOpen #-} - -instance FindOpen Word32 where - findOpen v p = if v `openAt` p then Just p else findOpenN v 0 (p - 1) - {-# INLINE findOpen #-} - -instance FindOpen Word64 where - findOpen v p = if v `openAt` p then Just p else findOpenN v 0 (p - 1) - {-# INLINE findOpen #-} - -instance FindOpen (Naive Word64) where - findOpen v p = if v `openAt` p then Just p else findOpenN v 0 (p - 1) - {-# INLINE findOpen #-} diff --git a/src/HaskellWorks/Data/Succinct/BalancedParens/FindOpenN.hs b/src/HaskellWorks/Data/Succinct/BalancedParens/FindOpenN.hs deleted file mode 100644 --- a/src/HaskellWorks/Data/Succinct/BalancedParens/FindOpenN.hs +++ /dev/null @@ -1,71 +0,0 @@ -{-# LANGUAGE FlexibleInstances #-} - -module HaskellWorks.Data.Succinct.BalancedParens.FindOpenN - ( FindOpenN(..) - ) where - -import qualified Data.Vector.Storable as DVS -import Data.Word -import HaskellWorks.Data.Bits.BitLength -import HaskellWorks.Data.Bits.BitShown -import HaskellWorks.Data.Bits.BitWise -import HaskellWorks.Data.Naive -import HaskellWorks.Data.Positioning -import HaskellWorks.Data.Succinct.BalancedParens.OpenAt - -class FindOpenN v where - findOpenN :: v -> Count -> Count -> Maybe Count - -findOpen' :: (BitLength a, OpenAt a, TestBit a) => a -> Count -> Count -> Maybe Count -findOpen' v c p = if 0 < p && p <= bitLength v - then if v `openAt` p - then if c == 0 - then Just p - else findOpen' v (c - 1) (p - 1) - else findOpen' v (c + 1) (p - 1) - else Nothing -{-# INLINE findOpen' #-} - -instance (BitLength a, OpenAt a, TestBit a) => FindOpenN (BitShown a) where - findOpenN = findOpen' . bitShown - {-# INLINE findOpenN #-} - -instance FindOpenN [Bool] where - findOpenN = findOpen' - {-# INLINE findOpenN #-} - -instance FindOpenN (DVS.Vector Word8) where - findOpenN = findOpen' - {-# INLINE findOpenN #-} - -instance FindOpenN (DVS.Vector Word16) where - findOpenN = findOpen' - {-# INLINE findOpenN #-} - -instance FindOpenN (DVS.Vector Word32) where - findOpenN = findOpen' - {-# INLINE findOpenN #-} - -instance FindOpenN (DVS.Vector Word64) where - findOpenN = findOpen' - {-# INLINE findOpenN #-} - -instance FindOpenN Word8 where - findOpenN = findOpen' - {-# INLINE findOpenN #-} - -instance FindOpenN Word16 where - findOpenN = findOpen' - {-# INLINE findOpenN #-} - -instance FindOpenN Word32 where - findOpenN = findOpen' - {-# INLINE findOpenN #-} - -instance FindOpenN Word64 where - findOpenN = findOpen' - {-# INLINE findOpenN #-} - -instance FindOpenN (Naive Word64) where - findOpenN = findOpen' - {-# INLINE findOpenN #-} diff --git a/src/HaskellWorks/Data/Succinct/BalancedParens/NewCloseAt.hs b/src/HaskellWorks/Data/Succinct/BalancedParens/NewCloseAt.hs deleted file mode 100644 --- a/src/HaskellWorks/Data/Succinct/BalancedParens/NewCloseAt.hs +++ /dev/null @@ -1,60 +0,0 @@ -{-# LANGUAGE FlexibleInstances #-} - -module HaskellWorks.Data.Succinct.BalancedParens.NewCloseAt - ( NewCloseAt(..) - , newCloseAt' - ) where - -import qualified Data.Vector.Storable as DVS -import Data.Word -import HaskellWorks.Data.Bits.BitLength -import HaskellWorks.Data.Bits.BitShown -import HaskellWorks.Data.Bits.BitWise -import HaskellWorks.Data.Positioning - -class NewCloseAt v where - newCloseAt :: v -> Count -> Bool - -newCloseAt' :: TestBit a => a -> Count -> Bool -newCloseAt' v c = not (v .?. toPosition c) -{-# INLINE newCloseAt' #-} - -instance (BitLength a, TestBit a) => NewCloseAt (BitShown a) where - newCloseAt = newCloseAt' . bitShown - {-# INLINE newCloseAt #-} - -instance NewCloseAt [Bool] where - newCloseAt = newCloseAt' - {-# INLINE newCloseAt #-} - -instance NewCloseAt (DVS.Vector Word8) where - newCloseAt = newCloseAt' - {-# INLINE newCloseAt #-} - -instance NewCloseAt (DVS.Vector Word16) where - newCloseAt = newCloseAt' - {-# INLINE newCloseAt #-} - -instance NewCloseAt (DVS.Vector Word32) where - newCloseAt = newCloseAt' - {-# INLINE newCloseAt #-} - -instance NewCloseAt (DVS.Vector Word64) where - newCloseAt = newCloseAt' - {-# INLINE newCloseAt #-} - -instance NewCloseAt Word8 where - newCloseAt = newCloseAt' - {-# INLINE newCloseAt #-} - -instance NewCloseAt Word16 where - newCloseAt = newCloseAt' - {-# INLINE newCloseAt #-} - -instance NewCloseAt Word32 where - newCloseAt = newCloseAt' - {-# INLINE newCloseAt #-} - -instance NewCloseAt Word64 where - newCloseAt = newCloseAt' - {-# INLINE newCloseAt #-} diff --git a/src/HaskellWorks/Data/Succinct/BalancedParens/NewOpenAt.hs b/src/HaskellWorks/Data/Succinct/BalancedParens/NewOpenAt.hs deleted file mode 100644 --- a/src/HaskellWorks/Data/Succinct/BalancedParens/NewOpenAt.hs +++ /dev/null @@ -1,59 +0,0 @@ -{-# LANGUAGE FlexibleInstances #-} - -module HaskellWorks.Data.Succinct.BalancedParens.NewOpenAt - ( NewOpenAt(..) - ) where - -import qualified Data.Vector.Storable as DVS -import Data.Word -import HaskellWorks.Data.Bits.BitLength -import HaskellWorks.Data.Bits.BitShown -import HaskellWorks.Data.Bits.BitWise -import HaskellWorks.Data.Positioning - -class NewOpenAt v where - newOpenAt :: v -> Count -> Bool - -newOpenAt' :: (BitLength a, TestBit a) => a -> Count -> Bool -newOpenAt' v c = (0 <= c && c < bitLength v) && (v .?. toPosition c) -{-# INLINE newOpenAt' #-} - -instance (BitLength a, TestBit a) => NewOpenAt (BitShown a) where - newOpenAt = newOpenAt' . bitShown - {-# INLINE newOpenAt #-} - -instance NewOpenAt [Bool] where - newOpenAt = newOpenAt' - {-# INLINE newOpenAt #-} - -instance NewOpenAt (DVS.Vector Word8) where - newOpenAt = newOpenAt' - {-# INLINE newOpenAt #-} - -instance NewOpenAt (DVS.Vector Word16) where - newOpenAt = newOpenAt' - {-# INLINE newOpenAt #-} - -instance NewOpenAt (DVS.Vector Word32) where - newOpenAt = newOpenAt' - {-# INLINE newOpenAt #-} - -instance NewOpenAt (DVS.Vector Word64) where - newOpenAt = newOpenAt' - {-# INLINE newOpenAt #-} - -instance NewOpenAt Word8 where - newOpenAt = newOpenAt' - {-# INLINE newOpenAt #-} - -instance NewOpenAt Word16 where - newOpenAt = newOpenAt' - {-# INLINE newOpenAt #-} - -instance NewOpenAt Word32 where - newOpenAt = newOpenAt' - {-# INLINE newOpenAt #-} - -instance NewOpenAt Word64 where - newOpenAt = newOpenAt' - {-# INLINE newOpenAt #-} diff --git a/src/HaskellWorks/Data/Succinct/BalancedParens/OpenAt.hs b/src/HaskellWorks/Data/Succinct/BalancedParens/OpenAt.hs deleted file mode 100644 --- a/src/HaskellWorks/Data/Succinct/BalancedParens/OpenAt.hs +++ /dev/null @@ -1,69 +0,0 @@ -{-# LANGUAGE FlexibleInstances #-} - -module HaskellWorks.Data.Succinct.BalancedParens.OpenAt - ( OpenAt(..) - ) where - -import qualified Data.Vector.Storable as DVS -import Data.Word -import HaskellWorks.Data.Bits.BitLength -import HaskellWorks.Data.Bits.BitShown -import HaskellWorks.Data.Bits.BitWise -import HaskellWorks.Data.Bits.Broadword -import HaskellWorks.Data.Naive -import HaskellWorks.Data.Positioning - -class OpenAt v where - openAt :: v -> Count -> Bool - -openAt' :: (BitLength a, TestBit a) => a -> Count -> Bool -openAt' v c = (0 <= c && c < bitLength v) && (v .?. toPosition (c - 1)) -{-# INLINE openAt' #-} - -instance (BitLength a, TestBit a) => OpenAt (BitShown a) where - openAt = openAt' . bitShown - {-# INLINE openAt #-} - -instance OpenAt [Bool] where - openAt = openAt' - {-# INLINE openAt #-} - -instance OpenAt (DVS.Vector Word8) where - openAt = openAt' - {-# INLINE openAt #-} - -instance OpenAt (DVS.Vector Word16) where - openAt = openAt' - {-# INLINE openAt #-} - -instance OpenAt (DVS.Vector Word32) where - openAt = openAt' - {-# INLINE openAt #-} - -instance OpenAt (DVS.Vector Word64) where - openAt = openAt' - {-# INLINE openAt #-} - -instance OpenAt Word8 where - openAt = openAt' - {-# INLINE openAt #-} - -instance OpenAt Word16 where - openAt = openAt' - {-# INLINE openAt #-} - -instance OpenAt Word32 where - openAt = openAt' - {-# INLINE openAt #-} - -instance OpenAt Word64 where - openAt = openAt' - {-# INLINE openAt #-} - -instance OpenAt (Naive Word64) where - openAt = openAt' - {-# INLINE openAt #-} - -instance OpenAt (Broadword Word64) where - openAt = openAt . broadword - {-# INLINE openAt #-} diff --git a/src/HaskellWorks/Data/Succinct/BalancedParens/RangeMinMax.hs b/src/HaskellWorks/Data/Succinct/BalancedParens/RangeMinMax.hs deleted file mode 100644 --- a/src/HaskellWorks/Data/Succinct/BalancedParens/RangeMinMax.hs +++ /dev/null @@ -1,239 +0,0 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE InstanceSigs #-} -{-# LANGUAGE TypeFamilies #-} - -module HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax - ( RangeMinMax(..) - , mkRangeMinMax - ) where - -import Data.Int -import qualified Data.Vector as DV -import qualified Data.Vector.Storable as DVS -import HaskellWorks.Data.AtIndex -import HaskellWorks.Data.Bits.AllExcess.AllExcess1 -import HaskellWorks.Data.Bits.BitLength -import HaskellWorks.Data.Bits.BitWise -import HaskellWorks.Data.Excess.MinMaxExcess1 -import HaskellWorks.Data.Positioning -import HaskellWorks.Data.RankSelect.Base.Rank0 -import HaskellWorks.Data.RankSelect.Base.Rank1 -import HaskellWorks.Data.Succinct.BalancedParens.BalancedParens -import HaskellWorks.Data.Succinct.BalancedParens.CloseAt -import HaskellWorks.Data.Succinct.BalancedParens.Enclose -import HaskellWorks.Data.Succinct.BalancedParens.FindClose -import HaskellWorks.Data.Succinct.BalancedParens.FindCloseN -import HaskellWorks.Data.Succinct.BalancedParens.FindOpen -import HaskellWorks.Data.Succinct.BalancedParens.FindOpenN -import HaskellWorks.Data.Succinct.BalancedParens.OpenAt -import HaskellWorks.Data.Succinct.BalancedParens.NewCloseAt -import HaskellWorks.Data.Vector.AsVector64 -import Prelude hiding (length) - -data RangeMinMax a = RangeMinMax - { rangeMinMaxBP :: !a - , rangeMinMaxL0Min :: !(DVS.Vector Int8) - , rangeMinMaxL0Max :: !(DVS.Vector Int8) - , rangeMinMaxL0Excess :: !(DVS.Vector Int8) - , rangeMinMaxL1Min :: !(DVS.Vector Int16) - , rangeMinMaxL1Max :: !(DVS.Vector Int16) - , rangeMinMaxL1Excess :: !(DVS.Vector Int16) - , rangeMinMaxL2Min :: !(DVS.Vector Int16) - , rangeMinMaxL2Max :: !(DVS.Vector Int16) - , rangeMinMaxL2Excess :: !(DVS.Vector Int16) - } - -factorL0 :: Integral a => a -factorL0 = 1 -{-# INLINE factorL0 #-} - -factorL1 :: Integral a => a -factorL1 = 32 -{-# INLINE factorL1 #-} - -factorL2 :: Integral a => a -factorL2 = 32 -{-# INLINE factorL2 #-} - -pageSizeL0 :: Integral a => a -pageSizeL0 = factorL0 -{-# INLINE pageSizeL0 #-} - -pageSizeL1 :: Integral a => a -pageSizeL1 = pageSizeL0 * factorL1 -{-# INLINE pageSizeL1 #-} - -pageSizeL2 :: Integral a => a -pageSizeL2 = pageSizeL1 * factorL2 -{-# INLINE pageSizeL2 #-} - -mkRangeMinMax :: AsVector64 a => a -> RangeMinMax a -mkRangeMinMax bp = RangeMinMax - { rangeMinMaxBP = bp - , rangeMinMaxL0Min = rmmL0Min - , rangeMinMaxL0Max = rmmL0Max - , rangeMinMaxL0Excess = dvsReword rmmL0Excess - , rangeMinMaxL1Min = rmmL1Min - , rangeMinMaxL1Max = rmmL1Max - , rangeMinMaxL1Excess = dvsReword rmmL1Excess - , rangeMinMaxL2Min = rmmL2Min - , rangeMinMaxL2Max = rmmL2Max - , rangeMinMaxL2Excess = rmmL2Excess - } - where bpv = asVector64 bp - lenBP = fromIntegral (length bpv) :: Int - lenL0 = lenBP - lenL1 = (DVS.length rmmL0Min `div` pageSizeL1) + 1 :: Int - lenL2 = (DVS.length rmmL0Min `div` pageSizeL2) + 1 :: Int - allMinMaxL0 = dvConstructNI lenL0 (\i -> if i == lenBP then (-64, -64, 0) else minMaxExcess1 (bpv !!! fromIntegral i)) - allMinMaxL1 = dvConstructNI lenL1 (\i -> minMaxExcess1 (dropTake (i * pageSizeL1) pageSizeL1 bpv)) - allMinMaxL2 = dvConstructNI lenL2 (\i -> minMaxExcess1 (dropTake (i * pageSizeL2) pageSizeL2 bpv)) - rmmL0Excess = dvsConstructNI lenL0 (\i -> fromIntegral (allExcess1 (pageFill i pageSizeL0 (-64) bpv))) :: DVS.Vector Int16 - rmmL1Excess = dvsConstructNI lenL1 (\i -> fromIntegral (allExcess1 (pageFill i pageSizeL1 (-64) bpv))) :: DVS.Vector Int16 - rmmL2Excess = dvsConstructNI lenL2 (\i -> fromIntegral (allExcess1 (pageFill i pageSizeL2 (-64) bpv))) :: DVS.Vector Int16 - rmmL0Min = dvsConstructNI lenL0 (\i -> let (minE, _, _) = allMinMaxL0 DV.! i in fromIntegral minE) - rmmL1Min = dvsConstructNI lenL1 (\i -> let (minE, _, _) = allMinMaxL1 DV.! i in fromIntegral minE) - rmmL2Min = dvsConstructNI lenL2 (\i -> let (minE, _, _) = allMinMaxL2 DV.! i in fromIntegral minE) - rmmL0Max = dvsConstructNI lenL0 (\i -> let (_, _, maxE) = allMinMaxL0 DV.! i in fromIntegral maxE) - rmmL1Max = dvsConstructNI lenL1 (\i -> let (_, _, maxE) = allMinMaxL1 DV.! i in fromIntegral maxE) - rmmL2Max = dvsConstructNI lenL2 (\i -> let (_, _, maxE) = allMinMaxL2 DV.! i in fromIntegral maxE) - -dropTake :: DVS.Storable a => Int -> Int -> DVS.Vector a -> DVS.Vector a -dropTake n o = DVS.take o . DVS.drop n -{-# INLINE dropTake #-} - -dvsReword :: (DVS.Storable a, Integral a, DVS.Storable b, Num b) => DVS.Vector a -> DVS.Vector b -dvsReword v = dvsConstructNI (DVS.length v) (\i -> fromIntegral (v DVS.! i)) -{-# INLINE dvsReword #-} - -pageFill :: DVS.Storable a => Int -> Int -> a -> DVS.Vector a -> DVS.Vector a -pageFill n s = dropTakeFill (n * s) s -{-# INLINE pageFill #-} - -dropTakeFill :: DVS.Storable a => Int -> Int -> a -> DVS.Vector a -> DVS.Vector a -dropTakeFill n o a v = let r = DVS.take o (DVS.drop n v) in - let len = DVS.length r in - if len == o then r else DVS.concat [r, DVS.fromList (replicate (o - len) a)] -{-# INLINE dropTakeFill #-} - -dvConstructNI :: Int -> (Int -> a) -> DV.Vector a -dvConstructNI n g = DV.constructN n (g . DV.length) -{-# INLINE dvConstructNI #-} - -dvsConstructNI :: DVS.Storable a => Int -> (Int -> a) -> DVS.Vector a -dvsConstructNI n g = DVS.constructN n (g . DVS.length) -{-# INLINE dvsConstructNI #-} - -data FindState = FindBP - | FindL0 | FindFromL0 - | FindL1 | FindFromL1 - | FindL2 | FindFromL2 - -rmm2FindClose :: (BitLength a, NewCloseAt a) => RangeMinMax a -> Int -> Count -> FindState -> Maybe Count -rmm2FindClose v s p FindBP = if v `newCloseAt` p - then if s <= 1 - then Just p - else rmm2FindClose v (s - 1) (p + 1) FindFromL0 - else rmm2FindClose v (s + 1) (p + 1) FindFromL0 -rmm2FindClose v s p FindL0 = - let i = p `div` 64 in - let mins = rangeMinMaxL0Min v in - let minE = fromIntegral (mins !!! fromIntegral i) :: Int in - if fromIntegral s + minE <= 0 - then rmm2FindClose v s p FindBP - else if v `newCloseAt` p && s <= 1 - then Just p - else let excesses = rangeMinMaxL0Excess v in - let excess = fromIntegral (excesses !!! fromIntegral i) :: Int in - rmm2FindClose v (fromIntegral (excess + fromIntegral s)) (p + 64) FindFromL0 -rmm2FindClose v s p FindL1 = - let !i = p `div` (64 * pageSizeL1) in - let !mins = rangeMinMaxL1Min v in - let !minE = fromIntegral (mins !!! fromIntegral i) :: Int in - if fromIntegral s + minE <= 0 - then rmm2FindClose v s p FindL0 - else if 0 <= p && p < bitLength v - then if v `newCloseAt` p && s <= 1 - then Just p - else let excesses = rangeMinMaxL1Excess v in - let excess = fromIntegral (excesses !!! fromIntegral i) :: Int in - rmm2FindClose v (fromIntegral (excess + fromIntegral s)) (p + (64 * pageSizeL1)) FindFromL1 - else Nothing -rmm2FindClose v s p FindL2 = - let !i = p `div` (64 * pageSizeL2) in - let !mins = rangeMinMaxL2Min v in - let !minE = fromIntegral (mins !!! fromIntegral i) :: Int in - if fromIntegral s + minE <= 0 - then rmm2FindClose v s p FindL1 - else if 0 <= p && p < bitLength v - then if v `newCloseAt` p && s <= 1 - then Just p - else let excesses = rangeMinMaxL2Excess v in - let excess = fromIntegral (excesses !!! fromIntegral i) :: Int in - rmm2FindClose v (fromIntegral (excess + fromIntegral s)) (p + (64 * pageSizeL2)) FindFromL2 - else Nothing -rmm2FindClose v s p FindFromL0 - | p `mod` 64 == 0 = rmm2FindClose v s p FindFromL1 - | 0 <= p && p < bitLength v = rmm2FindClose v s p FindBP - | otherwise = Nothing -rmm2FindClose v s p FindFromL1 - | p `mod` (64 * pageSizeL1) == 0 = if 0 <= p && p < bitLength v then rmm2FindClose v s p FindFromL2 else Nothing - | 0 <= p && p < bitLength v = rmm2FindClose v s p FindL0 - | otherwise = Nothing -rmm2FindClose v s p FindFromL2 - | p `mod` (64 * pageSizeL2) == 0 = if 0 <= p && p < bitLength v then rmm2FindClose v s p FindL2 else Nothing - | 0 <= p && p < bitLength v = rmm2FindClose v s p FindL1 - | otherwise = Nothing -{-# INLINE rmm2FindClose #-} - -instance TestBit a => TestBit (RangeMinMax a) where - (.?.) = (.?.) . rangeMinMaxBP - {-# INLINE (.?.) #-} - -instance Rank1 a => Rank1 (RangeMinMax a) where - rank1 = rank1 . rangeMinMaxBP - {-# INLINE rank1 #-} - -instance Rank0 a => Rank0 (RangeMinMax a) where - rank0 = rank0 . rangeMinMaxBP - {-# INLINE rank0 #-} - -instance BitLength a => BitLength (RangeMinMax a) where - bitLength = bitLength . rangeMinMaxBP - {-# INLINE bitLength #-} - -instance OpenAt a => OpenAt (RangeMinMax a) where - openAt = openAt . rangeMinMaxBP - {-# INLINE openAt #-} - -instance CloseAt a => CloseAt (RangeMinMax a) where - closeAt = closeAt . rangeMinMaxBP - {-# INLINE closeAt #-} - -instance NewCloseAt a => NewCloseAt (RangeMinMax a) where - newCloseAt = newCloseAt . rangeMinMaxBP - {-# INLINE newCloseAt #-} - -instance FindOpenN a => FindOpenN (RangeMinMax a) where - findOpenN = findOpenN . rangeMinMaxBP - {-# INLINE findOpenN #-} - -instance (BitLength a, NewCloseAt a) => FindCloseN (RangeMinMax a) where - findCloseN v s p = (+ 1) `fmap` rmm2FindClose v (fromIntegral s) (p - 1) FindFromL0 - {-# INLINE findCloseN #-} - -instance (BitLength a, CloseAt a, NewCloseAt a, FindCloseN a) => FindClose (RangeMinMax a) where - findClose v p = if v `closeAt` p then Just p else findCloseN v 1 (p + 1) - {-# INLINE findClose #-} - -instance FindOpen (RangeMinMax a) where - findOpen = undefined - {-# INLINE findOpen #-} - -instance Enclose (RangeMinMax a) where - enclose = undefined - {-# INLINE enclose #-} - -instance (BitLength a, NewCloseAt a, CloseAt a, OpenAt a, FindCloseN a) => BalancedParens (RangeMinMax a) diff --git a/src/HaskellWorks/Data/Succinct/BalancedParens/RangeMinMax2.hs b/src/HaskellWorks/Data/Succinct/BalancedParens/RangeMinMax2.hs deleted file mode 100644 --- a/src/HaskellWorks/Data/Succinct/BalancedParens/RangeMinMax2.hs +++ /dev/null @@ -1,322 +0,0 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE InstanceSigs #-} -{-# LANGUAGE TypeFamilies #-} - -module HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax2 - ( RangeMinMax2(..) - , mkRangeMinMax2 - , genMin - , genMax - ) where - -import Data.Int -import qualified Data.Vector as DV -import qualified Data.Vector.Storable as DVS --- import Data.Word -import HaskellWorks.Data.AtIndex -import HaskellWorks.Data.Bits.AllExcess.AllExcess1 -import HaskellWorks.Data.Bits.BitLength -import HaskellWorks.Data.Bits.BitWise -import HaskellWorks.Data.Excess.MinMaxExcess1 -import HaskellWorks.Data.Positioning -import HaskellWorks.Data.RankSelect.Base.Rank0 -import HaskellWorks.Data.RankSelect.Base.Rank1 -import HaskellWorks.Data.Succinct.BalancedParens.BalancedParens -import HaskellWorks.Data.Succinct.BalancedParens.CloseAt -import HaskellWorks.Data.Succinct.BalancedParens.Enclose -import HaskellWorks.Data.Succinct.BalancedParens.FindClose -import HaskellWorks.Data.Succinct.BalancedParens.FindCloseN -import HaskellWorks.Data.Succinct.BalancedParens.FindOpen -import HaskellWorks.Data.Succinct.BalancedParens.FindOpenN -import HaskellWorks.Data.Succinct.BalancedParens.OpenAt -import HaskellWorks.Data.Succinct.BalancedParens.NewCloseAt -import HaskellWorks.Data.Vector.AsVector64 -import Prelude hiding (length) - -data RangeMinMax2 a = RangeMinMax2 - { rangeMinMax2BP :: !a - , rangeMinMax2L0Min :: !(DVS.Vector Int8) - , rangeMinMax2L0Max :: !(DVS.Vector Int8) - , rangeMinMax2L0Excess :: !(DVS.Vector Int8) - , rangeMinMax2L1Min :: !(DVS.Vector Int16) - , rangeMinMax2L1Max :: !(DVS.Vector Int16) - , rangeMinMax2L1Excess :: !(DVS.Vector Int16) - , rangeMinMax2L2Min :: !(DVS.Vector Int16) - , rangeMinMax2L2Max :: !(DVS.Vector Int16) - , rangeMinMax2L2Excess :: !(DVS.Vector Int16) - , rangeMinMax2L3Min :: !(DVS.Vector Int16) - , rangeMinMax2L3Max :: !(DVS.Vector Int16) - , rangeMinMax2L3Excess :: !(DVS.Vector Int16) - , rangeMinMax2L4Min :: !(DVS.Vector Int16) - , rangeMinMax2L4Max :: !(DVS.Vector Int16) - , rangeMinMax2L4Excess :: !(DVS.Vector Int16) - } - -factorL0 :: Integral a => a -factorL0 = 1 -{-# INLINE factorL0 #-} - -factorL1 :: Integral a => a -factorL1 = 32 -{-# INLINE factorL1 #-} - -factorL2 :: Integral a => a -factorL2 = 32 -{-# INLINE factorL2 #-} - -factorL3 :: Integral a => a -factorL3 = 32 -{-# INLINE factorL3 #-} - -factorL4 :: Integral a => a -factorL4 = 32 -{-# INLINE factorL4 #-} - -pageSizeL0 :: Integral a => a -pageSizeL0 = factorL0 -{-# INLINE pageSizeL0 #-} - -pageSizeL1 :: Integral a => a -pageSizeL1 = pageSizeL0 * factorL1 -{-# INLINE pageSizeL1 #-} - -pageSizeL2 :: Integral a => a -pageSizeL2 = pageSizeL1 * factorL2 -{-# INLINE pageSizeL2 #-} - -pageSizeL3 :: Integral a => a -pageSizeL3 = pageSizeL2 * factorL3 -{-# INLINE pageSizeL3 #-} - -pageSizeL4 :: Integral a => a -pageSizeL4 = pageSizeL3 * factorL4 -{-# INLINE pageSizeL4 #-} - -mkRangeMinMax2 :: AsVector64 a => a -> RangeMinMax2 a -mkRangeMinMax2 bp = RangeMinMax2 - { rangeMinMax2BP = bp - , rangeMinMax2L0Min = dvsReword rmmL0Min - , rangeMinMax2L0Max = dvsReword rmmL0Max - , rangeMinMax2L0Excess = dvsReword rmmL0Excess - , rangeMinMax2L1Min = rmmL1Min - , rangeMinMax2L1Max = rmmL1Max - , rangeMinMax2L1Excess = rmmL1Excess - , rangeMinMax2L2Min = rmmL2Min - , rangeMinMax2L2Max = rmmL2Max - , rangeMinMax2L2Excess = rmmL2Excess - , rangeMinMax2L3Min = rmmL3Min - , rangeMinMax2L3Max = rmmL3Max - , rangeMinMax2L3Excess = rmmL3Excess - , rangeMinMax2L4Min = rmmL4Min - , rangeMinMax2L4Max = rmmL4Max - , rangeMinMax2L4Excess = rmmL4Excess - } - where bpv = asVector64 bp - lenBP = fromIntegral (length bpv) :: Int - lenL0 = lenBP - lenL1 = (DVS.length rmmL0Min `div` pageSizeL1) + 1 :: Int - lenL2 = (DVS.length rmmL0Min `div` pageSizeL2) + 1 :: Int - lenL3 = (DVS.length rmmL0Min `div` pageSizeL3) + 1 :: Int - lenL4 = (DVS.length rmmL0Min `div` pageSizeL4) + 1 :: Int - allMinMaxL0 = dvConstructNI lenL0 (\i -> if i == lenBP then (-64, -64, 0) else minMaxExcess1 (bpv !!! fromIntegral i)) - rmmL0Excess = dvsConstructNI lenL0 (\i -> fromIntegral (allExcess1 (pageFill i pageSizeL0 (-64) bpv))) :: DVS.Vector Int16 - rmmL1Excess = dvsConstructNI lenL1 (\i -> fromIntegral (allExcess1 (pageFill i pageSizeL1 (-64) bpv))) :: DVS.Vector Int16 - rmmL2Excess = dvsConstructNI lenL2 (\i -> fromIntegral (allExcess1 (pageFill i pageSizeL2 (-64) bpv))) :: DVS.Vector Int16 - rmmL3Excess = dvsConstructNI lenL3 (\i -> fromIntegral (allExcess1 (pageFill i pageSizeL3 (-64) bpv))) :: DVS.Vector Int16 - rmmL4Excess = dvsConstructNI lenL4 (\i -> fromIntegral (allExcess1 (pageFill i pageSizeL4 (-64) bpv))) :: DVS.Vector Int16 - rmmL0Min = dvsConstructNI lenL0 (\i -> let (minE, _, _) = allMinMaxL0 DV.! i in fromIntegral minE) :: DVS.Vector Int16 - rmmL1Min = dvsConstructNI lenL1 (\i -> genMin 0 (pageFill i factorL1 0 rmmL0Min) (pageFill i factorL1 0 rmmL0Excess)) - rmmL2Min = dvsConstructNI lenL2 (\i -> genMin 0 (pageFill i factorL2 0 rmmL1Min) (pageFill i factorL2 0 rmmL1Excess)) - rmmL3Min = dvsConstructNI lenL3 (\i -> genMin 0 (pageFill i factorL3 0 rmmL2Min) (pageFill i factorL3 0 rmmL2Excess)) - rmmL4Min = dvsConstructNI lenL4 (\i -> genMin 0 (pageFill i factorL4 0 rmmL3Min) (pageFill i factorL4 0 rmmL3Excess)) - rmmL0Max = dvsConstructNI lenL0 (\i -> let (_, _, maxE) = allMinMaxL0 DV.! i in fromIntegral maxE) :: DVS.Vector Int16 - rmmL1Max = dvsConstructNI lenL1 (\i -> genMax 0 (pageFill i factorL1 0 rmmL0Max) (pageFill i factorL1 0 rmmL0Excess)) - rmmL2Max = dvsConstructNI lenL2 (\i -> genMax 0 (pageFill i factorL2 0 rmmL1Max) (pageFill i factorL2 0 rmmL1Excess)) - rmmL3Max = dvsConstructNI lenL3 (\i -> genMax 0 (pageFill i factorL3 0 rmmL2Max) (pageFill i factorL3 0 rmmL2Excess)) - rmmL4Max = dvsConstructNI lenL4 (\i -> genMax 0 (pageFill i factorL4 0 rmmL3Max) (pageFill i factorL4 0 rmmL3Excess)) - -genMin :: (Integral a, DVS.Storable a) => a -> DVS.Vector a -> DVS.Vector a -> a -genMin mL mins excesses = if not (DVS.null mins) || not (DVS.null excesses) - then genMin (dvsLastOrZero mins `min` (mL + dvsLastOrZero excesses)) (DVS.init mins) (DVS.init excesses) - else mL - -genMax :: (Integral a, DVS.Storable a) => a -> DVS.Vector a -> DVS.Vector a -> a -genMax mL maxs excesses = if not (DVS.null maxs) || not (DVS.null excesses) - then genMax (dvsLastOrZero maxs `max` (mL + dvsLastOrZero excesses)) (DVS.init maxs) (DVS.init excesses) - else mL - -pageFill :: DVS.Storable a => Int -> Int -> a -> DVS.Vector a -> DVS.Vector a -pageFill n s = dropTakeFill (n * s) s -{-# INLINE pageFill #-} - -dropTakeFill :: DVS.Storable a => Int -> Int -> a -> DVS.Vector a -> DVS.Vector a -dropTakeFill n s a v = let r = DVS.take s (DVS.drop n v) in - let rLen = DVS.length r in - if rLen == s then r else DVS.concat [r, DVS.replicate (s - rLen) a] -{-# INLINE dropTakeFill #-} - -dvConstructNI :: Int -> (Int -> a) -> DV.Vector a -dvConstructNI n g = DV.constructN n (g . DV.length) -{-# INLINE dvConstructNI #-} - -dvsConstructNI :: DVS.Storable a => Int -> (Int -> a) -> DVS.Vector a -dvsConstructNI n g = DVS.constructN n (g . DVS.length) -{-# INLINE dvsConstructNI #-} - -dvsReword :: (DVS.Storable a, Integral a, DVS.Storable b, Num b) => DVS.Vector a -> DVS.Vector b -dvsReword v = dvsConstructNI (DVS.length v) (\i -> fromIntegral (v DVS.! i)) -{-# INLINE dvsReword #-} - -dvsLastOrZero :: (DVS.Storable a, Integral a) => DVS.Vector a -> a -dvsLastOrZero v = if not (DVS.null v) then DVS.last v else 0 -{-# INLINE dvsLastOrZero #-} - -data FindState = FindBP - | FindL0 | FindFromL0 - | FindL1 | FindFromL1 - | FindL2 | FindFromL2 - | FindL3 | FindFromL3 - | FindL4 | FindFromL4 - -rmm2FindClose :: (BitLength a, NewCloseAt a) => RangeMinMax2 a -> Int -> Count -> FindState -> Maybe Count -rmm2FindClose v s p FindBP = if v `newCloseAt` p - then if s <= 1 - then Just p - else rmm2FindClose v (s - 1) (p + 1) FindFromL0 - else rmm2FindClose v (s + 1) (p + 1) FindFromL0 -rmm2FindClose v s p FindL0 = - let i = p `div` 64 in - let mins = rangeMinMax2L0Min v in - let minE = fromIntegral (mins !!! fromIntegral i) :: Int in - if fromIntegral s + minE <= 0 - then rmm2FindClose v s p FindBP - else if v `newCloseAt` p && s <= 1 - then Just p - else let excesses = rangeMinMax2L0Excess v in - let excess = fromIntegral (excesses !!! fromIntegral i) :: Int in - rmm2FindClose v (fromIntegral (excess + fromIntegral s)) (p + 64) FindFromL0 -rmm2FindClose v s p FindL1 = - let !i = p `div` (64 * pageSizeL1) in - let !mins = rangeMinMax2L1Min v in - let !minE = fromIntegral (mins !!! fromIntegral i) :: Int in - if fromIntegral s + minE <= 0 - then rmm2FindClose v s p FindL0 - else if 0 <= p && p < bitLength v - then if v `newCloseAt` p && s <= 1 - then Just p - else let excesses = rangeMinMax2L1Excess v in - let excess = fromIntegral (excesses !!! fromIntegral i) :: Int in - rmm2FindClose v (fromIntegral (excess + fromIntegral s)) (p + (64 * pageSizeL1)) FindFromL1 - else Nothing -rmm2FindClose v s p FindL2 = - let !i = p `div` (64 * pageSizeL2) in - let !mins = rangeMinMax2L2Min v in - let !minE = fromIntegral (mins !!! fromIntegral i) :: Int in - if fromIntegral s + minE <= 0 - then rmm2FindClose v s p FindL1 - else if 0 <= p && p < bitLength v - then if v `newCloseAt` p && s <= 1 - then Just p - else let excesses = rangeMinMax2L2Excess v in - let excess = fromIntegral (excesses !!! fromIntegral i) :: Int in - rmm2FindClose v (fromIntegral (excess + fromIntegral s)) (p + (64 * pageSizeL2)) FindFromL2 - else Nothing -rmm2FindClose v s p FindL3 = - let !i = p `div` (64 * pageSizeL3) in - let !mins = rangeMinMax2L3Min v in - let !minE = fromIntegral (mins !!! fromIntegral i) :: Int in - if fromIntegral s + minE <= 0 - then rmm2FindClose v s p FindL2 - else if 0 <= p && p < bitLength v - then if v `newCloseAt` p && s <= 1 - then Just p - else let excesses = rangeMinMax2L3Excess v in - let excess = fromIntegral (excesses !!! fromIntegral i) :: Int in - rmm2FindClose v (fromIntegral (excess + fromIntegral s)) (p + (64 * pageSizeL3)) FindFromL3 - else Nothing -rmm2FindClose v s p FindL4 = - let !i = p `div` (64 * pageSizeL4) in - let !mins = rangeMinMax2L4Min v in - let !minE = fromIntegral (mins !!! fromIntegral i) :: Int in - if fromIntegral s + minE <= 0 - then rmm2FindClose v s p FindL3 - else if 0 <= p && p < bitLength v - then if v `newCloseAt` p && s <= 1 - then Just p - else let excesses = rangeMinMax2L4Excess v in - let excess = fromIntegral (excesses !!! fromIntegral i) :: Int in - rmm2FindClose v (fromIntegral (excess + fromIntegral s)) (p + (64 * pageSizeL4)) FindFromL4 - else Nothing -rmm2FindClose v s p FindFromL0 - | p `mod` 64 == 0 = rmm2FindClose v s p FindFromL1 - | 0 <= p && p < bitLength v = rmm2FindClose v s p FindBP - | otherwise = Nothing -rmm2FindClose v s p FindFromL1 - | p `mod` (64 * pageSizeL1) == 0 = if 0 <= p && p < bitLength v then rmm2FindClose v s p FindFromL2 else Nothing - | 0 <= p && p < bitLength v = rmm2FindClose v s p FindL0 - | otherwise = Nothing -rmm2FindClose v s p FindFromL2 - | p `mod` (64 * pageSizeL2) == 0 = if 0 <= p && p < bitLength v then rmm2FindClose v s p FindFromL3 else Nothing - | 0 <= p && p < bitLength v = rmm2FindClose v s p FindL1 - | otherwise = Nothing -rmm2FindClose v s p FindFromL3 - | p `mod` (64 * pageSizeL3) == 0 = if 0 <= p && p < bitLength v then rmm2FindClose v s p FindFromL4 else Nothing - | 0 <= p && p < bitLength v = rmm2FindClose v s p FindL2 - | otherwise = Nothing -rmm2FindClose v s p FindFromL4 - | p `mod` (64 * pageSizeL4) == 0 = if 0 <= p && p < bitLength v then rmm2FindClose v s p FindL4 else Nothing - | 0 <= p && p < bitLength v = rmm2FindClose v s p FindL3 - | otherwise = Nothing -{-# INLINE rmm2FindClose #-} - -instance TestBit a => TestBit (RangeMinMax2 a) where - (.?.) = (.?.) . rangeMinMax2BP - {-# INLINE (.?.) #-} - -instance Rank1 a => Rank1 (RangeMinMax2 a) where - rank1 = rank1 . rangeMinMax2BP - {-# INLINE rank1 #-} - -instance Rank0 a => Rank0 (RangeMinMax2 a) where - rank0 = rank0 . rangeMinMax2BP - {-# INLINE rank0 #-} - -instance BitLength a => BitLength (RangeMinMax2 a) where - bitLength = bitLength . rangeMinMax2BP - {-# INLINE bitLength #-} - -instance OpenAt a => OpenAt (RangeMinMax2 a) where - openAt = openAt . rangeMinMax2BP - {-# INLINE openAt #-} - -instance CloseAt a => CloseAt (RangeMinMax2 a) where - closeAt = closeAt . rangeMinMax2BP - {-# INLINE closeAt #-} - -instance NewCloseAt a => NewCloseAt (RangeMinMax2 a) where - newCloseAt = newCloseAt . rangeMinMax2BP - {-# INLINE newCloseAt #-} - -instance FindOpenN a => FindOpenN (RangeMinMax2 a) where - findOpenN = findOpenN . rangeMinMax2BP - {-# INLINE findOpenN #-} - -instance (BitLength a, FindCloseN a, NewCloseAt a) => FindCloseN (RangeMinMax2 a) where - findCloseN v s p = (+ 1) `fmap` rmm2FindClose v (fromIntegral s) (p - 1) FindFromL0 - {-# INLINE findCloseN #-} - -instance (BitLength a, NewCloseAt a, CloseAt a, FindCloseN a) => FindClose (RangeMinMax2 a) where - findClose v p = if v `closeAt` p then Just p else findCloseN v 1 (p + 1) - {-# INLINE findClose #-} - -instance FindOpen (RangeMinMax2 a) where - findOpen = undefined - {-# INLINE findOpen #-} - -instance Enclose (RangeMinMax2 a) where - enclose = undefined - {-# INLINE enclose #-} - -instance (BitLength a, NewCloseAt a, CloseAt a, OpenAt a, FindCloseN a) => BalancedParens (RangeMinMax2 a) diff --git a/src/HaskellWorks/Data/Succinct/BalancedParens/Simple.hs b/src/HaskellWorks/Data/Succinct/BalancedParens/Simple.hs deleted file mode 100644 --- a/src/HaskellWorks/Data/Succinct/BalancedParens/Simple.hs +++ /dev/null @@ -1,32 +0,0 @@ -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} - -module HaskellWorks.Data.Succinct.BalancedParens.Simple - ( SimpleBalancedParens(..) - ) where - -import Control.Monad -import HaskellWorks.Data.Bits.BitLength -import HaskellWorks.Data.Bits.BitShow -import HaskellWorks.Data.Bits.BitWise -import HaskellWorks.Data.RankSelect.Base.Rank0 -import HaskellWorks.Data.RankSelect.Base.Rank1 -import HaskellWorks.Data.RankSelect.Base.Select0 -import HaskellWorks.Data.RankSelect.Base.Select1 -import HaskellWorks.Data.Succinct.BalancedParens.BalancedParens -import HaskellWorks.Data.Succinct.BalancedParens.CloseAt -import HaskellWorks.Data.Succinct.BalancedParens.Enclose -import HaskellWorks.Data.Succinct.BalancedParens.FindClose -import HaskellWorks.Data.Succinct.BalancedParens.FindOpen -import HaskellWorks.Data.Succinct.BalancedParens.OpenAt -import Prelude as P - -newtype SimpleBalancedParens a = SimpleBalancedParens a - deriving (BalancedParens, FindOpen, FindClose, Enclose, OpenAt, CloseAt, BitLength, BitShow, Eq, Rank0, Rank1, Select0, Select1, TestBit) - -instance Functor SimpleBalancedParens where - fmap f (SimpleBalancedParens a) = SimpleBalancedParens (f a) - {-# INLINABLE fmap #-} - -instance BitShow a => Show (SimpleBalancedParens a) where - show = bitShow diff --git a/src/HaskellWorks/Data/Succinct/EliasFano64.hs b/src/HaskellWorks/Data/Succinct/EliasFano64.hs deleted file mode 100644 --- a/src/HaskellWorks/Data/Succinct/EliasFano64.hs +++ /dev/null @@ -1,64 +0,0 @@ -{-# LANGUAGE FlexibleInstances #-} - -module HaskellWorks.Data.Succinct.EliasFano64 - ( EliasFano64(..) - , FromEliasFano64(..) - , ToEliasFano64(..) - ) where - -import qualified Data.Vector.Storable as DVS -import Data.Word -import HaskellWorks.Data.AtIndex -import HaskellWorks.Data.Bits.BitWise -import HaskellWorks.Data.Bits.Log2 -import HaskellWorks.Data.Bits.PackedVector as PV -import HaskellWorks.Data.Positioning -import HaskellWorks.Data.Succinct.EliasFano64.Internal -import HaskellWorks.Data.Take -import Safe -import Prelude hiding (length, take) - -data EliasFano64 = EliasFano64 - { hi :: DVS.Vector Word64 - , lo :: PackedVector64 - , loBits :: Int - , count :: Count - } deriving (Eq, Show) - -class FromEliasFano64 a where - fromEliasFano64 :: EliasFano64 -> a - -class ToEliasFano64 a where - toEliasFano64 :: a -> EliasFano64 - -instance ToEliasFano64 [Word64] where - toEliasFano64 ws = case lastMay ws of - Just end' -> EliasFano64 - { hi = DVS.fromList (packToWord64 (packToWord32 (packToWord16 (packToWord8 (mkHiBits loBits' ws))))) - , lo = PV.fromList loBits' ws - , loBits = fromIntegral loBits' - , count = length' - } - where length' = length ws - loBits' = fromIntegral (log2 (end' `div` length')) :: Count - Nothing -> EliasFano64 - { hi = DVS.empty - , lo = PV.empty - , loBits = 0 - , count = 0 - } - -instance FromEliasFano64 [Word64] where - fromEliasFano64 ef = gen `fmap` take (count ef) [0 ..] - where gen :: Int -> Word64 - gen i = let pos = (loBits ef * i) in - let (index, offset) = pos `quotRem` 64 in - let loValue = (lo ef !!! fromIntegral index) .>. fromIntegral offset in - let hiValue = (lo ef !!! fromIntegral index) .>. fromIntegral offset in - loValue + hiValue - --- instance AtIndex EliasFano64 where --- (!!!) v i = v !! fromIntegral i --- atIndex v i = v !! fromIntegral i --- {-# INLINE (!!!) #-} --- {-# INLINE atIndex #-} diff --git a/src/HaskellWorks/Data/Succinct/EliasFano64/Internal.hs b/src/HaskellWorks/Data/Succinct/EliasFano64/Internal.hs deleted file mode 100644 --- a/src/HaskellWorks/Data/Succinct/EliasFano64/Internal.hs +++ /dev/null @@ -1,53 +0,0 @@ -{-# LANGUAGE FlexibleInstances #-} - -module HaskellWorks.Data.Succinct.EliasFano64.Internal - ( mkHiBits - , packToWord8 - , packToWord16 - , packToWord32 - , packToWord64 - ) where - -import Data.Word -import HaskellWorks.Data.Bits.BitWise -import HaskellWorks.Data.Positioning -import HaskellWorks.Data.Widen - -mkHiBits :: Count -> [Word64] -> [Bool] -mkHiBits = mkHiBits' 0 - -mkHiBits' :: Word64 -> Count -> [Word64] -> [Bool] -mkHiBits' _ _ [] = [] -mkHiBits' oldHi loBitsSize wws@(w:ws) = case w .>. loBitsSize of - newHi | oldHi < newHi -> False:mkHiBits' (oldHi + 1) loBitsSize wws - newHi | oldHi == newHi -> True :mkHiBits' oldHi loBitsSize ws - _ -> error "Values must be non-decreasing" - -packToWord8 :: [Bool] -> [Word8] -packToWord8 (a:b:c:d:e:f:g:h:xs) = - ( (if a then 0x01 else 0x00) - .|. (if b then 0x02 else 0x00) - .|. (if c then 0x04 else 0x00) - .|. (if d then 0x08 else 0x00) - .|. (if e then 0x10 else 0x00) - .|. (if f then 0x20 else 0x00) - .|. (if g then 0x40 else 0x00) - .|. (if h then 0x80 else 0x00) - ) : packToWord8 xs -packToWord8 [] = [] -packToWord8 xs = packToWord8 (take 8 (xs ++ [False])) - -packToWord16 :: [Word8] -> [Word16] -packToWord16 (a:b:xs) = (widen16 a .|. (widen16 b .<. 8)):packToWord16 xs -packToWord16 (a :xs) = widen16 a :packToWord16 xs -packToWord16 [] = [] - -packToWord32 :: [Word16] -> [Word32] -packToWord32 (a:b:xs) = (widen32 a .|. (widen32 b .<. 16)):packToWord32 xs -packToWord32 (a :xs) = widen32 a :packToWord32 xs -packToWord32 [] = [] - -packToWord64 :: [Word32] -> [Word64] -packToWord64 (a:b:xs) = (widen64 a .|. (widen64 b .<. 32)):packToWord64 xs -packToWord64 (a :xs) = widen64 a :packToWord64 xs -packToWord64 [] = [] diff --git a/src/HaskellWorks/Data/Succinct/NearestNeighbour.hs b/src/HaskellWorks/Data/Succinct/NearestNeighbour.hs deleted file mode 100644 --- a/src/HaskellWorks/Data/Succinct/NearestNeighbour.hs +++ /dev/null @@ -1,14 +0,0 @@ -module HaskellWorks.Data.Succinct.NearestNeighbour - ( bitPred - , bitSucc - ) where - -import HaskellWorks.Data.Positioning -import HaskellWorks.Data.RankSelect.Base.Rank1 -import HaskellWorks.Data.RankSelect.Base.Select1 - -bitPred :: (Rank1 v, Select1 v) => v -> Count -> Count -bitPred v p = select1 v (rank1 v p - 1) - -bitSucc :: (Rank1 v, Select1 v) => v -> Count -> Count -bitSucc v p = select1 v (rank1 v p + 1) diff --git a/src/HaskellWorks/Data/Succinct/RankSelect/Binary/CsPoppy.hs b/src/HaskellWorks/Data/Succinct/RankSelect/Binary/CsPoppy.hs deleted file mode 100644 --- a/src/HaskellWorks/Data/Succinct/RankSelect/Binary/CsPoppy.hs +++ /dev/null @@ -1,120 +0,0 @@ -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.AtIndex -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 HaskellWorks.Data.Search -import HaskellWorks.Data.Vector.AsVector64 - -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) - -instance AsVector64 CsPoppy where - asVector64 = asVector64 . csPoppyBits - {-# INLINE asVector64 #-} - -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 popCount1Range (indexN * 8) 8 v + DVS.last u - genCum2048 u = let indexN = DVS.length u in - if indexN .&. 0xffffffff == 0 - then 0 - else popCount1Range ((indexN - 1) * 32) 32 v + DVS.last u - genLayer0 u = let indexN = DVS.length u in - if indexN == 0 - then 0 - else 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 = popCount1Range (indexN * 32 + 0) 8 v in - let b = popCount1Range (indexN * 32 + 8) 8 v in - let c = 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 < end 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 = (rankLayer0 + rankLayer1) :: Count - 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 = (i !!! q) :: Count - 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 deleted file mode 100644 --- a/src/HaskellWorks/Data/Succinct/RankSelect/Binary/CsPoppy2.hs +++ /dev/null @@ -1,111 +0,0 @@ -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.AtIndex -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 HaskellWorks.Data.Search -import HaskellWorks.Data.Vector.AsVector64 - -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) - -instance AsVector64 CsPoppy2 where - asVector64 = asVector64 . csPoppy2Bits - {-# INLINE asVector64 #-} - -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 popCount1Range (indexN * 8) 8 v + DVS.last u - genCum2048 u = let indexN = DVS.length u in - if indexN .&. 0xffffffff == 0 - then 0 - else popCount1Range ((indexN - 1) * 32) 32 v + DVS.last u - genLayer0 u = let indexN = DVS.length u in - if indexN == 0 - then 0 - else 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 = popCount1Range (indexN * 32 + 0) 8 v in - let b = popCount1Range (indexN * 32 + 8) 8 v in - let c = 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 < end 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 = (rankLayer0 + rankLayer1) :: Count - 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 = (i !!! q) :: Count - 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 deleted file mode 100644 --- a/src/HaskellWorks/Data/Succinct/RankSelect/Binary/Poppy512.hs +++ /dev/null @@ -1,122 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} - -module HaskellWorks.Data.Succinct.RankSelect.Binary.Poppy512 - ( Poppy512(..) - , Rank1(..) - , makePoppy512 - ) where - -import qualified Data.Vector.Storable as DVS -import Data.Word -import HaskellWorks.Data.AtIndex -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.RankSelect.Base.Rank0 -import HaskellWorks.Data.RankSelect.Base.Rank1 -import HaskellWorks.Data.RankSelect.Base.Select0 -import HaskellWorks.Data.RankSelect.Base.Select1 -import HaskellWorks.Data.Search -import HaskellWorks.Data.Succinct.BalancedParens.BalancedParens -import HaskellWorks.Data.Succinct.BalancedParens.CloseAt -import HaskellWorks.Data.Succinct.BalancedParens.Enclose -import HaskellWorks.Data.Succinct.BalancedParens.FindClose -import HaskellWorks.Data.Succinct.BalancedParens.FindOpen -import HaskellWorks.Data.Succinct.BalancedParens.FindCloseN -import HaskellWorks.Data.Succinct.BalancedParens.FindOpenN -import HaskellWorks.Data.Succinct.BalancedParens.NewCloseAt -import HaskellWorks.Data.Succinct.BalancedParens.OpenAt -import HaskellWorks.Data.Vector.AsVector64 -import Prelude hiding (length) - -data Poppy512 = Poppy512 - { poppy512Bits :: DVS.Vector Word64 - , poppy512Index :: DVS.Vector Word64 - } deriving (Eq, Show) - -instance AsVector64 Poppy512 where - asVector64 = asVector64 . poppy512Bits - {-# INLINE asVector64 #-} - -makePoppy512 :: DVS.Vector Word64 -> Poppy512 -makePoppy512 v = Poppy512 - { poppy512Bits = v - , poppy512Index = DVS.constructN (((DVS.length v + 7) `div` 8) + 1) gen512Index - } - where gen512Index u = let indexN = DVS.length u - 1 in - if indexN == -1 - then 0 - else popCount1 (DVS.take 8 (DVS.drop (indexN * 8) v)) + DVS.last u - -instance BitLength Poppy512 where - bitLength v = length (poppy512Bits v) * bitLength (poppy512Bits v !!! 0) - {-# INLINE bitLength #-} - -instance TestBit Poppy512 where - (.?.) = (.?.) . poppy512Bits - {-# INLINE (.?.) #-} - -instance BitRead Poppy512 where - bitRead = fmap makePoppy512 . bitRead - -instance Rank1 Poppy512 where - rank1 (Poppy512 v i) p = - (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 - (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) - where q = binarySearch (fromIntegral p) wordAt 0 (fromIntegral $ DVS.length i - 1) - s = (i !!! q) :: Count - wordAt = (i !!!) - -instance Select0 Poppy512 where - select0 (Poppy512 v i) p = toCount q * 512 + select0 (DVS.drop (fromIntegral q * 8) v) (p - s) - where q = binarySearch (fromIntegral p) wordAt 0 (fromIntegral $ DVS.length i - 1) - s = (fromIntegral q * 512 - (i !!! q)) :: Count - wordAt o = fromIntegral o * 512 - (i !!! o) - -instance OpenAt Poppy512 where - openAt = openAt . poppy512Bits - {-# INLINE openAt #-} - -instance CloseAt Poppy512 where - closeAt = closeAt . poppy512Bits - {-# INLINE closeAt #-} - -instance FindOpenN Poppy512 where - findOpenN = findOpenN . poppy512Bits - {-# INLINE findOpenN #-} - -instance FindCloseN Poppy512 where - findCloseN = findCloseN . poppy512Bits - {-# INLINE findCloseN #-} - -instance FindOpen Poppy512 where - findOpen = findOpen . poppy512Bits - {-# INLINE findOpen #-} - -instance FindClose Poppy512 where - findClose = findClose . poppy512Bits - {-# INLINE findClose #-} - -instance NewCloseAt Poppy512 where - newCloseAt = newCloseAt . poppy512Bits - {-# INLINE newCloseAt #-} - -instance Enclose Poppy512 where - enclose = enclose . poppy512Bits - {-# INLINE enclose #-} - -instance BalancedParens Poppy512 where - firstChild = firstChild . poppy512Bits - nextSibling = nextSibling . poppy512Bits - parent = parent . poppy512Bits - {-# INLINE firstChild #-} - {-# INLINE nextSibling #-} - {-# INLINE parent #-} diff --git a/src/HaskellWorks/Data/Succinct/RankSelect/Binary/Poppy512S.hs b/src/HaskellWorks/Data/Succinct/RankSelect/Binary/Poppy512S.hs deleted file mode 100644 --- a/src/HaskellWorks/Data/Succinct/RankSelect/Binary/Poppy512S.hs +++ /dev/null @@ -1,143 +0,0 @@ -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.AtIndex -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.RankSelect.Base.Rank0 -import HaskellWorks.Data.RankSelect.Base.Rank1 -import HaskellWorks.Data.RankSelect.Base.Select1 -import HaskellWorks.Data.Search -import HaskellWorks.Data.Succinct.BalancedParens.BalancedParens -import HaskellWorks.Data.Succinct.BalancedParens.CloseAt -import HaskellWorks.Data.Succinct.BalancedParens.Enclose -import HaskellWorks.Data.Succinct.BalancedParens.FindClose -import HaskellWorks.Data.Succinct.BalancedParens.FindCloseN -import HaskellWorks.Data.Succinct.BalancedParens.FindOpen -import HaskellWorks.Data.Succinct.BalancedParens.FindOpenN -import HaskellWorks.Data.Succinct.BalancedParens.NewCloseAt -import HaskellWorks.Data.Succinct.BalancedParens.OpenAt -import HaskellWorks.Data.Vector.AsVector64 -import Prelude hiding (length) - -data Poppy512S = Poppy512S - { poppy512SBits :: DVS.Vector Word64 - , poppy512Index :: DVS.Vector Word64 - , poppy512Samples :: DVS.Vector Word64 -- Sampling position of each 8192 1-bit - } deriving (Eq, Show) - -instance AsVector64 Poppy512S where - asVector64 = asVector64 . poppy512SBits - {-# INLINE asVector64 #-} - -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 - { poppy512SBits = v - , poppy512Index = DVS.constructN (((DVS.length v + 8 - 1) `div` 8) + 1) gen512Index - , poppy512Samples = 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 popCount1Range (indexN * 8) 8 v + DVS.last u - genS :: (Count, Position) -> Maybe (Word64, (Count, Position)) - genS (pca, n) = if n < end 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 BitLength Poppy512S where - bitLength v = length (poppy512SBits v) * bitLength (poppy512SBits v !!! 0) - {-# INLINE bitLength #-} - -instance TestBit Poppy512S where - (.?.) = (.?.) . poppy512SBits - {-# INLINE (.?.) #-} - -instance BitRead Poppy512S where - bitRead = fmap makePoppy512S . bitRead - -instance Rank1 Poppy512S where - rank1 (Poppy512S v i _) p = - (i !!! toPosition (p `div` 512)) + rank1 (DVS.drop ((fromIntegral p `div` 512) * 8) v) (p `mod` 512) - -instance Rank0 Poppy512S where - rank0 (Poppy512S v i _) p = - p `div` 512 * 512 - (i !!! toPosition (p `div` 512)) + rank0 (DVS.drop ((fromIntegral p `div` 512) * 8) 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 = (i !!! q) :: Count - wordAt = (i !!!) - (sampleMin, sampleMax) = sampleRange iv p - iMin = fromIntegral $ (sampleMin - 1) `div` 512 :: Position - iMax = fromIntegral $ ((sampleMax - 1) `div` 512) + 1 :: Position - -instance OpenAt Poppy512S where - openAt = openAt . poppy512SBits - {-# INLINE openAt #-} - -instance CloseAt Poppy512S where - closeAt = closeAt . poppy512SBits - {-# INLINE closeAt #-} - -instance NewCloseAt Poppy512S where - newCloseAt = newCloseAt . poppy512SBits - {-# INLINE newCloseAt #-} - -instance FindOpenN Poppy512S where - findOpenN = findOpenN . poppy512SBits - {-# INLINE findOpenN #-} - -instance FindOpen Poppy512S where - findOpen = findOpen . poppy512SBits - {-# INLINE findOpen #-} - -instance FindClose Poppy512S where - findClose = findClose . poppy512SBits - {-# INLINE findClose #-} - -instance FindCloseN Poppy512S where - findCloseN = findCloseN . poppy512SBits - {-# INLINE findCloseN #-} - -instance Enclose Poppy512S where - enclose = enclose . poppy512SBits - {-# INLINE enclose #-} - -instance BalancedParens Poppy512S where - firstChild = firstChild . poppy512SBits - nextSibling = nextSibling . poppy512SBits - parent = parent . poppy512SBits - {-# INLINE firstChild #-} - {-# INLINE nextSibling #-} - {-# INLINE parent #-} diff --git a/test/HaskellWorks/Data/RankSelect/BasicGen.hs b/test/HaskellWorks/Data/RankSelect/BasicGen.hs new file mode 100644 --- /dev/null +++ b/test/HaskellWorks/Data/RankSelect/BasicGen.hs @@ -0,0 +1,120 @@ +{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module HaskellWorks.Data.RankSelect.BasicGen + ( genRankSelectSpec + , genRank0Select0Spec + , genRank1Select1Spec + ) where + +import Data.Maybe +import Data.Typeable +import Data.Word +import HaskellWorks.Data.Bits.BitRead +import HaskellWorks.Data.RankSelect.Base.Rank0 +import HaskellWorks.Data.RankSelect.Base.Rank1 +import HaskellWorks.Data.RankSelect.Base.Select0 +import HaskellWorks.Data.RankSelect.Base.Select1 +import Test.Hspec + +{-# 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 + let bs = fromJust (bitRead "10010010") :: s + fmap (rank0 bs) [0..8] `shouldBe` [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 + 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 + 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] + +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 + let bs = fromJust (bitRead "10010010") :: s + fmap (rank1 bs) [0..8] `shouldBe` [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 + 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 + 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] + +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 + let bs = fromJust $ bitRead "10010010" :: Word8 + fmap (select0 bs) [0..5] `shouldBe` [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 + 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] + +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] + +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 + let bs = fromJust $ bitRead "10010010" :: s + fmap (select1 bs) [0..3] `shouldBe` [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 + 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 + let bs = fromJust $ bitRead "01000000 00000100" :: s + fmap (select1 bs) [0..2] `shouldBe` [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 + let bs = fromJust $ bitRead "10000010 00000000 00100000 00010000" :: s + fmap (select1 bs) [0..4] `shouldBe` [0, 1, 7, 19, 28] + +genRank1Select1Spec :: forall s. (Typeable s, BitRead s, Rank1 s, Select1 s) => s -> Spec +genRank1Select1Spec s = describe "For Rank 1" $ do + genRank1UpTo8Spec s + genRank1UpTo16Spec s + genSelect1UpTo8Spec s + genSelect1UpTo16Spec s + genSelect1UpTo32Spec s + +genRank0Select0Spec :: forall s. (Typeable s, BitRead s, Rank0 s, Select0 s) => s -> Spec +genRank0Select0Spec s = describe "For Rank 0" $ do + genRank0UpTo8Spec s + genRank0UpTo16Spec s + genSelect0UpTo8Spec s + genSelect0UpTo16Spec s + genSelect0UpTo32Spec s + +genRankSelectSpec :: forall s. (Typeable s, BitRead s, Rank0 s, Rank1 s, Select0 s, Select1 s) => s -> Spec +genRankSelectSpec s = describe "Generically" $ do + genRank1Select1Spec s + genRank0Select0Spec s diff --git a/test/HaskellWorks/Data/RankSelect/CsPoppy2Spec.hs b/test/HaskellWorks/Data/RankSelect/CsPoppy2Spec.hs new file mode 100644 --- /dev/null +++ b/test/HaskellWorks/Data/RankSelect/CsPoppy2Spec.hs @@ -0,0 +1,94 @@ +{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module HaskellWorks.Data.RankSelect.CsPoppy2Spec (spec) where + +import GHC.Exts +import Data.Maybe +import qualified Data.Vector.Storable as DVS +import Data.Word +import HaskellWorks.Data.AtIndex +import HaskellWorks.Data.Bits.BitRead +import HaskellWorks.Data.Bits.BitShow +import HaskellWorks.Data.Bits.PopCount.PopCount1 +import HaskellWorks.Data.RankSelect.Base.Rank1 +import HaskellWorks.Data.RankSelect.Base.Select1 +import HaskellWorks.Data.RankSelect.BasicGen +import HaskellWorks.Data.RankSelect.CsPoppy2 +import Prelude hiding (length) +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.RankSelect.CsPoppy2.Rank1Spec" $ do + genRank1Select1Spec (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, length 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, length 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, length 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/RankSelect/CsPoppySpec.hs b/test/HaskellWorks/Data/RankSelect/CsPoppySpec.hs new file mode 100644 --- /dev/null +++ b/test/HaskellWorks/Data/RankSelect/CsPoppySpec.hs @@ -0,0 +1,94 @@ +{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module HaskellWorks.Data.RankSelect.CsPoppySpec (spec) where + +import GHC.Exts +import Data.Maybe +import qualified Data.Vector.Storable as DVS +import Data.Word +import HaskellWorks.Data.AtIndex +import HaskellWorks.Data.Bits.BitRead +import HaskellWorks.Data.Bits.BitShow +import HaskellWorks.Data.Bits.PopCount.PopCount1 +import HaskellWorks.Data.RankSelect.Base.Rank1 +import HaskellWorks.Data.RankSelect.Base.Select1 +import HaskellWorks.Data.RankSelect.BasicGen +import HaskellWorks.Data.RankSelect.CsPoppy +import Prelude hiding (length) +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.RankSelect.CsPoppy.Rank1Spec" $ do + genRank1Select1Spec (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, length 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, length 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, length 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/RankSelect/InternalSpec.hs b/test/HaskellWorks/Data/RankSelect/InternalSpec.hs new file mode 100644 --- /dev/null +++ b/test/HaskellWorks/Data/RankSelect/InternalSpec.hs @@ -0,0 +1,35 @@ +{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module HaskellWorks.Data.RankSelect.InternalSpec (spec) where + +import HaskellWorks.Data.Bits.BitRead +import HaskellWorks.Data.Bits.PopCount.PopCount1 +import HaskellWorks.Data.Positioning +import HaskellWorks.Data.RankSelect.Base.Rank +import HaskellWorks.Data.RankSelect.Base.Select +import Test.Hspec +import Test.QuickCheck + +{-# ANN module ("HLint: ignore Redundant do" :: String) #-} +{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-} + +spec :: Spec +spec = describe "HaskellWorks.Data.RankSelect.InternalSpec" $ do + describe "For [Bool]" $ do + it "rank True 10010010 over [0..8] should be 011122233" $ + let (Just bs) = bitRead "10010010" :: Maybe [Bool] in + fmap (rank True bs) [0..8] `shouldBe` [0, 1, 1, 1, 2, 2, 2, 3, 3] + it "rank True 10010010 over [0..8] should be 001223445" $ + let (Just bs) = bitRead "10010010" :: Maybe [Bool] in + fmap (rank False bs) [0..8] `shouldBe` [0, 0, 1, 2, 2, 3, 4, 4, 5] + it "select True 10010010 over [0..3] should be 0147" $ + let (Just bs) = bitRead "10010010" :: Maybe [Bool] in + fmap (select True bs) [0..3] `shouldBe` [0, 1, 4, 7] + it "select False 10010010 over [0..5] should be 023568" $ + let (Just bs) = bitRead "10010010" :: Maybe [Bool] in + fmap (select False bs) [0..5] `shouldBe` [0, 2, 3, 5, 6, 8] + it "Rank and select form a galois connection" $ + property $ \(bs :: [Bool]) -> + forAll (choose (0, popCount1 bs)) $ \(c :: Count) -> + rank True bs (select True bs c) == c diff --git a/test/HaskellWorks/Data/RankSelect/Poppy512SSpec.hs b/test/HaskellWorks/Data/RankSelect/Poppy512SSpec.hs new file mode 100644 --- /dev/null +++ b/test/HaskellWorks/Data/RankSelect/Poppy512SSpec.hs @@ -0,0 +1,94 @@ +{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module HaskellWorks.Data.RankSelect.Poppy512SSpec (spec) where + +import GHC.Exts +import Data.Maybe +import qualified Data.Vector.Storable as DVS +import Data.Word +import HaskellWorks.Data.AtIndex +import HaskellWorks.Data.Bits.BitRead +import HaskellWorks.Data.Bits.BitShow +import HaskellWorks.Data.Bits.PopCount.PopCount1 +import HaskellWorks.Data.RankSelect.Base.Rank1 +import HaskellWorks.Data.RankSelect.Base.Select1 +import HaskellWorks.Data.RankSelect.BasicGen +import HaskellWorks.Data.RankSelect.Poppy512S +import Prelude hiding (length) +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.RankSelect.Poppy512S.Rank1Spec" $ do + genRank1Select1Spec (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, length 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, length 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, length 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/RankSelect/Poppy512Spec.hs b/test/HaskellWorks/Data/RankSelect/Poppy512Spec.hs new file mode 100644 --- /dev/null +++ b/test/HaskellWorks/Data/RankSelect/Poppy512Spec.hs @@ -0,0 +1,143 @@ +{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module HaskellWorks.Data.RankSelect.Poppy512Spec (spec) where + +import GHC.Exts +import Data.Maybe +import qualified Data.Vector.Storable as DVS +import Data.Word +import HaskellWorks.Data.AtIndex +import HaskellWorks.Data.Bits.BitRead +import HaskellWorks.Data.Bits.BitShow +import HaskellWorks.Data.Bits.PopCount.PopCount0 +import HaskellWorks.Data.Bits.PopCount.PopCount1 +import HaskellWorks.Data.RankSelect.Base.Rank0 +import HaskellWorks.Data.RankSelect.Base.Rank1 +import HaskellWorks.Data.RankSelect.Base.Select0 +import HaskellWorks.Data.RankSelect.Base.Select1 +import HaskellWorks.Data.RankSelect.BasicGen +import HaskellWorks.Data.RankSelect.Poppy512 +import Prelude hiding (length) +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.RankSelect.Poppy512.Rank1Spec" $ do + genRankSelectSpec (undefined :: Poppy512) + describe "rank1 for Vector Word64 is equivalent to rank1 for Poppy512" $ do + it "on empty bitvector" $ + let v = DVS.empty in + let w = makePoppy512 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, length v * 8)) $ \i -> + let w = makePoppy512 v in + rank1 v i === rank1 w i + it "on two basic blocks" $ + forAll (vectorSizedBetween 9 16) $ \(ShowVector v) -> + forAll (choose (0, length v * 8)) $ \i -> + let w = makePoppy512 v in + rank1 v i === rank1 w i + it "on three basic blocks" $ + forAll (vectorSizedBetween 17 24) $ \(ShowVector v) -> + forAll (choose (0, length v * 8)) $ \i -> + let w = makePoppy512 v in + rank1 v i === rank1 w i + describe "rank0 for Vector Word64 is equivalent to rank0 for Poppy512" $ do + it "on empty bitvector" $ + let v = DVS.empty in + let w = makePoppy512 v in + let i = 0 in + rank0 v i === rank0 w i + it "on one basic block" $ + forAll (vectorSizedBetween 1 8) $ \(ShowVector v) -> + forAll (choose (0, length v * 8)) $ \i -> + let w = makePoppy512 v in + rank0 v i === rank0 w i + it "on two basic blocks" $ + forAll (vectorSizedBetween 9 16) $ \(ShowVector v) -> + forAll (choose (0, length v * 8)) $ \i -> + let w = makePoppy512 v in + rank0 v i === rank0 w i + it "on three basic blocks" $ + forAll (vectorSizedBetween 17 24) $ \(ShowVector v) -> + forAll (choose (0, length v * 8)) $ \i -> + let w = makePoppy512 v in + rank0 v i === rank0 w i + describe "select0 for Vector Word64 is equivalent to select0 for Poppy512" $ do + it "on empty bitvector" $ + let v = DVS.empty in + let w = makePoppy512 v in + let i = 0 in + select0 v i === select0 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 = makePoppy512 v in + select0 v 0 === select0 w 0 + it "on one basic block" $ + forAll (vectorSizedBetween 1 8) $ \(ShowVector v) -> + forAll (choose (0, popCount0 v)) $ \i -> + let w = makePoppy512 v in + select0 v i === select0 w i + it "on two basic blocks" $ + forAll (vectorSizedBetween 9 16) $ \(ShowVector v) -> + forAll (choose (0, popCount0 v)) $ \i -> + let w = makePoppy512 v in + select0 v i === select0 w i + it "on three basic blocks" $ + forAll (vectorSizedBetween 17 24) $ \(ShowVector v) -> + forAll (choose (0, popCount0 v)) $ \i -> + let w = makePoppy512 v in + select0 v i === select0 w i + describe "select1 for Vector Word64 is equivalent to select1 for Poppy512" $ do + it "on empty bitvector" $ + let v = DVS.empty in + let w = makePoppy512 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 = makePoppy512 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 = makePoppy512 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 = makePoppy512 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 = 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] diff --git a/test/HaskellWorks/Data/RankSelect/SimpleSpec.hs b/test/HaskellWorks/Data/RankSelect/SimpleSpec.hs new file mode 100644 --- /dev/null +++ b/test/HaskellWorks/Data/RankSelect/SimpleSpec.hs @@ -0,0 +1,52 @@ +{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module HaskellWorks.Data.RankSelect.SimpleSpec (spec) where + +import Data.Vector +import Data.Word +import HaskellWorks.Data.Bits.BitShown +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Positioning +import HaskellWorks.Data.RankSelect.Base.Rank1 +import Test.Hspec +import Test.QuickCheck + +{-# ANN module ("HLint: ignore Redundant do" :: String) #-} + +spec :: Spec +spec = describe "HaskellWorks.Data.SuccinctSpec" $ do + it "rank1 for BitShown (Vector Word8) and BitShown (Vector Word64) should give same answer" $ + forAll (choose (0, 64)) $ \(i :: Count) (a :: Word8) (b :: Word8) (c :: Word8) (d :: Word8) + (e :: Word8) (f :: Word8) (g :: Word8) (h :: Word8) -> + let a64 = fromIntegral a :: Word64 in + let b64 = fromIntegral b :: Word64 in + let c64 = fromIntegral c :: Word64 in + let d64 = fromIntegral d :: Word64 in + let e64 = fromIntegral e :: Word64 in + let f64 = fromIntegral f :: Word64 in + let g64 = fromIntegral g :: Word64 in + let h64 = fromIntegral h :: Word64 in + let abcdefgh64 = (h64 .<. 56) .|. (g64 .<. 48) .|. (f64 .<. 40) .|. (e64 .<. 32) .|. + (d64 .<. 24) .|. (c64 .<. 16) .|. (b64 .<. 8 ) .|. a64 in + let vec16 = BitShown (fromList [a, b, c, d, e, f, g, h] :: Vector Word8 ) in + let vec64 = BitShown (fromList [abcdefgh64] :: Vector Word64) in + rank1 vec16 i == rank1 vec64 i + it "rank1 for BitShown (Vector Word16) and BitShown (Vector Word64) should give same answer" $ + forAll (choose (0, 64)) $ \(i :: Count) (a :: Word16) (b :: Word16) (c :: Word16) (d :: Word16) -> + let a64 = fromIntegral a :: Word64 in + let b64 = fromIntegral b :: Word64 in + let c64 = fromIntegral c :: Word64 in + let d64 = fromIntegral d :: Word64 in + let abcd64 = (d64 .<. 48) .|. (c64 .<. 32) .|. (b64 .<. 16) .|. a64 in + let vec16 = BitShown (fromList [a, b, c, d] :: Vector Word16) in + let vec64 = BitShown (fromList [abcd64] :: Vector Word64) in + rank1 vec16 i == rank1 vec64 i + it "rank1 for BitShown (Vector Word32) and BitShown (Vector Word64) should give same answer" $ + forAll (choose (0, 64)) $ \(i :: Count) (a :: Word32) (b :: Word32) -> + let a64 = fromIntegral a :: Word64 in + let b64 = fromIntegral b :: Word64 in + let ab64 = (b64 .<. 32) .|. a64 in + let vec32 = BitShown (fromList [a, b] :: Vector Word32) in + let vec64 = BitShown (fromList [ab64] :: Vector Word64) in + rank1 vec32 i == rank1 vec64 i diff --git a/test/HaskellWorks/Data/Succinct/BalancedParens/Internal/BroadwordSpec.hs b/test/HaskellWorks/Data/Succinct/BalancedParens/Internal/BroadwordSpec.hs deleted file mode 100644 --- a/test/HaskellWorks/Data/Succinct/BalancedParens/Internal/BroadwordSpec.hs +++ /dev/null @@ -1,137 +0,0 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} - -module HaskellWorks.Data.Succinct.BalancedParens.Internal.BroadwordSpec where - --- import Data.Maybe -import qualified Data.Vector.Storable as DVS -import Data.Word --- import HaskellWorks.Data.Bits.BitLength --- import HaskellWorks.Data.Bits.BitRead -import HaskellWorks.Data.Bits.BitShow -import HaskellWorks.Data.Bits.Broadword -import HaskellWorks.Data.Bits.FromBitTextByteString -import HaskellWorks.Data.Positioning -import HaskellWorks.Data.Succinct.BalancedParens.FindClose -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 - -spec :: Spec -spec = describe "HaskellWorks.Data.Succinct.BalancedParens.BroadwordSpec" $ do - describe "For (()(()())) 1101101000" $ do - let bs = Broadword (91 :: Word64) - it "Test 1a" $ findClose bs 1 `shouldBe` Just 10 - it "Test 1b" $ findClose bs 2 `shouldBe` Just 3 - it "Test 1b" $ findClose bs 3 `shouldBe` Just 3 - it "Test 1b" $ findClose bs 4 `shouldBe` Just 9 - it "Test 1b" $ findClose bs 5 `shouldBe` Just 6 - it "Test 1b" $ findClose bs 6 `shouldBe` Just 6 - it "Test 1b" $ findClose bs 7 `shouldBe` Just 8 - it "Test 1b" $ findClose bs 8 `shouldBe` Just 8 - it "Test 1b" $ findClose bs 9 `shouldBe` Just 9 - it "Test 1b" $ findClose bs 10 `shouldBe` Just 10 - -- it "Test 2a" $ findOpen bs 10 `shouldBe` Just 1 - -- it "Test 2b" $ findOpen bs 3 `shouldBe` Just 2 - -- it "Test 3a" $ enclose bs 2 `shouldBe` Just 1 - -- it "Test 3b" $ enclose bs 7 `shouldBe` Just 4 - -- describe "For (()(()())) 1101101000" $ do - -- let bs = Broadword (fromJust (bitRead "1101101000") :: [Bool]) - -- it "Test 1a" $ findClose bs 1 `shouldBe` Just 10 - -- it "Test 1b" $ findClose bs 2 `shouldBe` Just 3 - -- it "Test 1b" $ findClose bs 3 `shouldBe` Just 3 - -- it "Test 1b" $ findClose bs 4 `shouldBe` Just 9 - -- it "Test 1b" $ findClose bs 5 `shouldBe` Just 6 - -- it "Test 1b" $ findClose bs 6 `shouldBe` Just 6 - -- it "Test 1b" $ findClose bs 7 `shouldBe` Just 8 - -- it "Test 1b" $ findClose bs 8 `shouldBe` Just 8 - -- it "Test 1b" $ findClose bs 9 `shouldBe` Just 9 - -- it "Test 1b" $ findClose bs 10 `shouldBe` Just 10 - -- it "Test 2a" $ findOpen bs 10 `shouldBe` Just 1 - -- it "Test 2b" $ findOpen bs 3 `shouldBe` Just 2 - -- it "Test 3a" $ enclose bs 2 `shouldBe` Just 1 - -- it "Test 3b" $ enclose bs 7 `shouldBe` Just 4 - -- it "firstChild 1" $ firstChild bs 1 `shouldBe` Just 2 - -- it "firstChild 4" $ firstChild bs 4 `shouldBe` Just 5 - -- it "nextSibling 2" $ nextSibling bs 2 `shouldBe` Just 4 - -- it "nextSibling 5" $ nextSibling bs 5 `shouldBe` Just 7 - -- it "parent 2" $ parent bs 2 `shouldBe` Just 1 - -- it "parent 5" $ parent bs 5 `shouldBe` Just 4 - -- it "depth 1" $ depth bs 1 `shouldBe` Just 1 - -- it "depth 2" $ depth bs 2 `shouldBe` Just 2 - -- it "depth 3" $ depth bs 3 `shouldBe` Just 2 - -- it "depth 4" $ depth bs 4 `shouldBe` Just 2 - -- it "depth 5" $ depth bs 5 `shouldBe` Just 3 - -- it "depth 6" $ depth bs 6 `shouldBe` Just 3 - -- it "depth 7" $ depth bs 7 `shouldBe` Just 3 - -- it "depth 8" $ depth bs 8 `shouldBe` Just 3 - -- it "depth 9" $ depth bs 9 `shouldBe` Just 2 - -- it "depth 10" $ depth bs 10 `shouldBe` Just 1 - -- it "subtreeSize 1" $ subtreeSize bs 1 `shouldBe` Just 5 - -- it "subtreeSize 2" $ subtreeSize bs 2 `shouldBe` Just 1 - -- it "subtreeSize 3" $ subtreeSize bs 3 `shouldBe` Just 0 - -- it "subtreeSize 4" $ subtreeSize bs 4 `shouldBe` Just 3 - -- it "subtreeSize 5" $ subtreeSize bs 5 `shouldBe` Just 1 - -- it "subtreeSize 6" $ subtreeSize bs 6 `shouldBe` Just 0 - -- it "subtreeSize 7" $ subtreeSize bs 7 `shouldBe` Just 1 - -- it "subtreeSize 8" $ subtreeSize bs 8 `shouldBe` Just 0 - -- it "subtreeSize 9" $ subtreeSize bs 9 `shouldBe` Just 0 - -- it "subtreeSize 10" $ subtreeSize bs 10 `shouldBe` Just 0 - describe "For (()(()())) 11011010 00000000 :: DVS.Vector Word8" $ do - let bs = Broadword (DVS.head (fromBitTextByteString "11011010 00000000") :: Word64) - it "Test 1a" $ findClose bs 1 `shouldBe` Just 10 - it "Test 1b" $ findClose bs 2 `shouldBe` Just 3 - it "Test 1b" $ findClose bs 3 `shouldBe` Just 3 - it "Test 1b" $ findClose bs 4 `shouldBe` Just 9 - it "Test 1b" $ findClose bs 5 `shouldBe` Just 6 - it "Test 1b" $ findClose bs 6 `shouldBe` Just 6 - it "Test 1b" $ findClose bs 7 `shouldBe` Just 8 - it "Test 1b" $ findClose bs 8 `shouldBe` Just 8 - it "Test 1b" $ findClose bs 9 `shouldBe` Just 9 - it "Test 1b" $ findClose bs 10 `shouldBe` Just 10 - -- it "Test 2a" $ findOpen bs 10 `shouldBe` Just 1 - -- it "Test 2b" $ findOpen bs 3 `shouldBe` Just 2 - -- it "Test 3a" $ enclose bs 2 `shouldBe` Just 1 - -- it "Test 3b" $ enclose bs 7 `shouldBe` Just 4 - -- it "firstChild 1" $ firstChild bs 1 `shouldBe` Just 2 - -- it "firstChild 4" $ firstChild bs 4 `shouldBe` Just 5 - -- it "nextSibling 2" $ nextSibling bs 2 `shouldBe` Just 4 - -- it "nextSibling 5" $ nextSibling bs 5 `shouldBe` Just 7 - -- it "parent 2" $ parent bs 2 `shouldBe` Just 1 - -- it "parent 5" $ parent bs 5 `shouldBe` Just 4 - -- it "depth 1" $ depth bs 1 `shouldBe` Just 1 - -- it "depth 2" $ depth bs 2 `shouldBe` Just 2 - -- it "depth 3" $ depth bs 3 `shouldBe` Just 2 - -- it "depth 4" $ depth bs 4 `shouldBe` Just 2 - -- it "depth 5" $ depth bs 5 `shouldBe` Just 3 - -- it "depth 6" $ depth bs 6 `shouldBe` Just 3 - -- it "depth 7" $ depth bs 7 `shouldBe` Just 3 - -- it "depth 8" $ depth bs 8 `shouldBe` Just 3 - -- it "depth 9" $ depth bs 9 `shouldBe` Just 2 - -- it "depth 10" $ depth bs 10 `shouldBe` Just 1 - -- it "subtreeSize 1" $ subtreeSize bs 1 `shouldBe` Just 5 - -- it "subtreeSize 2" $ subtreeSize bs 2 `shouldBe` Just 1 - -- it "subtreeSize 3" $ subtreeSize bs 3 `shouldBe` Just 0 - -- it "subtreeSize 4" $ subtreeSize bs 4 `shouldBe` Just 3 - -- it "subtreeSize 5" $ subtreeSize bs 5 `shouldBe` Just 1 - -- it "subtreeSize 6" $ subtreeSize bs 6 `shouldBe` Just 0 - -- it "subtreeSize 7" $ subtreeSize bs 7 `shouldBe` Just 1 - -- it "subtreeSize 8" $ subtreeSize bs 8 `shouldBe` Just 0 - -- it "subtreeSize 9" $ subtreeSize bs 9 `shouldBe` Just 0 - -- it "subtreeSize 10" $ subtreeSize bs 10 `shouldBe` Just 0 - -- describe "Does not suffer exceptions" $ do - -- it "when calling nextSibling from valid locations" $ do - -- forAll (vectorSizedBetween 1 64) $ \(ShowVector v) -> do - -- [nextSibling v p | p <- [1..bitLength v]] `shouldBe` [nextSibling v p | p <- [1..bitLength v]] - it "Broadword findClose should behave the same as Naive findClose" $ do - property $ \(w :: Word64) -> - forAll (choose (1, 64 :: Count)) $ \p -> - findClose w p == findClose (Broadword w) p diff --git a/test/HaskellWorks/Data/Succinct/BalancedParens/RangeMinMax2Spec.hs b/test/HaskellWorks/Data/Succinct/BalancedParens/RangeMinMax2Spec.hs deleted file mode 100644 --- a/test/HaskellWorks/Data/Succinct/BalancedParens/RangeMinMax2Spec.hs +++ /dev/null @@ -1,152 +0,0 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} - -module HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax2Spec where - -import qualified Data.Vector.Storable as DVS -import Data.Word --- import HaskellWorks.Data.Bits.BitLength -import HaskellWorks.Data.Bits.BitShow --- import HaskellWorks.Data.Bits.FromBitTextByteString --- import HaskellWorks.Data.Succinct.BalancedParens --- import HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax --- import HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax2 -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 (DVS.fromList xs) - -maxVectorSize :: Int -maxVectorSize = 16384 -{-# INLINE maxVectorSize #-} - -spec :: Spec -spec = describe "HaskellWorks.Data.Succinct.BalancedParens.RangeMinMaxSpec2" $ do - it "Skip tests" $ do - True `shouldBe` True - -- it "For a simple bit string can find close" $ do - -- let v = fromBitTextByteString "11101111 10100101 01111110 10110010 10111011 10111011 00011111 11011100" :: DVS.Vector Word64 - -- let !rmm = mkRangeMinMax v - -- findClose rmm 61 `shouldBe` findClose v 61 - -- it "findClose should return the same result" $ do - -- forAll (vectorSizedBetween 1 4) $ \(ShowVector v) -> do - -- let !rmm = mkRangeMinMax v - -- let len = bitLength v - -- [findClose rmm i | i <- [1..len]] `shouldBe `[findClose v i | i <- [1..len]] - -- it "findClose should return the same result over all counts" $ do - -- forAll (vectorSizedBetween 1 maxVectorSize) $ \(ShowVector v) -> do - -- forAll (choose (1, bitLength v)) $ \p -> do - -- let !rmm = mkRangeMinMax v - -- findClose rmm p `shouldBe` findClose v p - -- it "nextSibling should return the same result" $ do - -- forAll (vectorSizedBetween 1 maxVectorSize) $ \(ShowVector v) -> do - -- let !rmm = mkRangeMinMax v - -- nextSibling rmm 0 `shouldBe` nextSibling v 0 - -- it "nextSibling should return the same result over all counts" $ do - -- forAll (vectorSizedBetween 1 maxVectorSize) $ \(ShowVector v) -> do - -- forAll (choose (1, bitLength v)) $ \p -> do - -- let !rmm = mkRangeMinMax v - -- nextSibling rmm p `shouldBe` nextSibling v p - -- it "Pass" $ do - -- True `shouldBe` True - -- it "rangeMinMaxBP should match" $ do - -- forAll (vectorSizedBetween 1 maxVectorSize) $ \(ShowVector v) -> do - -- let !rmm1 = mkRangeMinMax v - -- let !rmm2 = mkRangeMinMax2 v - -- rangeMinMax2BP rmm2 `shouldBe` rangeMinMaxBP rmm1 - -- it "rangeMinMaxL0Excess should match" $ do - -- forAll (vectorSizedBetween 1 maxVectorSize) $ \(ShowVector v) -> do - -- let !rmm1 = mkRangeMinMax v - -- let !rmm2 = mkRangeMinMax2 v - -- rangeMinMax2L0Excess rmm2 `shouldBe` rangeMinMaxL0Excess rmm1 - -- it "rangeMinMaxL0Min should match" $ do - -- forAll (vectorSizedBetween 1 maxVectorSize) $ \(ShowVector v) -> do - -- let !rmm1 = mkRangeMinMax v - -- let !rmm2 = mkRangeMinMax2 v - -- rangeMinMax2L0Min rmm2 `shouldBe` rangeMinMaxL0Min rmm1 - -- it "rangeMinMaxL0Max should match" $ do - -- forAll (vectorSizedBetween 1 maxVectorSize) $ \(ShowVector v) -> do - -- let !rmm1 = mkRangeMinMax v - -- let !rmm2 = mkRangeMinMax2 v - -- rangeMinMax2L0Max rmm2 `shouldBe` rangeMinMaxL0Max rmm1 - -- it "rangeMinMaxL1Min should match" $ do - -- forAll (vectorSizedBetween 1 maxVectorSize) $ \(ShowVector v) -> do - -- let !rmm1 = mkRangeMinMax v - -- let !rmm2 = mkRangeMinMax2 v - -- rangeMinMax2L1Min rmm2 `shouldBe` rangeMinMaxL1Min rmm1 - -- it "rangeMinMaxL1Max should match" $ do - -- forAll (vectorSizedBetween 1 maxVectorSize) $ \(ShowVector v) -> do - -- let !rmm1 = mkRangeMinMax v - -- let !rmm2 = mkRangeMinMax2 v - -- rangeMinMax2L1Max rmm2 `shouldBe` rangeMinMaxL1Max rmm1 - -- it "rangeMinMaxL1Excess should match" $ do - -- forAll (vectorSizedBetween 1 maxVectorSize) $ \(ShowVector v) -> do - -- let !rmm1 = mkRangeMinMax v - -- let !rmm2 = mkRangeMinMax2 v - -- rangeMinMax2L1Excess rmm2 `shouldBe` rangeMinMaxL1Excess rmm1 - -- it "rangeMinMaxL2Min should match" $ do - -- forAll (vectorSizedBetween 1 maxVectorSize) $ \(ShowVector v) -> do - -- let !rmm1 = mkRangeMinMax v - -- let !rmm2 = mkRangeMinMax2 v - -- rangeMinMax2L2Min rmm2 `shouldBe` rangeMinMaxL2Min rmm1 - -- it "rangeMinMaxL2Max should match" $ do - -- forAll (vectorSizedBetween 1 maxVectorSize) $ \(ShowVector v) -> do - -- let !rmm1 = mkRangeMinMax v - -- let !rmm2 = mkRangeMinMax2 v - -- rangeMinMax2L2Max rmm2 `shouldBe` rangeMinMaxL2Max rmm1 - -- it "rangeMinMaxL2Excess should match" $ do - -- forAll (vectorSizedBetween 1 maxVectorSize) $ \(ShowVector v) -> do - -- let !rmm1 = mkRangeMinMax v - -- let !rmm2 = mkRangeMinMax2 v - -- rangeMinMax2L2Excess rmm2 `shouldBe` rangeMinMaxL2Excess rmm1 - -- describe "For example long bit string" $ do - -- let v = fromBitTextByteString " \ - -- \ 01101101 01111100 10011111 01100101 11111100 01101111 00000000 00000000 10001010 11000000 01000010 01010010 01001101 01000101 00000000 00000000 \ - -- \ " :: DVS.Vector Word64 - -- let !rmm1 = mkRangeMinMax v - -- let !rmm2 = mkRangeMinMax2 v - -- it "l0 max matches" $ do - -- rangeMinMax2L0Max rmm2 `shouldBe` rangeMinMaxL0Max rmm1 - -- it "l1 max matches" $ do - -- rangeMinMax2L1Max rmm2 `shouldBe` rangeMinMaxL1Max rmm1 - -- it "l2 max matches" $ do - -- rangeMinMax2L2Max rmm2 `shouldBe` rangeMinMaxL2Max rmm1 - -- it "l0 min matches" $ do - -- rangeMinMax2L0Min rmm2 `shouldBe` rangeMinMaxL0Min rmm1 - -- it "l1 min matches" $ do - -- rangeMinMax2L1Min rmm2 `shouldBe` rangeMinMaxL1Min rmm1 - -- it "l2 min matches" $ do - -- putStrLn $ "--> data: " ++ show (BitShown (DVS.take 80 v)) - -- putStrLn $ "--> rangeMinMaxAL0Min: " ++ show (DVS.take 80 (rangeMinMaxL0Min rmm1)) - -- putStrLn $ "--> rangeMinMaxAL0Max: " ++ show (DVS.take 80 (rangeMinMaxL0Max rmm1)) - -- putStrLn $ "--> rangeMinMaxAL0Excess: " ++ show (DVS.take 80 (rangeMinMaxL0Excess rmm1)) - -- putStrLn $ "--> rangeMinMaxBL0Min: " ++ show (DVS.take 80 (rangeMinMax2L0Min rmm2)) - -- putStrLn $ "--> rangeMinMaxBL0Max: " ++ show (DVS.take 80 (rangeMinMax2L0Max rmm2)) - -- putStrLn $ "--> rangeMinMaxBL0Excess: " ++ show (DVS.take 80 (rangeMinMax2L0Excess rmm2)) - -- putStrLn $ "--> rangeMinMaxAL1Min: " ++ show (DVS.take 80 (rangeMinMaxL1Min rmm1)) - -- putStrLn $ "--> rangeMinMaxAL1Max: " ++ show (DVS.take 80 (rangeMinMaxL1Max rmm1)) - -- putStrLn $ "--> rangeMinMaxAL1Excess: " ++ show (DVS.take 80 (rangeMinMaxL1Excess rmm1)) - -- putStrLn $ "--> rangeMinMaxBL1Min: " ++ show (DVS.take 80 (rangeMinMax2L1Min rmm2)) - -- putStrLn $ "--> rangeMinMaxBL1Max: " ++ show (DVS.take 80 (rangeMinMax2L1Max rmm2)) - -- putStrLn $ "--> rangeMinMaxBL1Excess: " ++ show (DVS.take 80 (rangeMinMax2L1Excess rmm2)) - -- putStrLn $ "--> rangeMinMaxAL2Min: " ++ show (DVS.take 80 (rangeMinMaxL2Min rmm1)) - -- putStrLn $ "--> rangeMinMaxAL2Max: " ++ show (DVS.take 80 (rangeMinMaxL2Max rmm1)) - -- putStrLn $ "--> rangeMinMaxAL2Excess: " ++ show (DVS.take 80 (rangeMinMaxL2Excess rmm1)) - -- putStrLn $ "--> rangeMinMaxBL2Min: " ++ show (DVS.take 80 (rangeMinMax2L2Min rmm2)) - -- putStrLn $ "--> rangeMinMaxBL2Max: " ++ show (DVS.take 80 (rangeMinMax2L2Max rmm2)) - -- putStrLn $ "--> rangeMinMaxBL2Excess: " ++ show (DVS.take 80 (rangeMinMax2L2Excess rmm2)) - -- rangeMinMax2L2Min rmm2 `shouldBe` rangeMinMaxL2Min rmm1 diff --git a/test/HaskellWorks/Data/Succinct/BalancedParens/RangeMinMaxSpec.hs b/test/HaskellWorks/Data/Succinct/BalancedParens/RangeMinMaxSpec.hs deleted file mode 100644 --- a/test/HaskellWorks/Data/Succinct/BalancedParens/RangeMinMaxSpec.hs +++ /dev/null @@ -1,62 +0,0 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} - -module HaskellWorks.Data.Succinct.BalancedParens.RangeMinMaxSpec where - -import qualified Data.Vector.Storable as DVS -import Data.Word --- import HaskellWorks.Data.Bits.BitLength -import HaskellWorks.Data.Bits.BitShow --- import HaskellWorks.Data.Bits.FromBitTextByteString --- import HaskellWorks.Data.Succinct.BalancedParens --- import HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax -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 (DVS.fromList xs) - -factor :: Int -factor = 16384 -{-# INLINE factor #-} - -spec :: Spec -spec = describe "HaskellWorks.Data.Succinct.BalancedParens.RangeMinMaxSpec" $ do - it "Skip tests" $ do - True `shouldBe` True - -- it "For a simple bit string can find close" $ do - -- let v = fromBitTextByteString "11101111 10100101 01111110 10110010 10111011 10111011 00011111 11011100" :: DVS.Vector Word64 - -- let !rmm = mkRangeMinMax v - -- findClose rmm 61 `shouldBe` findClose v 61 - -- it "findClose should return the same result" $ do - -- forAll (vectorSizedBetween 1 4) $ \(ShowVector v) -> do - -- let !rmm = mkRangeMinMax v - -- let len = bitLength v - -- [findClose rmm i | i <- [1..len]] `shouldBe `[findClose v i | i <- [1..len]] - -- it "findClose should return the same result over all counts" $ do - -- forAll (vectorSizedBetween 1 factor) $ \(ShowVector v) -> do - -- forAll (choose (1, bitLength v)) $ \p -> do - -- let !rmm = mkRangeMinMax v - -- findClose rmm p `shouldBe` findClose v p - -- it "nextSibling should return the same result" $ do - -- forAll (vectorSizedBetween 1 factor) $ \(ShowVector v) -> do - -- let !rmm = mkRangeMinMax v - -- nextSibling rmm 0 `shouldBe` nextSibling v 0 - -- it "nextSibling should return the same result over all counts" $ do - -- forAll (vectorSizedBetween 1 factor) $ \(ShowVector v) -> do - -- forAll (choose (1, bitLength v)) $ \p -> do - -- let !rmm = mkRangeMinMax v - -- nextSibling rmm p `shouldBe` nextSibling v p diff --git a/test/HaskellWorks/Data/Succinct/BalancedParens/SimpleSpec.hs b/test/HaskellWorks/Data/Succinct/BalancedParens/SimpleSpec.hs deleted file mode 100644 --- a/test/HaskellWorks/Data/Succinct/BalancedParens/SimpleSpec.hs +++ /dev/null @@ -1,135 +0,0 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE ScopedTypeVariables #-} - -module HaskellWorks.Data.Succinct.BalancedParens.SimpleSpec where - -import Data.Maybe -import qualified Data.Vector.Storable as DVS -import Data.Word -import HaskellWorks.Data.Bits.BitLength -import HaskellWorks.Data.Bits.BitRead -import HaskellWorks.Data.Bits.BitShow -import HaskellWorks.Data.Succinct.BalancedParens -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 (DVS.fromList xs) - -spec :: Spec -spec = describe "HaskellWorks.Data.Succinct.BalancedParens.SimpleSpec" $ do - describe "For (()(()())) 1101101000" $ do - let bs = SimpleBalancedParens (91 :: Word64) - it "Test 1a" $ findClose bs 1 `shouldBe` Just 10 - it "Test 1b" $ findClose bs 2 `shouldBe` Just 3 - it "Test 1b" $ findClose bs 3 `shouldBe` Just 3 - it "Test 1b" $ findClose bs 4 `shouldBe` Just 9 - it "Test 1b" $ findClose bs 5 `shouldBe` Just 6 - it "Test 1b" $ findClose bs 6 `shouldBe` Just 6 - it "Test 1b" $ findClose bs 7 `shouldBe` Just 8 - it "Test 1b" $ findClose bs 8 `shouldBe` Just 8 - it "Test 1b" $ findClose bs 9 `shouldBe` Just 9 - it "Test 1b" $ findClose bs 10 `shouldBe` Just 10 - it "Test 2a" $ findOpen bs 10 `shouldBe` Just 1 - it "Test 2b" $ findOpen bs 3 `shouldBe` Just 2 - it "Test 3a" $ enclose bs 2 `shouldBe` Just 1 - it "Test 3b" $ enclose bs 7 `shouldBe` Just 4 - describe "For (()(()())) 1101101000" $ do - let bs = SimpleBalancedParens (fromJust (bitRead "1101101000") :: [Bool]) - it "Test 1a" $ findClose bs 1 `shouldBe` Just 10 - it "Test 1b" $ findClose bs 2 `shouldBe` Just 3 - it "Test 1b" $ findClose bs 3 `shouldBe` Just 3 - it "Test 1b" $ findClose bs 4 `shouldBe` Just 9 - it "Test 1b" $ findClose bs 5 `shouldBe` Just 6 - it "Test 1b" $ findClose bs 6 `shouldBe` Just 6 - it "Test 1b" $ findClose bs 7 `shouldBe` Just 8 - it "Test 1b" $ findClose bs 8 `shouldBe` Just 8 - it "Test 1b" $ findClose bs 9 `shouldBe` Just 9 - it "Test 1b" $ findClose bs 10 `shouldBe` Just 10 - it "Test 2a" $ findOpen bs 10 `shouldBe` Just 1 - it "Test 2b" $ findOpen bs 3 `shouldBe` Just 2 - it "Test 3a" $ enclose bs 2 `shouldBe` Just 1 - it "Test 3b" $ enclose bs 7 `shouldBe` Just 4 - it "firstChild 1" $ firstChild bs 1 `shouldBe` Just 2 - it "firstChild 4" $ firstChild bs 4 `shouldBe` Just 5 - it "nextSibling 2" $ nextSibling bs 2 `shouldBe` Just 4 - it "nextSibling 5" $ nextSibling bs 5 `shouldBe` Just 7 - it "parent 2" $ parent bs 2 `shouldBe` Just 1 - it "parent 5" $ parent bs 5 `shouldBe` Just 4 - it "depth 1" $ depth bs 1 `shouldBe` Just 1 - it "depth 2" $ depth bs 2 `shouldBe` Just 2 - it "depth 3" $ depth bs 3 `shouldBe` Just 2 - it "depth 4" $ depth bs 4 `shouldBe` Just 2 - it "depth 5" $ depth bs 5 `shouldBe` Just 3 - it "depth 6" $ depth bs 6 `shouldBe` Just 3 - it "depth 7" $ depth bs 7 `shouldBe` Just 3 - it "depth 8" $ depth bs 8 `shouldBe` Just 3 - it "depth 9" $ depth bs 9 `shouldBe` Just 2 - it "depth 10" $ depth bs 10 `shouldBe` Just 1 - it "subtreeSize 1" $ subtreeSize bs 1 `shouldBe` Just 5 - it "subtreeSize 2" $ subtreeSize bs 2 `shouldBe` Just 1 - it "subtreeSize 3" $ subtreeSize bs 3 `shouldBe` Just 0 - it "subtreeSize 4" $ subtreeSize bs 4 `shouldBe` Just 3 - it "subtreeSize 5" $ subtreeSize bs 5 `shouldBe` Just 1 - it "subtreeSize 6" $ subtreeSize bs 6 `shouldBe` Just 0 - it "subtreeSize 7" $ subtreeSize bs 7 `shouldBe` Just 1 - it "subtreeSize 8" $ subtreeSize bs 8 `shouldBe` Just 0 - it "subtreeSize 9" $ subtreeSize bs 9 `shouldBe` Just 0 - it "subtreeSize 10" $ subtreeSize bs 10 `shouldBe` Just 0 - describe "For (()(()())) 11011010 00000000 :: DVS.Vector Word8" $ do - let bs = SimpleBalancedParens (fromJust (bitRead "11011010 00000000") :: DVS.Vector Word8) - it "Test 1a" $ findClose bs 1 `shouldBe` Just 10 - it "Test 1b" $ findClose bs 2 `shouldBe` Just 3 - it "Test 1b" $ findClose bs 3 `shouldBe` Just 3 - it "Test 1b" $ findClose bs 4 `shouldBe` Just 9 - it "Test 1b" $ findClose bs 5 `shouldBe` Just 6 - it "Test 1b" $ findClose bs 6 `shouldBe` Just 6 - it "Test 1b" $ findClose bs 7 `shouldBe` Just 8 - it "Test 1b" $ findClose bs 8 `shouldBe` Just 8 - it "Test 1b" $ findClose bs 9 `shouldBe` Just 9 - it "Test 1b" $ findClose bs 10 `shouldBe` Just 10 - it "Test 2a" $ findOpen bs 10 `shouldBe` Just 1 - it "Test 2b" $ findOpen bs 3 `shouldBe` Just 2 - it "Test 3a" $ enclose bs 2 `shouldBe` Just 1 - it "Test 3b" $ enclose bs 7 `shouldBe` Just 4 - it "firstChild 1" $ firstChild bs 1 `shouldBe` Just 2 - it "firstChild 4" $ firstChild bs 4 `shouldBe` Just 5 - it "nextSibling 2" $ nextSibling bs 2 `shouldBe` Just 4 - it "nextSibling 5" $ nextSibling bs 5 `shouldBe` Just 7 - it "parent 2" $ parent bs 2 `shouldBe` Just 1 - it "parent 5" $ parent bs 5 `shouldBe` Just 4 - it "depth 1" $ depth bs 1 `shouldBe` Just 1 - it "depth 2" $ depth bs 2 `shouldBe` Just 2 - it "depth 3" $ depth bs 3 `shouldBe` Just 2 - it "depth 4" $ depth bs 4 `shouldBe` Just 2 - it "depth 5" $ depth bs 5 `shouldBe` Just 3 - it "depth 6" $ depth bs 6 `shouldBe` Just 3 - it "depth 7" $ depth bs 7 `shouldBe` Just 3 - it "depth 8" $ depth bs 8 `shouldBe` Just 3 - it "depth 9" $ depth bs 9 `shouldBe` Just 2 - it "depth 10" $ depth bs 10 `shouldBe` Just 1 - it "subtreeSize 1" $ subtreeSize bs 1 `shouldBe` Just 5 - it "subtreeSize 2" $ subtreeSize bs 2 `shouldBe` Just 1 - it "subtreeSize 3" $ subtreeSize bs 3 `shouldBe` Just 0 - it "subtreeSize 4" $ subtreeSize bs 4 `shouldBe` Just 3 - it "subtreeSize 5" $ subtreeSize bs 5 `shouldBe` Just 1 - it "subtreeSize 6" $ subtreeSize bs 6 `shouldBe` Just 0 - it "subtreeSize 7" $ subtreeSize bs 7 `shouldBe` Just 1 - it "subtreeSize 8" $ subtreeSize bs 8 `shouldBe` Just 0 - it "subtreeSize 9" $ subtreeSize bs 9 `shouldBe` Just 0 - it "subtreeSize 10" $ subtreeSize bs 10 `shouldBe` Just 0 - describe "Does not suffer exceptions" $ do - it "when calling nextSibling from valid locations" $ do - forAll (vectorSizedBetween 1 64) $ \(ShowVector v) -> do - [nextSibling v p | p <- [1..bitLength v]] `shouldBe` [nextSibling v p | p <- [1..bitLength v]] diff --git a/test/HaskellWorks/Data/Succinct/EliasFano64Spec.hs b/test/HaskellWorks/Data/Succinct/EliasFano64Spec.hs deleted file mode 100644 --- a/test/HaskellWorks/Data/Succinct/EliasFano64Spec.hs +++ /dev/null @@ -1,15 +0,0 @@ -{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} -{-# LANGUAGE ScopedTypeVariables #-} - -module HaskellWorks.Data.Succinct.EliasFano64Spec (spec) where - -import Data.Word -import HaskellWorks.Data.Succinct.EliasFano64 -import Test.Hspec - -{-# ANN module ("HLint: Ignore Redundant do" :: String) #-} - -spec :: Spec -spec = describe "HaskellWorks.Data.Succinct.EliasFano64Spec" $ do - it "Empty" $ - fromEliasFano64 (toEliasFano64 ([] :: [Word64])) `shouldBe` ([] :: [Word64]) diff --git a/test/HaskellWorks/Data/Succinct/RankSelect/Binary/BasicGen.hs b/test/HaskellWorks/Data/Succinct/RankSelect/Binary/BasicGen.hs deleted file mode 100644 --- a/test/HaskellWorks/Data/Succinct/RankSelect/Binary/BasicGen.hs +++ /dev/null @@ -1,120 +0,0 @@ -{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} -{-# LANGUAGE ScopedTypeVariables #-} - -module HaskellWorks.Data.Succinct.RankSelect.Binary.BasicGen - ( genBinaryRankSelectSpec - , genBinaryRank0Select0Spec - , genBinaryRank1Select1Spec - ) where - -import Data.Maybe -import Data.Typeable -import Data.Word -import HaskellWorks.Data.Bits.BitRead -import HaskellWorks.Data.RankSelect.Base.Rank0 -import HaskellWorks.Data.RankSelect.Base.Rank1 -import HaskellWorks.Data.RankSelect.Base.Select0 -import HaskellWorks.Data.RankSelect.Base.Select1 -import Test.Hspec - -{-# 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 - let bs = fromJust (bitRead "10010010") :: s - fmap (rank0 bs) [0..8] `shouldBe` [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 - 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 - 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] - -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 - let bs = fromJust (bitRead "10010010") :: s - fmap (rank1 bs) [0..8] `shouldBe` [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 - 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 - 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] - -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 - let bs = fromJust $ bitRead "10010010" :: Word8 - fmap (select0 bs) [0..5] `shouldBe` [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 - 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] - -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] - -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 - let bs = fromJust $ bitRead "10010010" :: s - fmap (select1 bs) [0..3] `shouldBe` [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 - 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 - let bs = fromJust $ bitRead "01000000 00000100" :: s - fmap (select1 bs) [0..2] `shouldBe` [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 - let bs = fromJust $ bitRead "10000010 00000000 00100000 00010000" :: s - fmap (select1 bs) [0..4] `shouldBe` [0, 1, 7, 19, 28] - -genBinaryRank1Select1Spec :: forall s. (Typeable s, BitRead s, Rank1 s, Select1 s) => s -> Spec -genBinaryRank1Select1Spec s = describe "For Rank 1" $ do - genRank1UpTo8Spec s - genRank1UpTo16Spec 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 deleted file mode 100644 --- a/test/HaskellWorks/Data/Succinct/RankSelect/Binary/CsPoppy2Spec.hs +++ /dev/null @@ -1,94 +0,0 @@ -{-# 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.AtIndex -import HaskellWorks.Data.Bits.BitRead -import HaskellWorks.Data.Bits.BitShow -import HaskellWorks.Data.Bits.PopCount.PopCount1 -import HaskellWorks.Data.RankSelect.Base.Rank1 -import HaskellWorks.Data.RankSelect.Base.Select1 -import HaskellWorks.Data.Succinct.RankSelect.Binary.BasicGen -import HaskellWorks.Data.Succinct.RankSelect.Binary.CsPoppy2 -import Prelude hiding (length) -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, length 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, length 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, length 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 deleted file mode 100644 --- a/test/HaskellWorks/Data/Succinct/RankSelect/Binary/CsPoppySpec.hs +++ /dev/null @@ -1,94 +0,0 @@ -{-# 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.AtIndex -import HaskellWorks.Data.Bits.BitRead -import HaskellWorks.Data.Bits.BitShow -import HaskellWorks.Data.Bits.PopCount.PopCount1 -import HaskellWorks.Data.RankSelect.Base.Rank1 -import HaskellWorks.Data.RankSelect.Base.Select1 -import HaskellWorks.Data.Succinct.RankSelect.Binary.BasicGen -import HaskellWorks.Data.Succinct.RankSelect.Binary.CsPoppy -import Prelude hiding (length) -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, length 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, length 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, length 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 deleted file mode 100644 --- a/test/HaskellWorks/Data/Succinct/RankSelect/Binary/Poppy512SSpec.hs +++ /dev/null @@ -1,94 +0,0 @@ -{-# 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.AtIndex -import HaskellWorks.Data.Bits.BitRead -import HaskellWorks.Data.Bits.BitShow -import HaskellWorks.Data.Bits.PopCount.PopCount1 -import HaskellWorks.Data.RankSelect.Base.Rank1 -import HaskellWorks.Data.RankSelect.Base.Select1 -import HaskellWorks.Data.Succinct.RankSelect.Binary.BasicGen -import HaskellWorks.Data.Succinct.RankSelect.Binary.Poppy512S -import Prelude hiding (length) -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, length 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, length 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, length 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 deleted file mode 100644 --- a/test/HaskellWorks/Data/Succinct/RankSelect/Binary/Poppy512Spec.hs +++ /dev/null @@ -1,143 +0,0 @@ -{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE ScopedTypeVariables #-} - -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.AtIndex -import HaskellWorks.Data.Bits.BitRead -import HaskellWorks.Data.Bits.BitShow -import HaskellWorks.Data.Bits.PopCount.PopCount0 -import HaskellWorks.Data.Bits.PopCount.PopCount1 -import HaskellWorks.Data.RankSelect.Base.Rank0 -import HaskellWorks.Data.RankSelect.Base.Rank1 -import HaskellWorks.Data.RankSelect.Base.Select0 -import HaskellWorks.Data.RankSelect.Base.Select1 -import HaskellWorks.Data.Succinct.RankSelect.Binary.BasicGen -import HaskellWorks.Data.Succinct.RankSelect.Binary.Poppy512 -import Prelude hiding (length) -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.Poppy512.Rank1Spec" $ do - genBinaryRankSelectSpec (undefined :: Poppy512) - describe "rank1 for Vector Word64 is equivalent to rank1 for Poppy512" $ do - it "on empty bitvector" $ - let v = DVS.empty in - let w = makePoppy512 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, length v * 8)) $ \i -> - let w = makePoppy512 v in - rank1 v i === rank1 w i - it "on two basic blocks" $ - forAll (vectorSizedBetween 9 16) $ \(ShowVector v) -> - forAll (choose (0, length v * 8)) $ \i -> - let w = makePoppy512 v in - rank1 v i === rank1 w i - it "on three basic blocks" $ - forAll (vectorSizedBetween 17 24) $ \(ShowVector v) -> - forAll (choose (0, length v * 8)) $ \i -> - let w = makePoppy512 v in - rank1 v i === rank1 w i - describe "rank0 for Vector Word64 is equivalent to rank0 for Poppy512" $ do - it "on empty bitvector" $ - let v = DVS.empty in - let w = makePoppy512 v in - let i = 0 in - rank0 v i === rank0 w i - it "on one basic block" $ - forAll (vectorSizedBetween 1 8) $ \(ShowVector v) -> - forAll (choose (0, length v * 8)) $ \i -> - let w = makePoppy512 v in - rank0 v i === rank0 w i - it "on two basic blocks" $ - forAll (vectorSizedBetween 9 16) $ \(ShowVector v) -> - forAll (choose (0, length v * 8)) $ \i -> - let w = makePoppy512 v in - rank0 v i === rank0 w i - it "on three basic blocks" $ - forAll (vectorSizedBetween 17 24) $ \(ShowVector v) -> - forAll (choose (0, length v * 8)) $ \i -> - let w = makePoppy512 v in - rank0 v i === rank0 w i - describe "select0 for Vector Word64 is equivalent to select0 for Poppy512" $ do - it "on empty bitvector" $ - let v = DVS.empty in - let w = makePoppy512 v in - let i = 0 in - select0 v i === select0 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 = makePoppy512 v in - select0 v 0 === select0 w 0 - it "on one basic block" $ - forAll (vectorSizedBetween 1 8) $ \(ShowVector v) -> - forAll (choose (0, popCount0 v)) $ \i -> - let w = makePoppy512 v in - select0 v i === select0 w i - it "on two basic blocks" $ - forAll (vectorSizedBetween 9 16) $ \(ShowVector v) -> - forAll (choose (0, popCount0 v)) $ \i -> - let w = makePoppy512 v in - select0 v i === select0 w i - it "on three basic blocks" $ - forAll (vectorSizedBetween 17 24) $ \(ShowVector v) -> - forAll (choose (0, popCount0 v)) $ \i -> - let w = makePoppy512 v in - select0 v i === select0 w i - describe "select1 for Vector Word64 is equivalent to select1 for Poppy512" $ do - it "on empty bitvector" $ - let v = DVS.empty in - let w = makePoppy512 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 = makePoppy512 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 = makePoppy512 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 = makePoppy512 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 = 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] diff --git a/test/HaskellWorks/Data/Succinct/RankSelect/InternalSpec.hs b/test/HaskellWorks/Data/Succinct/RankSelect/InternalSpec.hs deleted file mode 100644 --- a/test/HaskellWorks/Data/Succinct/RankSelect/InternalSpec.hs +++ /dev/null @@ -1,35 +0,0 @@ -{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} -{-# LANGUAGE ScopedTypeVariables #-} - -module HaskellWorks.Data.Succinct.RankSelect.InternalSpec (spec) where - -import HaskellWorks.Data.Bits.BitRead -import HaskellWorks.Data.Bits.PopCount.PopCount1 -import HaskellWorks.Data.Positioning -import HaskellWorks.Data.RankSelect.Base.Rank -import HaskellWorks.Data.RankSelect.Base.Select -import Test.Hspec -import Test.QuickCheck - -{-# ANN module ("HLint: ignore Redundant do" :: String) #-} -{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-} - -spec :: Spec -spec = describe "HaskellWorks.Data.Succinct.RankSelect.InternalSpec" $ do - describe "For [Bool]" $ do - it "rank True 10010010 over [0..8] should be 011122233" $ - let (Just bs) = bitRead "10010010" :: Maybe [Bool] in - fmap (rank True bs) [0..8] `shouldBe` [0, 1, 1, 1, 2, 2, 2, 3, 3] - it "rank True 10010010 over [0..8] should be 001223445" $ - let (Just bs) = bitRead "10010010" :: Maybe [Bool] in - fmap (rank False bs) [0..8] `shouldBe` [0, 0, 1, 2, 2, 3, 4, 4, 5] - it "select True 10010010 over [0..3] should be 0147" $ - let (Just bs) = bitRead "10010010" :: Maybe [Bool] in - fmap (select True bs) [0..3] `shouldBe` [0, 1, 4, 7] - it "select False 10010010 over [0..5] should be 023568" $ - let (Just bs) = bitRead "10010010" :: Maybe [Bool] in - fmap (select False bs) [0..5] `shouldBe` [0, 2, 3, 5, 6, 8] - it "Rank and select form a galois connection" $ - property $ \(bs :: [Bool]) -> - forAll (choose (0, popCount1 bs)) $ \(c :: Count) -> - rank True bs (select True bs c) == c diff --git a/test/HaskellWorks/Data/Succinct/SimpleSpec.hs b/test/HaskellWorks/Data/Succinct/SimpleSpec.hs deleted file mode 100644 --- a/test/HaskellWorks/Data/Succinct/SimpleSpec.hs +++ /dev/null @@ -1,52 +0,0 @@ -{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} -{-# LANGUAGE ScopedTypeVariables #-} - -module HaskellWorks.Data.Succinct.SimpleSpec (spec) where - -import Data.Vector -import Data.Word -import HaskellWorks.Data.Bits.BitShown -import HaskellWorks.Data.Bits.BitWise -import HaskellWorks.Data.Positioning -import HaskellWorks.Data.RankSelect.Base.Rank1 -import Test.Hspec -import Test.QuickCheck - -{-# ANN module ("HLint: ignore Redundant do" :: String) #-} - -spec :: Spec -spec = describe "HaskellWorks.Data.SuccinctSpec" $ do - it "rank1 for BitShown (Vector Word8) and BitShown (Vector Word64) should give same answer" $ - forAll (choose (0, 64)) $ \(i :: Count) (a :: Word8) (b :: Word8) (c :: Word8) (d :: Word8) - (e :: Word8) (f :: Word8) (g :: Word8) (h :: Word8) -> - let a64 = fromIntegral a :: Word64 in - let b64 = fromIntegral b :: Word64 in - let c64 = fromIntegral c :: Word64 in - let d64 = fromIntegral d :: Word64 in - let e64 = fromIntegral e :: Word64 in - let f64 = fromIntegral f :: Word64 in - let g64 = fromIntegral g :: Word64 in - let h64 = fromIntegral h :: Word64 in - let abcdefgh64 = (h64 .<. 56) .|. (g64 .<. 48) .|. (f64 .<. 40) .|. (e64 .<. 32) .|. - (d64 .<. 24) .|. (c64 .<. 16) .|. (b64 .<. 8 ) .|. a64 in - let vec16 = BitShown (fromList [a, b, c, d, e, f, g, h] :: Vector Word8 ) in - let vec64 = BitShown (fromList [abcdefgh64] :: Vector Word64) in - rank1 vec16 i == rank1 vec64 i - it "rank1 for BitShown (Vector Word16) and BitShown (Vector Word64) should give same answer" $ - forAll (choose (0, 64)) $ \(i :: Count) (a :: Word16) (b :: Word16) (c :: Word16) (d :: Word16) -> - let a64 = fromIntegral a :: Word64 in - let b64 = fromIntegral b :: Word64 in - let c64 = fromIntegral c :: Word64 in - let d64 = fromIntegral d :: Word64 in - let abcd64 = (d64 .<. 48) .|. (c64 .<. 32) .|. (b64 .<. 16) .|. a64 in - let vec16 = BitShown (fromList [a, b, c, d] :: Vector Word16) in - let vec64 = BitShown (fromList [abcd64] :: Vector Word64) in - rank1 vec16 i == rank1 vec64 i - it "rank1 for BitShown (Vector Word32) and BitShown (Vector Word64) should give same answer" $ - forAll (choose (0, 64)) $ \(i :: Count) (a :: Word32) (b :: Word32) -> - let a64 = fromIntegral a :: Word64 in - let b64 = fromIntegral b :: Word64 in - let ab64 = (b64 .<. 32) .|. a64 in - let vec32 = BitShown (fromList [a, b] :: Vector Word32) in - let vec64 = BitShown (fromList [ab64] :: Vector Word64) in - rank1 vec32 i == rank1 vec64 i