packages feed

hw-rankselect (empty) → 0.0.0.1

raw patch · 29 files changed

+1974/−0 lines, 29 filesdep +QuickCheckdep +arraydep +attoparsecsetup-changed

Dependencies added: QuickCheck, array, attoparsec, base, bytestring, conduit, criterion, deepseq, ghc-prim, hspec, hw-bits, hw-diagnostics, hw-prim, hw-rankselect, lens, mmap, mono-traversable, parsec, random, resourcet, safe, text, transformers, vector, word8

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright John Ky (c) 2016++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Author name here nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,4 @@+# hw-rankselect+[![v0.0-branch](https://circleci.com/gh/haskell-works/hw-rankselect/tree/v0.0-branch.svg?style=svg)](https://circleci.com/gh/haskell-works/hw-rankselect/tree/v0.0-branch)++Rank and select operations.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,4 @@+module Main where++main :: IO ()+main = putStrLn "Hello world"
+ bench/Main.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE BangPatterns        #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Main where++import           Criterion.Main+import qualified Data.ByteString                                     as BS+import qualified Data.ByteString.Internal                            as BSI+import qualified Data.Vector.Storable                                as DVS+import           Data.Word+import           Foreign+import           HaskellWorks.Data.Positioning+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic+import           System.IO.MMap++setupEnvBs :: Int -> IO BS.ByteString+setupEnvBs n = return $ BS.pack (take n (cycle [maxBound, 0]))++setupEnvBss :: Int -> Int -> IO [BS.ByteString]+setupEnvBss n k = setupEnvBs n >>= \v -> return (replicate k v)++setupEnvVector :: Int -> IO (DVS.Vector Word64)+setupEnvVector n = return $ DVS.fromList (take n (cycle [maxBound, 0]))++setupEnvVectors :: Int -> Int -> IO [DVS.Vector Word64]+setupEnvVectors n k = setupEnvVector n >>= \v -> return (replicate k v)++setupEnvJson :: FilePath -> IO BS.ByteString+setupEnvJson filepath = do+  (fptr :: ForeignPtr Word8, offset, size) <- mmapFileForeignPtr filepath ReadOnly Nothing+  let !bs = BSI.fromForeignPtr (castForeignPtr fptr) offset size+  return bs++benchRankSelect :: [Benchmark]+benchRankSelect =+  [ 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 (getCount . rank1  bv)) [0, 1000..10000000])+    ]+  ]++main :: IO ()+main = defaultMain benchRankSelect
+ hw-rankselect.cabal view
@@ -0,0 +1,121 @@+name:                   hw-rankselect+version:                0.0.0.1+synopsis:               Conduits for tokenizing streams.+description:            Please see README.md+homepage:               http://github.com/haskell-works/hw-rankselect#readme+license:                BSD3+license-file:           LICENSE+author:                 John Ky+maintainer:             newhoggy@gmail.com+copyright:              2016 John Ky+category:               Data, Conduit+build-type:             Simple+extra-source-files:     README.md+cabal-version:          >= 1.10++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+                      , bytestring+                      , conduit+                      , criterion+                      , hw-bits+                      , hw-diagnostics+                      , hw-prim+                      , hw-rankselect+                      , mmap+                      , resourcet+                      , vector+  default-language:     Haskell2010++library+  hs-source-dirs:       src+  exposed-modules:      HaskellWorks.Data.Succinct.BalancedParens+                      , HaskellWorks.Data.Succinct.BalancedParens.Internal+                      , HaskellWorks.Data.Succinct.BalancedParens.Simple+                      , HaskellWorks.Data.Succinct.NearestNeighbour+                      , HaskellWorks.Data.Succinct.RankSelect+                      , HaskellWorks.Data.Succinct.RankSelect.Binary+                      , HaskellWorks.Data.Succinct.RankSelect.Binary.Basic+                      , HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank0+                      , HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1+                      , HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select0+                      , HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1+                      , HaskellWorks.Data.Succinct.RankSelect.Binary.Poppy512+                      , HaskellWorks.Data.Succinct.RankSelect.Internal+  build-depends:        base                            >= 4.7  && < 5+                      , array+                      , attoparsec                      >= 0.10+                      , bytestring+                      , conduit                         >= 1.1  && < 1.3+                      , deepseq                         <  1.5+                      , ghc-prim+                      , hw-bits+                      , hw-prim+                      , lens+                      , mmap+                      , mono-traversable+                      , parsec+                      , QuickCheck+                      , random+                      , resourcet                       >= 1.1+                      , safe+                      , text+                      , vector+                      , word8++  default-language:     Haskell2010+  ghc-options:          -rtsopts -with-rtsopts=-N -Wall -O2 -Wall -msse4.2++test-suite hw-rankselect-test+  type:                 exitcode-stdio-1.0+  hs-source-dirs:       test+  main-is:              Spec.hs+  other-modules:        HaskellWorks.Data.Succinct.BalancedParensSpec+                      , HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank0Spec+                      , HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1Spec+                      , HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select0Spec+                      , HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1Spec+                      , HaskellWorks.Data.Succinct.RankSelect.Binary.BasicGen+                      , HaskellWorks.Data.Succinct.RankSelect.Binary.Poppy512Spec+                      , HaskellWorks.Data.Succinct.RankSelect.InternalSpec+                      , HaskellWorks.Data.Succinct.SimpleSpec+  build-depends:        base+                      , attoparsec                      >= 0.10+                      , bytestring+                      , conduit                         >= 1.1  && < 1.3+                      , hspec                           >= 1.3+                      , hw-bits+                      , hw-prim+                      , hw-rankselect+                      , mmap+                      , parsec+                      , QuickCheck+                      , resourcet                       >= 1.1+                      , transformers+                      , vector+  ghc-options:          -threaded -rtsopts -with-rtsopts=-N -Wall+  default-language:     Haskell2010++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+                      , hw-prim+                      , hw-rankselect+                      , mmap+                      , resourcet+                      , vector
+ src/HaskellWorks/Data/Succinct/BalancedParens.hs view
@@ -0,0 +1,6 @@+module HaskellWorks.Data.Succinct.BalancedParens+  ( module X+  ) where++import HaskellWorks.Data.Succinct.BalancedParens.Internal as X+import HaskellWorks.Data.Succinct.BalancedParens.Simple as X
+ src/HaskellWorks/Data/Succinct/BalancedParens/Internal.hs view
@@ -0,0 +1,32 @@+module HaskellWorks.Data.Succinct.BalancedParens.Internal+  ( BalancedParens(..)+  , firstChild+  , nextSibling+  , parent+  , depth+  , subtreeSize+  ) where++import           HaskellWorks.Data.Positioning+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank0+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1++class BalancedParens v where+  findOpen :: v -> Count -> Count+  findClose :: v -> Count -> Count+  enclose :: v -> Count -> Count++firstChild :: v -> Count -> Count+firstChild _ = (+ 1)++nextSibling :: BalancedParens v => v -> Count -> Count+nextSibling v p = findClose v p + 1++parent :: BalancedParens v => v -> Count -> Count+parent = enclose++depth :: (BalancedParens v, Rank0 v, Rank1 v) => v -> Count -> Count+depth v p = let q = findOpen v p in rank1 v q - rank0 v q++subtreeSize :: BalancedParens v => v -> Count -> Count+subtreeSize v p = (findClose v p - p + 1) `quot` 2
+ src/HaskellWorks/Data/Succinct/BalancedParens/Simple.hs view
@@ -0,0 +1,138 @@+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module HaskellWorks.Data.Succinct.BalancedParens.Simple+  ( SimpleBalancedParens(..)+  , closeAt+  , findOpen+  , findClose+  , findClose'+  , openAt+  ) 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.BitWise+import           HaskellWorks.Data.Positioning+import           HaskellWorks.Data.Succinct.BalancedParens.Internal+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank0+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select0+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1+import           Prelude                                                    as P++newtype SimpleBalancedParens a = SimpleBalancedParens a+  deriving (BitLength, Eq, BitShow, TestBit, Rank0, Rank1, Select0, Select1)++instance Functor SimpleBalancedParens where+  fmap f (SimpleBalancedParens a) = SimpleBalancedParens (f a)+  {-# INLINABLE fmap   #-}++instance BitShow a => Show (SimpleBalancedParens a) where+  show = bitShow++closeAt :: TestBit a => a -> Count -> Bool+closeAt v c = not (v .?. toPosition (c - 1))+{-# INLINABLE closeAt #-}++openAt :: TestBit a => a -> Count -> Bool+openAt v c = v .?. toPosition (c - 1)+{-# INLINABLE openAt #-}++require :: Bool -> String -> a -> a+require p msg v = if p then v else error msg+{-# INLINABLE require #-}++findOpen' :: (BitLength a, TestBit a) => Count -> SimpleBalancedParens a -> Count -> Count+findOpen' c v p =+  require (0 < p && p <= bitLength v) "Out of bounds" $+  if v `openAt` p+    then if c == 0+      then p+      else findOpen' (c - 1) v (p - 1)+    else findOpen' (c + 1) v (p - 1)+{-# INLINABLE findOpen' #-}++findClose' :: (BitLength a, TestBit a) => Count -> SimpleBalancedParens a -> Count -> Count+findClose' c v p =+  require (1 < p && p <= bitLength v) "Out of bounds" $+  if v `closeAt` p+    then if c == 0+      then p+      else findClose' (c + 1) v (p + 1)+    else findClose' (c - 1) v (p + 1)+{-# INLINABLE findClose' #-}++instance BalancedParens (SimpleBalancedParens [Bool]) where+  findOpen  v p = if v `openAt`  p then p else findOpen'  (Count 0) v (p - 1)+  findClose v p = if v `closeAt` p then p else findClose' (Count 0) v (p + 1)+  enclose       = findOpen' (Count 1)+  {-# INLINABLE findOpen  #-}+  {-# INLINABLE findClose #-}+  {-# INLINABLE enclose   #-}++instance BalancedParens (SimpleBalancedParens (DVS.Vector Word8)) where+  findOpen  v p = if v `openAt`  p then p else findOpen'  (Count 0) v (p - 1)+  findClose v p = if v `closeAt` p then p else findClose' (Count 0) v (p + 1)+  enclose       = findOpen' (Count 1)+  {-# INLINABLE findOpen  #-}+  {-# INLINABLE findClose #-}+  {-# INLINABLE enclose   #-}++instance BalancedParens (SimpleBalancedParens (DVS.Vector Word16)) where+  findOpen  v p = if v `openAt`  p then p else findOpen'  (Count 0) v (p - 1)+  findClose v p = if v `closeAt` p then p else findClose' (Count 0) v (p + 1)+  enclose       = findOpen' (Count 1)+  {-# INLINABLE findOpen  #-}+  {-# INLINABLE findClose #-}+  {-# INLINABLE enclose   #-}++instance BalancedParens (SimpleBalancedParens (DVS.Vector Word32)) where+  findOpen  v p = if v `openAt`  p then p else findOpen'  (Count 0) v (p - 1)+  findClose v p = if v `closeAt` p then p else findClose' (Count 0) v (p + 1)+  enclose       = findOpen' (Count 1)+  {-# INLINABLE findOpen  #-}+  {-# INLINABLE findClose #-}+  {-# INLINABLE enclose   #-}++instance BalancedParens (SimpleBalancedParens (DVS.Vector Word64)) where+  findOpen  v p = if v `openAt`  p then p else findOpen'  (Count 0) v (p - 1)+  findClose v p = if v `closeAt` p then p else findClose' (Count 0) v (p + 1)+  enclose       = findOpen' (Count 1)+  {-# INLINABLE findOpen  #-}+  {-# INLINABLE findClose #-}+  {-# INLINABLE enclose   #-}++instance BalancedParens (SimpleBalancedParens Word8) where+  findOpen  v p = if v `openAt`  p then p else findOpen'  (Count 0) v (p - 1)+  findClose v p = if v `closeAt` p then p else findClose' (Count 0) v (p + 1)+  enclose       = findOpen' (Count 1)+  {-# INLINABLE findOpen  #-}+  {-# INLINABLE findClose #-}+  {-# INLINABLE enclose   #-}++instance BalancedParens (SimpleBalancedParens Word16) where+  findOpen  v p = if v `openAt`  p then p else findOpen'  (Count 0) v (p - 1)+  findClose v p = if v `closeAt` p then p else findClose' (Count 0) v (p + 1)+  enclose       = findOpen' (Count 1)+  {-# INLINABLE findOpen  #-}+  {-# INLINABLE findClose #-}+  {-# INLINABLE enclose   #-}++instance BalancedParens (SimpleBalancedParens Word32) where+  findOpen  v p = if v `openAt`  p then p else findOpen'  (Count 0) v (p - 1)+  findClose v p = if v `closeAt` p then p else findClose' (Count 0) v (p + 1)+  enclose       = findOpen' (Count 1)+  {-# INLINABLE findOpen  #-}+  {-# INLINABLE findClose #-}+  {-# INLINABLE enclose   #-}++instance BalancedParens (SimpleBalancedParens Word64) where+  findOpen  v p = if v `openAt`  p then p else findOpen'  (Count 0) v (p - 1)+  findClose v p = if v `closeAt` p then p else findClose' (Count 0) v (p + 1)+  enclose       = findOpen' (Count 1)+  {-# INLINABLE findOpen  #-}+  {-# INLINABLE findClose #-}+  {-# INLINABLE enclose   #-}
+ src/HaskellWorks/Data/Succinct/NearestNeighbour.hs view
@@ -0,0 +1,14 @@+module HaskellWorks.Data.Succinct.NearestNeighbour+  ( bitPred+  , bitSucc+  ) where++import           HaskellWorks.Data.Positioning+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.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)
+ src/HaskellWorks/Data/Succinct/RankSelect.hs view
@@ -0,0 +1,5 @@+module HaskellWorks.Data.Succinct.RankSelect+  ( module X+  ) where++import           HaskellWorks.Data.Succinct.RankSelect.Internal as X
+ src/HaskellWorks/Data/Succinct/RankSelect/Binary.hs view
@@ -0,0 +1,5 @@+module HaskellWorks.Data.Succinct.RankSelect.Binary+  ( module X+  ) where++import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic as X
+ src/HaskellWorks/Data/Succinct/RankSelect/Binary/Basic.hs view
@@ -0,0 +1,9 @@++module HaskellWorks.Data.Succinct.RankSelect.Binary.Basic+    ( module X+    ) where++import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank0   as X+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1   as X+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select0 as X+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1 as X
+ src/HaskellWorks/Data/Succinct/RankSelect/Binary/Basic/Rank0.hs view
@@ -0,0 +1,133 @@+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE StandaloneDeriving         #-}++module HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank0+    ( Rank0(..)+    ) where++import qualified Data.Vector                                              as DV+import qualified Data.Vector.Storable                                     as DVS+import           Data.Word+import           HaskellWorks.Data.Bits.BitShown+import           HaskellWorks.Data.Bits.ElemFixedBitSize+import           HaskellWorks.Data.Bits.PopCount.PopCount0+import           HaskellWorks.Data.Positioning+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1 as X+import           HaskellWorks.Data.Vector.VectorLike+import           Prelude                                                  as P++{-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}++class Rank0 v where+  rank0 :: v -> Count -> Count++deriving instance Rank0 a => Rank0 (BitShown a)++instance Rank0 Word8 where+  rank0 v s0 = s0 - rank1 v s0+  {-# INLINABLE rank0 #-}++instance Rank0 Word16 where+  rank0 v s0 = s0 - rank1 v s0+  {-# INLINABLE rank0 #-}++instance Rank0 Word32 where+  rank0 v s0 = s0 - rank1 v s0+  {-# INLINABLE rank0 #-}++instance Rank0 Word64 where+  rank0 v s0 = s0 - rank1 v s0+  {-# INLINABLE rank0 #-}++instance Rank0 [Bool] where+  rank0 = go 0+    where go r _ 0 = r+          go r (False:bs) p = go (r + 1) bs (p - 1)+          go r (True:bs) p  = go  r      bs (p - 1)+          go _ [] _         = error "Out of range"+  {-# INLINABLE rank0 #-}++instance Rank0 [Word8] where+  rank0 v p = popCount0 prefix + if r == 0 then 0 else (`rank0` r) maybeElem+    where (q, r)    = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)+          prefix    = take (fromIntegral q) v+          maybeElem = v !! fromIntegral q+  {-# INLINABLE rank0 #-}++instance Rank0 [Word16] where+  rank0 v p = popCount0 prefix + if r == 0 then 0 else (`rank0` r) maybeElem+    where (q, r)    = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)+          prefix    = take (fromIntegral q) v+          maybeElem = v !! fromIntegral q+  {-# INLINABLE rank0 #-}++instance Rank0 [Word32] where+  rank0 v p = popCount0 prefix + if r == 0 then 0 else (`rank0` r) maybeElem+    where (q, r)    = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)+          prefix    = take (fromIntegral q) v+          maybeElem = v !! fromIntegral q+  {-# INLINABLE rank0 #-}++instance Rank0 [Word64] where+  rank0 v p = popCount0 prefix + if r == 0 then 0 else (`rank0` r) maybeElem+    where (q, r)    = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)+          prefix    = take (fromIntegral q) v+          maybeElem = v !! fromIntegral q+  {-# INLINABLE rank0 #-}++instance Rank0 (DV.Vector Word8) where+  rank0 v p = popCount0 prefix + if r == 0 then 0 else (`rank0` r) maybeElem+    where (q, r)    = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)+          prefix    = DV.take (fromIntegral q) v+          maybeElem = v !!! fromIntegral q+  {-# INLINABLE rank0 #-}++instance Rank0 (DV.Vector Word16) where+  rank0 v p = popCount0 prefix + if r == 0 then 0 else (`rank0` r) maybeElem+    where (q, r)    = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)+          prefix    = DV.take (fromIntegral q) v+          maybeElem = v !!! fromIntegral q+  {-# INLINABLE rank0 #-}++instance Rank0 (DV.Vector Word32) where+  rank0 v p = popCount0 prefix + if r == 0 then 0 else (`rank0` r) maybeElem+    where (q, r)    = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)+          prefix    = DV.take (fromIntegral q) v+          maybeElem = v !!! fromIntegral q+  {-# INLINABLE rank0 #-}++instance Rank0 (DV.Vector Word64) where+  rank0 v p = popCount0 prefix + if r == 0 then 0 else (`rank0` r) maybeElem+    where (q, r)    = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)+          prefix    = DV.take (fromIntegral q) v+          maybeElem = v !!! fromIntegral q+  {-# INLINABLE rank0 #-}++instance Rank0 (DVS.Vector Word8) where+  rank0 v p = popCount0 prefix + if r == 0 then 0 else (`rank0` r) maybeElem+    where (q, r)    = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)+          prefix    = DVS.take (fromIntegral q) v+          maybeElem = v !!! fromIntegral q+  {-# INLINABLE rank0 #-}++instance Rank0 (DVS.Vector Word16) where+  rank0 v p = popCount0 prefix + if r == 0 then 0 else (`rank0` r) maybeElem+    where (q, r)    = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)+          prefix    = DVS.take (fromIntegral q) v+          maybeElem = v !!! fromIntegral q+  {-# INLINABLE rank0 #-}++instance Rank0 (DVS.Vector Word32) where+  rank0 v p = popCount0 prefix + if r == 0 then 0 else (`rank0` r) maybeElem+    where (q, r)    = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)+          prefix    = DVS.take (fromIntegral q) v+          maybeElem = v !!! fromIntegral q+  {-# INLINABLE rank0 #-}++instance Rank0 (DVS.Vector Word64) where+  rank0 v p = popCount0 prefix + if r == 0 then 0 else (`rank0` r) maybeElem+    where (q, r)    = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)+          prefix    = DVS.take (fromIntegral q) v+          maybeElem = v !!! fromIntegral q+  {-# INLINABLE rank0 #-}
+ src/HaskellWorks/Data/Succinct/RankSelect/Binary/Basic/Rank1.hs view
@@ -0,0 +1,169 @@+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE StandaloneDeriving         #-}++module HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1+    ( Rank1(..)+    ) where++import qualified Data.Vector                               as DV+import qualified Data.Vector.Storable                      as DVS+import           Data.Word+import           HaskellWorks.Data.Bits.BitShown+import           HaskellWorks.Data.Bits.BitWise+import           HaskellWorks.Data.Bits.ElemFixedBitSize+import           HaskellWorks.Data.Bits.PopCount.PopCount1+import           HaskellWorks.Data.Positioning+import           HaskellWorks.Data.Vector.VectorLike+import           Prelude                                   as P++{-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}++class Rank1 v where+  rank1 :: v -> Count -> Count++deriving instance Rank1 a => Rank1 (BitShown a)++instance Rank1 Word8 where+  rank1 _ 0  = 0+  rank1 v s0 =+    -- Shift out bits after given position.+    let r0 = v .<. (8 - s0) in+    -- Count set bits in parallel.+    let r1 = (r0 .&. 0x55) + ((r0 .>. 1) .&. 0x55)  in+    let r2 = (r1 .&. 0x33) + ((r1 .>. 2) .&. 0x33)  in+    let r3 = (r2 .&. 0x0f) + ((r2 .>. 4) .&. 0x0f)  in+    let r4 = r3 `mod` 255                           in+    Count $ fromIntegral r4+  {-# INLINABLE rank1 #-}++instance Rank1 Word16 where+  rank1 _ 0  = 0+  rank1 v s0 =+    -- Shift out bits after given position.+    let r0 = v .<. (16 - s0) in+    -- Count set bits in parallel.+    let r1 = (r0 .&. 0x5555) + ((r0 .>. 1) .&. 0x5555)  in+    let r2 = (r1 .&. 0x3333) + ((r1 .>. 2) .&. 0x3333)  in+    let r3 = (r2 .&. 0x0f0f) + ((r2 .>. 4) .&. 0x0f0f)  in+    let r4 = r3 `mod` 255                               in+    Count $ fromIntegral r4+  {-# INLINABLE rank1 #-}++instance Rank1 Word32 where+  rank1 _ 0  = 0+  rank1 v s0 =+    -- Shift out bits after given position.+    let r0 = v .<. (32 - s0) in+    -- Count set bits in parallel.+    let r1 = (r0 .&. 0x55555555) + ((r0 .>. 1) .&. 0x55555555)  in+    let r2 = (r1 .&. 0x33333333) + ((r1 .>. 2) .&. 0x33333333)  in+    let r3 = (r2 .&. 0x0f0f0f0f) + ((r2 .>. 4) .&. 0x0f0f0f0f)  in+    let r4 = r3 `mod` 255                                       in+    Count $ fromIntegral r4+  {-# INLINABLE rank1 #-}++instance Rank1 Word64 where+  rank1 _ 0  = 0+  rank1 v s0 =+    -- Shift out bits after given position.+    let r0 = v .<. (64 - s0) in+    -- Count set bits in parallel.+    let r1 = (r0 .&. 0x5555555555555555) + ((r0 .>. 1) .&. 0x5555555555555555)  in+    let r2 = (r1 .&. 0x3333333333333333) + ((r1 .>. 2) .&. 0x3333333333333333)  in+    let r3 = (r2 .&. 0x0f0f0f0f0f0f0f0f) + ((r2 .>. 4) .&. 0x0f0f0f0f0f0f0f0f)  in+    let r4 = r3 `mod` 255                                                       in+    Count $ fromIntegral r4+  {-# INLINABLE rank1 #-}++instance Rank1 [Bool] where+  rank1 = go 0+    where go r _ 0 = r+          go r (True :bs) p = go (r + 1) bs (p - 1)+          go r (False:bs) p = go  r      bs (p - 1)+          go _ [] _         = error "Out of range"+  {-# INLINABLE rank1 #-}++instance Rank1 [Word8] where+  rank1 v p = popCount1 prefix + if r == 0 then 0 else (`rank1` r) maybeElem+    where (q, r)    = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)+          prefix    = take (fromIntegral q) v+          maybeElem = v !! fromIntegral q+  {-# INLINABLE rank1 #-}++instance Rank1 [Word16] where+  rank1 v p = popCount1 prefix + if r == 0 then 0 else (`rank1` r) maybeElem+    where (q, r)    = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)+          prefix    = take (fromIntegral q) v+          maybeElem = v !! fromIntegral q+  {-# INLINABLE rank1 #-}++instance Rank1 [Word32] where+  rank1 v p = popCount1 prefix + if r == 0 then 0 else (`rank1` r) maybeElem+    where (q, r)    = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)+          prefix    = take (fromIntegral q) v+          maybeElem = v !! fromIntegral q+  {-# INLINABLE rank1 #-}++instance Rank1 [Word64] where+  rank1 v p = popCount1 prefix + if r == 0 then 0 else (`rank1` r) maybeElem+    where (q, r)    = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)+          prefix    = take (fromIntegral q) v+          maybeElem = v !! fromIntegral q+  {-# INLINABLE rank1 #-}++instance Rank1 (DV.Vector Word8) where+  rank1 v p = popCount1 prefix + if r == 0 then 0 else (`rank1` r) maybeElem+    where (q, r)    = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)+          prefix    = DV.take (fromIntegral q) v+          maybeElem = v !!! fromIntegral q+  {-# INLINABLE rank1 #-}++instance Rank1 (DV.Vector Word16) where+  rank1 v p = popCount1 prefix + if r == 0 then 0 else (`rank1` r) maybeElem+    where (q, r)    = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)+          prefix    = DV.take (fromIntegral q) v+          maybeElem = v !!! fromIntegral q+  {-# INLINABLE rank1 #-}++instance Rank1 (DV.Vector Word32) where+  rank1 v p = popCount1 prefix + if r == 0 then 0 else (`rank1` r) maybeElem+    where (q, r)    = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)+          prefix    = DV.take (fromIntegral q) v+          maybeElem = v !!! fromIntegral q+  {-# INLINABLE rank1 #-}++instance Rank1 (DV.Vector Word64) where+  rank1 v p = popCount1 prefix + if r == 0 then 0 else (`rank1` r) maybeElem+    where (q, r)    = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)+          prefix    = DV.take (fromIntegral q) v+          maybeElem = v !!! fromIntegral q+  {-# INLINABLE rank1 #-}++instance Rank1 (DVS.Vector Word8) where+  rank1 v p = popCount1 prefix + if r == 0 then 0 else (`rank1` r) maybeElem+    where (q, r)    = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)+          prefix    = DVS.take (fromIntegral q) v+          maybeElem = v !!! fromIntegral q+  {-# INLINABLE rank1 #-}++instance Rank1 (DVS.Vector Word16) where+  rank1 v p = popCount1 prefix + if r == 0 then 0 else (`rank1` r) maybeElem+    where (q, r)    = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)+          prefix    = DVS.take (fromIntegral q) v+          maybeElem = v !!! fromIntegral q+  {-# INLINABLE rank1 #-}++instance Rank1 (DVS.Vector Word32) where+  rank1 v p = popCount1 prefix + if r == 0 then 0 else (`rank1` r) maybeElem+    where (q, r)    = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)+          prefix    = DVS.take (fromIntegral q) v+          maybeElem = v !!! fromIntegral q+  {-# INLINABLE rank1 #-}++instance Rank1 (DVS.Vector Word64) where+  rank1 v p = popCount1 prefix + if r == 0 then 0 else (`rank1` r) maybeElem+    where (q, r)    = if p < 1 then (0, 0) else ((p - 1) `quot` elemFixedBitSize v, ((p - 1) `rem` elemFixedBitSize v) + 1)+          prefix    = DVS.take (fromIntegral q) v+          maybeElem = v !!! fromIntegral q+  {-# INLINABLE rank1 #-}
+ src/HaskellWorks/Data/Succinct/RankSelect/Binary/Basic/Select0.hs view
@@ -0,0 +1,162 @@+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE StandaloneDeriving         #-}++module HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select0+    ( Select0(..)+    ) where++import qualified Data.Vector                                                as DV+import qualified Data.Vector.Storable                                       as DVS+import           Data.Word+import           HaskellWorks.Data.Bits.BitShown+import           HaskellWorks.Data.Bits.BitWise+import           HaskellWorks.Data.Bits.ElemFixedBitSize+import           HaskellWorks.Data.Bits.PopCount.PopCount0+import           HaskellWorks.Data.Positioning+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1+import           HaskellWorks.Data.Vector.VectorLike++{-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}++class Select0 v where+  select0 :: v -> Count -> Count++deriving instance Select0 a => Select0 (BitShown a)++-- TODO: Implement NOT in terms of select for word-16+instance Select0 Word8 where+  select0 v = select1 (comp v)+  {-# INLINABLE select0 #-}++instance Select0 Word16 where+  select0 v = select1 (comp v)+  {-# INLINABLE select0 #-}++instance Select0 Word32 where+  select0 v = select1 (comp v)+  {-# INLINABLE select0 #-}++instance Select0 Word64 where+  select0 v = select1 (comp v)+  {-# INLINABLE select0 #-}++instance Select0 [Bool] where+  select0 = go 0+    where go r _ 0 = r+          go r (False:bs) c = go (r + 1) bs (c - 1)+          go r (True:bs)  c = go (r + 1) bs  c+          go _ []         _ = error "Out of range"+  {-# INLINABLE select0 #-}++instance Select0 [Word8] where+  select0 v c = go v c 0+    where go :: [Word8] -> Count -> Count -> Count+          go _ 0  acc = acc+          go u d acc = let w = head u in+            case popCount0 w of+              pc | d <= pc  -> select0 w d + acc+              pc            -> go (tail u) (d - pc) (acc + elemFixedBitSize u)+  {-# INLINABLE select0 #-}++instance Select0 [Word16] where+  select0 v c = go v c 0+    where go :: [Word16] -> Count -> Count -> Count+          go _ 0  acc = acc+          go u d acc = let w = head u in+            case popCount0 w of+              pc | d <= pc  -> select0 w d + acc+              pc            -> go (tail u) (d - pc) (acc + elemFixedBitSize u)+  {-# INLINABLE select0 #-}++instance Select0 [Word32] where+  select0 v c = go v c 0+    where go :: [Word32] -> Count -> Count -> Count+          go _ 0  acc = acc+          go u d acc = let w = head u in+            case popCount0 w of+              pc | d <= pc  -> select0 w d + acc+              pc            -> go (tail u) (d - pc) (acc + elemFixedBitSize u)+  {-# INLINABLE select0 #-}++instance Select0 [Word64] where+  select0 v c = go v c 0+    where go :: [Word64] -> Count -> Count -> Count+          go _ 0  acc = acc+          go u d acc = let w = head u in+            case popCount0 w of+              pc | d <= pc  -> select0 w d + acc+              pc            -> go (tail u) (d - pc) (acc + elemFixedBitSize u)+  {-# INLINABLE select0 #-}++instance Select0 (DV.Vector Word8) where+  select0 v c = go 0 c 0+    where go _ 0  acc = acc+          go n d acc = let w = (v !!! n) in+            case popCount0 w of+              pc | d <= pc  -> select0 w d + acc+              pc            -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)+  {-# INLINABLE select0 #-}++instance Select0 (DV.Vector Word16) where+  select0 v c = go 0 c 0+    where go _ 0  acc = acc+          go n d acc = let w = (v !!! n) in+            case popCount0 w of+              pc | d <= pc  -> select0 w d + acc+              pc            -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)+  {-# INLINABLE select0 #-}++instance Select0 (DV.Vector Word32) where+  select0 v c = go 0 c 0+    where go _ 0  acc = acc+          go n d acc = let w = (v !!! n) in+            case popCount0 w of+              pc | d <= pc  -> select0 w d + acc+              pc            -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)+  {-# INLINABLE select0 #-}++instance Select0 (DV.Vector Word64) where+  select0 v c = go 0 c 0+    where go _ 0  acc = acc+          go n d acc = let w = (v !!! n) in+            case popCount0 w of+              pc | d <= pc  -> select0 w d + acc+              pc            -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)+  {-# INLINABLE select0 #-}++instance Select0 (DVS.Vector Word8) where+  select0 v c = go 0 c 0+    where go _ 0  acc = acc+          go n d acc = let w = (v !!! n) in+            case popCount0 w of+              pc | d <= pc  -> select0 w d + acc+              pc            -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)+  {-# INLINABLE select0 #-}++instance Select0 (DVS.Vector Word16) where+  select0 v c = go 0 c 0+    where go _ 0  acc = acc+          go n d acc = let w = (v !!! n) in+            case popCount0 w of+              pc | d <= pc  -> select0 w d + acc+              pc            -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)+  {-# INLINABLE select0 #-}++instance Select0 (DVS.Vector Word32) where+  select0 v c = go 0 c 0+    where go _ 0  acc = acc+          go n d acc = let w = (v !!! n) in+            case popCount0 w of+              pc | d <= pc  -> select0 w d + acc+              pc            -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)+  {-# INLINABLE select0 #-}++instance Select0 (DVS.Vector Word64) where+  select0 v c = go 0 c 0+    where go _ 0  acc = acc+          go n d acc = let w = (v !!! n) in+            case popCount0 w of+              pc | d <= pc  -> select0 w d + acc+              pc            -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)+  {-# INLINABLE select0 #-}
+ src/HaskellWorks/Data/Succinct/RankSelect/Binary/Basic/Select1.hs view
@@ -0,0 +1,252 @@+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE StandaloneDeriving         #-}++module HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1+    ( Select1(..)+    ) where++import qualified Data.Vector                               as DV+import qualified Data.Vector.Storable                      as DVS+import           Data.Word+import           HaskellWorks.Data.Bits.BitShown+import           HaskellWorks.Data.Bits.BitWise+import           HaskellWorks.Data.Bits.ElemFixedBitSize+import           HaskellWorks.Data.Bits.PopCount.PopCount1+import           HaskellWorks.Data.Positioning+import           HaskellWorks.Data.Vector.VectorLike+import           Prelude                                   as P++{-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}++class Select1 v where+  select1 :: v -> Count -> Count++deriving instance Select1 a => Select1 (BitShown a)++-- TODO: Implement NOT interms of select for word-16+instance Select1 Word8 where+  select1 _ 0 = 0+  select1 v p = select1 (fromIntegral v :: Word16) p+  {-# INLINABLE select1 #-}++-- TODO: Remove redundant code to optimise+instance Select1 Word16 where+  select1 _ 0 = 0+  select1 v rn =+    -- Do a normal parallel bit count for a 64-bit integer,+    -- but store all intermediate steps.+    let a = (v .&. 0x5555) + ((v .>.  1) .&. 0x5555)    in+    let b = (a .&. 0x3333) + ((a .>.  2) .&. 0x3333)    in+    let c = (b .&. 0x0f0f) + ((b .>.  4) .&. 0x0f0f)    in+    let d = (c .&. 0x00ff) + ((c .>.  8) .&. 0x00ff)    in+    -- Now do branchless select!+    let r0 = d + 1 - (fromIntegral (getCount rn) :: Word16)                     in+    let s0 = 64 :: Word16                                                       in+    let t0 = (d .>. 32) + (d .>. 48)                                            in+    let s1 = s0 - ((t0 - r0) .&. 256) .>. 3                                     in+    let r1 = r0 - (t0 .&. ((t0 - r0) .>. 8))                                    in+    let t1 =      (d .>. fromIntegral (s1 - 16)) .&. 0xff                       in+    let s2 = s1 - ((t1 - r1) .&. 256) .>. 4                                     in+    let r2 = r1 - (t1 .&. ((t1 - r1) .>. 8))                                    in+    let t2 =      (c .>. fromIntegral (s2 - 8))  .&. 0xf                        in+    let s3 = s2 - ((t2 - r2) .&. 256) .>. 5                                     in+    let r3 = r2 - (t2 .&. ((t2 - r2) .>. 8))                                    in+    let t3 =      (b .>. fromIntegral (s3 - 4))  .&. 0x7                        in+    let s4 = s3 - ((t3 - r3) .&. 256) .>. 6                                     in+    let r4 = r3 - (t3 .&. ((t3 - r3) .>. 8))                                    in+    let t4 =      (a .>. fromIntegral (s4 - 2))  .&. 0x3                        in+    let s5 = s4 - ((t4 - r4) .&. 256) .>. 7                                     in+    let r5 = r4 - (t4 .&. ((t4 - r4) .>. 8))                                    in+    let t5 =      (v .>. fromIntegral (s5 - 1))  .&. 0x1                        in+    let s6 = s5 - ((t5 - r5) .&. 256) .>. 8                                     in+    fromIntegral s6+  {-# INLINABLE select1 #-}++-- TODO: Remove redundant code to optimise+instance Select1 Word32 where+  select1 _ 0 = 0+  select1 v rn =+    -- Do a normal parallel bit count for a 64-bit integer,+    -- but store all intermediate steps.+    let a = (v .&. 0x55555555) + ((v .>.  1) .&. 0x55555555)    in+    let b = (a .&. 0x33333333) + ((a .>.  2) .&. 0x33333333)    in+    let c = (b .&. 0x0f0f0f0f) + ((b .>.  4) .&. 0x0f0f0f0f)    in+    let d = (c .&. 0x00ff00ff) + ((c .>.  8) .&. 0x00ff00ff)    in+    let e = (d .&. 0x000000ff) + ((d .>. 16) .&. 0x000000ff)    in+    -- Now do branchless select!+    let r0 = e + 1 - (fromIntegral (getCount rn) :: Word32)                     in+    let s0 = 64 :: Word32                                                       in+    let t0 = (d .>. 32) + (d .>. 48)                                            in+    let s1 = s0 - ((t0 - r0) .&. 256) .>. 3                                     in+    let r1 = r0 - (t0 .&. ((t0 - r0) .>. 8))                                    in+    let t1 =      (d .>. fromIntegral (s1 - 16)) .&. 0xff                       in+    let s2 = s1 - ((t1 - r1) .&. 256) .>. 4                                     in+    let r2 = r1 - (t1 .&. ((t1 - r1) .>. 8))                                    in+    let t2 =      (c .>. fromIntegral (s2 - 8))  .&. 0xf                        in+    let s3 = s2 - ((t2 - r2) .&. 256) .>. 5                                     in+    let r3 = r2 - (t2 .&. ((t2 - r2) .>. 8))                                    in+    let t3 =      (b .>. fromIntegral (s3 - 4))  .&. 0x7                        in+    let s4 = s3 - ((t3 - r3) .&. 256) .>. 6                                     in+    let r4 = r3 - (t3 .&. ((t3 - r3) .>. 8))                                    in+    let t4 =      (a .>. fromIntegral (s4 - 2))  .&. 0x3                        in+    let s5 = s4 - ((t4 - r4) .&. 256) .>. 7                                     in+    let r5 = r4 - (t4 .&. ((t4 - r4) .>. 8))                                    in+    let t5 =      (v .>. fromIntegral (s5 - 1))  .&. 0x1                        in+    let s6 = s5 - ((t5 - r5) .&. 256) .>. 8                                     in+    fromIntegral s6+  {-# INLINABLE select1 #-}++instance Select1 Word64 where+  select1 _ 0 = 0+  select1 v rn =+    -- Do a normal parallel bit count for a 64-bit integer,+    -- but store all intermediate steps.+    let a = (v .&. 0x5555555555555555) + ((v .>.  1) .&. 0x5555555555555555)    in+    let b = (a .&. 0x3333333333333333) + ((a .>.  2) .&. 0x3333333333333333)    in+    let c = (b .&. 0x0f0f0f0f0f0f0f0f) + ((b .>.  4) .&. 0x0f0f0f0f0f0f0f0f)    in+    let d = (c .&. 0x00ff00ff00ff00ff) + ((c .>.  8) .&. 0x00ff00ff00ff00ff)    in+    let e = (d .&. 0x0000ffff0000ffff) + ((d .>. 16) .&. 0x0000ffff0000ffff)    in+    let f = (e .&. 0x00000000ffffffff) + ((e .>. 32) .&. 0x00000000ffffffff)    in+    -- Now do branchless select!+    let r0 = f + 1 - fromIntegral (getCount rn) :: Word64                       in+    let s0 = 64 :: Word64                                                       in+    let t0 = (d .>. 32) + (d .>. 48)                                            in+    let s1 = s0 - ((t0 - r0) .&. 256) .>. 3                                     in+    let r1 = r0 - (t0 .&. ((t0 - r0) .>. 8))                                    in+    let t1 =      (d .>. fromIntegral (s1 - 16)) .&. 0xff                       in+    let s2 = s1 - ((t1 - r1) .&. 256) .>. 4                                     in+    let r2 = r1 - (t1 .&. ((t1 - r1) .>. 8))                                    in+    let t2 =      (c .>. fromIntegral (s2 - 8))  .&. 0xf                        in+    let s3 = s2 - ((t2 - r2) .&. 256) .>. 5                                     in+    let r3 = r2 - (t2 .&. ((t2 - r2) .>. 8))                                    in+    let t3 =      (b .>. fromIntegral (s3 - 4))  .&. 0x7                        in+    let s4 = s3 - ((t3 - r3) .&. 256) .>. 6                                     in+    let r4 = r3 - (t3 .&. ((t3 - r3) .>. 8))                                    in+    let t4 =      (a .>. fromIntegral (s4 - 2))  .&. 0x3                        in+    let s5 = s4 - ((t4 - r4) .&. 256) .>. 7                                     in+    let r5 = r4 - (t4 .&. ((t4 - r4) .>. 8))                                    in+    let t5 =      (v .>. fromIntegral (s5 - 1))  .&. 0x1                        in+    let s6 = s5 - ((t5 - r5) .&. 256) .>. 8                                     in+    fromIntegral s6+  {-# INLINABLE select1 #-}++instance Select1 [Bool] where+  select1 = go 0+    where go r _ 0 = r+          go r (True :bs) c = go (r + 1) bs (c - 1)+          go r (False:bs) c = go (r + 1) bs  c+          go _ []         _ = error "Out of range"+  {-# INLINABLE select1 #-}++instance Select1 [Word8] where+  select1 v c = go v c 0+    where go :: [Word8] -> Count -> Count -> Count+          go _ 0  acc = acc+          go u d acc = let w = head u in+            case popCount1 w of+              pc | d <= pc  -> select1 w d + acc+              pc            -> go (tail u) (d - pc) (acc + elemFixedBitSize u)+  {-# INLINABLE select1 #-}++instance Select1 [Word16] where+  select1 v c = go v c 0+    where go :: [Word16] -> Count -> Count -> Count+          go _ 0  acc = acc+          go u d acc = let w = head u in+            case popCount1 w of+              pc | d <= pc  -> select1 w d + acc+              pc            -> go (tail u) (d - pc) (acc + elemFixedBitSize u)+  {-# INLINABLE select1 #-}++instance Select1 [Word32] where+  select1 v c = go v c 0+    where go :: [Word32] -> Count -> Count -> Count+          go _ 0  acc = acc+          go u d acc = let w = head u in+            case popCount1 w of+              pc | d <= pc  -> select1 w d + acc+              pc            -> go (tail u) (d - pc) (acc + elemFixedBitSize u)+  {-# INLINABLE select1 #-}++instance Select1 [Word64] where+  select1 v c = go v c 0+    where go :: [Word64] -> Count -> Count -> Count+          go _ 0  acc = acc+          go u d acc = let w = head u in+            case popCount1 w of+              pc | d <= pc  -> select1 w d + acc+              pc            -> go (tail u) (d - pc) (acc + elemFixedBitSize u)+  {-# INLINABLE select1 #-}++instance Select1 (DVS.Vector Word8) where+  select1 v c = go 0 c 0+    where go _ 0  acc = acc+          go n d acc = let w = (v !!! n) in+            case popCount1 w of+              pc | d <= pc  -> select1 w d + acc+              pc            -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)+  {-# INLINABLE select1 #-}++instance Select1 (DVS.Vector Word16) where+  select1 v c = go 0 c 0+    where go _ 0  acc = acc+          go n d acc = let w = (v !!! n) in+            case popCount1 w of+              pc | d <= pc  -> select1 w d + acc+              pc            -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)+  {-# INLINABLE select1 #-}++instance Select1 (DVS.Vector Word32) where+  select1 v c = go 0 c 0+    where go _ 0  acc = acc+          go n d acc = let w = (v !!! n) in+            case popCount1 w of+              pc | d <= pc  -> select1 w d + acc+              pc            -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)+  {-# INLINABLE select1 #-}++instance Select1 (DVS.Vector Word64) where+  select1 v c = go 0 c 0+    where go _ 0  acc = acc+          go n d acc = let w = (v !!! n) in+            case popCount1 w of+              pc | d <= pc  -> select1 w d + acc+              pc            -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)+  {-# INLINABLE select1 #-}++instance Select1 (DV.Vector Word8) where+  select1 v c = go 0 c 0+    where go _ 0  acc = acc+          go n d acc = let w = (v !!! n) in+            case popCount1 w of+              pc | d <= pc  -> select1 w d + acc+              pc            -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)+  {-# INLINABLE select1 #-}++instance Select1 (DV.Vector Word16) where+  select1 v c = go 0 c 0+    where go _ 0  acc = acc+          go n d acc = let w = (v !!! n) in+            case popCount1 w of+              pc | d <= pc  -> select1 w d + acc+              pc            -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)+  {-# INLINABLE select1 #-}++instance Select1 (DV.Vector Word32) where+  select1 v c = go 0 c 0+    where go _ 0  acc = acc+          go n d acc = let w = (v !!! n) in+            case popCount1 w of+              pc | d <= pc  -> select1 w d + acc+              pc            -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)+  {-# INLINABLE select1 #-}++instance Select1 (DV.Vector Word64) where+  select1 v c = go 0 c 0+    where go _ 0  acc = acc+          go n d acc = let w = (v !!! n) in+            case popCount1 w of+              pc | d <= pc  -> select1 w d + acc+              pc            -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)+  {-# INLINABLE select1 #-}
+ src/HaskellWorks/Data/Succinct/RankSelect/Binary/Poppy512.hs view
@@ -0,0 +1,55 @@+module HaskellWorks.Data.Succinct.RankSelect.Binary.Poppy512+    ( Poppy512(..)+    , Rank1(..)+    , makePoppy512+    ) where++import qualified Data.Vector.Storable                                       as DVS+import           Data.Word+import           HaskellWorks.Data.Bits.BitRead+import           HaskellWorks.Data.Bits.PopCount.PopCount1+import           HaskellWorks.Data.Positioning+import           HaskellWorks.Data.Search+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank0+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select0+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1+import           HaskellWorks.Data.Vector.VectorLike++data Poppy512 = Poppy512+  { poppy512Bits  :: DVS.Vector Word64+  , poppy512Index :: DVS.Vector Word64+  } deriving (Eq, Show)++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 getCount (popCount1 (DVS.take 8 (DVS.drop (indexN * 8) v))) + DVS.last u++instance BitRead Poppy512 where+  bitRead = fmap makePoppy512 . bitRead++instance Rank1 Poppy512 where+  rank1 (Poppy512 v i) p =+    Count (i !!! toPosition (p `div` 512)) + rank1 (DVS.drop (fromIntegral p `div` 512) v) (p `mod` 512)++instance Rank0 Poppy512 where+  rank0 (Poppy512 v i) p =+    p `div` 512 * 512 - Count (i !!! toPosition (p `div` 512)) + rank0 (DVS.drop (fromIntegral p `div` 512) v) (p `mod` 512)++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 = Count (i !!! q)+          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 = Count (fromIntegral q * 512 - (i !!! q))+          wordAt o = fromIntegral o * 512 - (i !!! o)
+ src/HaskellWorks/Data/Succinct/RankSelect/Internal.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module HaskellWorks.Data.Succinct.RankSelect.Internal+    ( -- * Rank & Select+      Rank(..)+    , Select(..)+    ) where++import           HaskellWorks.Data.Positioning+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic++class Eq a => Rank v a where+  rank :: a -> v -> Count -> Count++class Eq a => Select v a where+  select :: a -> v -> Count -> Count++instance Rank [Bool] Bool where+  rank a = if a then rank1 else rank0+  {-# INLINABLE rank #-}++instance Select [Bool] Bool where+  select a = if a then select1 else select0+  {-# INLINABLE select #-}
+ test/HaskellWorks/Data/Succinct/BalancedParensSpec.hs view
@@ -0,0 +1,98 @@+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.Succinct.BalancedParensSpec where++import           Data.Maybe+import qualified Data.Vector.Storable                      as DVS+import           Data.Word+import           HaskellWorks.Data.Bits.BitRead+import           HaskellWorks.Data.Succinct.BalancedParens+import           Test.Hspec++{-# ANN module ("HLint: ignore Redundant do"        :: String) #-}+{-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}++spec :: Spec+spec = describe "HaskellWorks.Data.Succinct.BalancedParensSpec" $ do+  describe "For (()(()())) 1101101000" $ do+    let bs = SimpleBalancedParens (91 :: Word64)+    it "Test 1a" $ findClose bs  1 `shouldBe` 10+    it "Test 1b" $ findClose bs  2 `shouldBe`  3+    it "Test 2a" $ findOpen  bs 10 `shouldBe`  1+    it "Test 2b" $ findOpen  bs  3 `shouldBe`  2+    it "Test 3a" $ enclose   bs  2 `shouldBe`  1+    it "Test 3b" $ enclose   bs  7 `shouldBe`  4+  describe "For (()(()())) 1101101000" $ do+    let bs = SimpleBalancedParens (fromJust (bitRead "1101101000") :: [Bool])+    it "Test 1a" $ findClose bs  1 `shouldBe` 10+    it "Test 1b" $ findClose bs  2 `shouldBe`  3+    it "Test 1b" $ findClose bs  3 `shouldBe`  3+    it "Test 1b" $ findClose bs  4 `shouldBe`  9+    it "Test 2a" $ findOpen  bs 10 `shouldBe`  1+    it "Test 2b" $ findOpen  bs  3 `shouldBe`  2+    it "Test 3a" $ enclose   bs  2 `shouldBe`  1+    it "Test 3b" $ enclose   bs  7 `shouldBe`  4+    it "firstChild 1" $ firstChild bs 1 `shouldBe` 2+    it "firstChild 4" $ firstChild bs 4 `shouldBe` 5+    it "nextSibling 2" $ nextSibling bs 2 `shouldBe` 4+    it "nextSibling 5" $ nextSibling bs 5 `shouldBe` 7+    it "parent 2" $ parent bs 2 `shouldBe` 1+    it "parent 5" $ parent bs 5 `shouldBe` 4+    it "depth  1" $ depth bs  1 `shouldBe` 1+    it "depth  2" $ depth bs  2 `shouldBe` 2+    it "depth  3" $ depth bs  3 `shouldBe` 2+    it "depth  4" $ depth bs  4 `shouldBe` 2+    it "depth  5" $ depth bs  5 `shouldBe` 3+    it "depth  6" $ depth bs  6 `shouldBe` 3+    it "depth  7" $ depth bs  7 `shouldBe` 3+    it "depth  8" $ depth bs  8 `shouldBe` 3+    it "depth  9" $ depth bs  9 `shouldBe` 2+    it "depth 10" $ depth bs 10 `shouldBe` 1+    it "subtreeSize  1" $ subtreeSize bs  1 `shouldBe` 5+    it "subtreeSize  2" $ subtreeSize bs  2 `shouldBe` 1+    it "subtreeSize  3" $ subtreeSize bs  3 `shouldBe` 0+    it "subtreeSize  4" $ subtreeSize bs  4 `shouldBe` 3+    it "subtreeSize  5" $ subtreeSize bs  5 `shouldBe` 1+    it "subtreeSize  6" $ subtreeSize bs  6 `shouldBe` 0+    it "subtreeSize  7" $ subtreeSize bs  7 `shouldBe` 1+    it "subtreeSize  8" $ subtreeSize bs  8 `shouldBe` 0+    it "subtreeSize  9" $ subtreeSize bs  9 `shouldBe` 0+    it "subtreeSize 10" $ subtreeSize bs 10 `shouldBe` 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` 10+    it "Test 1b" $ findClose bs  2 `shouldBe`  3+    it "Test 1b" $ findClose bs  3 `shouldBe`  3+    it "Test 1b" $ findClose bs  4 `shouldBe`  9+    it "Test 2a" $ findOpen  bs 10 `shouldBe`  1+    it "Test 2b" $ findOpen  bs  3 `shouldBe`  2+    it "Test 3a" $ enclose   bs  2 `shouldBe`  1+    it "Test 3b" $ enclose   bs  7 `shouldBe`  4+    it "firstChild 1" $ firstChild bs 1 `shouldBe` 2+    it "firstChild 4" $ firstChild bs 4 `shouldBe` 5+    it "nextSibling 2" $ nextSibling bs 2 `shouldBe` 4+    it "nextSibling 5" $ nextSibling bs 5 `shouldBe` 7+    it "parent 2" $ parent bs 2 `shouldBe` 1+    it "parent 5" $ parent bs 5 `shouldBe` 4+    it "depth  1" $ depth bs  1 `shouldBe` 1+    it "depth  2" $ depth bs  2 `shouldBe` 2+    it "depth  3" $ depth bs  3 `shouldBe` 2+    it "depth  4" $ depth bs  4 `shouldBe` 2+    it "depth  5" $ depth bs  5 `shouldBe` 3+    it "depth  6" $ depth bs  6 `shouldBe` 3+    it "depth  7" $ depth bs  7 `shouldBe` 3+    it "depth  8" $ depth bs  8 `shouldBe` 3+    it "depth  9" $ depth bs  9 `shouldBe` 2+    it "depth 10" $ depth bs 10 `shouldBe` 1+    it "subtreeSize  1" $ subtreeSize bs  1 `shouldBe` 5+    it "subtreeSize  2" $ subtreeSize bs  2 `shouldBe` 1+    it "subtreeSize  3" $ subtreeSize bs  3 `shouldBe` 0+    it "subtreeSize  4" $ subtreeSize bs  4 `shouldBe` 3+    it "subtreeSize  5" $ subtreeSize bs  5 `shouldBe` 1+    it "subtreeSize  6" $ subtreeSize bs  6 `shouldBe` 0+    it "subtreeSize  7" $ subtreeSize bs  7 `shouldBe` 1+    it "subtreeSize  8" $ subtreeSize bs  8 `shouldBe` 0+    it "subtreeSize  9" $ subtreeSize bs  9 `shouldBe` 0+    it "subtreeSize 10" $ subtreeSize bs 10 `shouldBe` 0++-- 11011010 00000000, cursorRank = 2
+ test/HaskellWorks/Data/Succinct/RankSelect/Binary/Basic/Rank0Spec.hs view
@@ -0,0 +1,90 @@+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank0Spec+  ( genRank0UpTo8Spec+  , genRank0UpTo16Spec+  , spec+  ) where++import           Data.Maybe+import           Data.Typeable+import qualified Data.Vector                                                as DV+import qualified Data.Vector.Storable                                       as DVS+import           Data.Word+import           HaskellWorks.Data.Bits.BitRead+import           HaskellWorks.Data.Bits.BitWise+import           HaskellWorks.Data.Bits.PopCount.PopCount0+import           HaskellWorks.Data.Positioning+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank0+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select0+import           Test.Hspec+import           Test.QuickCheck++{-# 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]++spec :: Spec+spec = describe "HaskellWorks.Data.Succinct.RankSelect.InternalSpec" $ do+  genRank0UpTo8Spec (undefined :: Word8)+  genRank0UpTo8Spec (undefined :: Word16)+  genRank0UpTo8Spec (undefined :: Word32)+  genRank0UpTo8Spec (undefined :: Word64)+  genRank0UpTo8Spec (undefined :: [Word8])+  genRank0UpTo16Spec (undefined :: [Word8])+  genRank0UpTo8Spec (undefined :: [Word16])+  genRank0UpTo16Spec (undefined :: [Word16])+  genRank0UpTo8Spec (undefined :: [Word32])+  genRank0UpTo16Spec (undefined :: [Word32])+  genRank0UpTo8Spec (undefined :: [Word64])+  genRank0UpTo16Spec (undefined :: [Word64])+  genRank0UpTo8Spec (undefined :: DV.Vector Word8)+  genRank0UpTo16Spec (undefined :: DV.Vector Word8)+  genRank0UpTo8Spec (undefined :: DV.Vector Word16)+  genRank0UpTo16Spec (undefined :: DV.Vector Word16)+  genRank0UpTo8Spec (undefined :: DV.Vector Word32)+  genRank0UpTo16Spec (undefined :: DV.Vector Word32)+  genRank0UpTo8Spec (undefined :: DV.Vector Word64)+  genRank0UpTo16Spec (undefined :: DV.Vector Word64)+  genRank0UpTo8Spec (undefined :: DVS.Vector Word8)+  genRank0UpTo16Spec (undefined :: DVS.Vector Word8)+  genRank0UpTo8Spec (undefined :: DVS.Vector Word16)+  genRank0UpTo16Spec (undefined :: DVS.Vector Word16)+  genRank0UpTo8Spec (undefined :: DVS.Vector Word32)+  genRank0UpTo16Spec (undefined :: DVS.Vector Word32)+  genRank0UpTo8Spec (undefined :: DVS.Vector Word64)+  genRank0UpTo16Spec (undefined :: DVS.Vector Word64)+  describe "Different word sizes give the same rank0" $ do+    it "when comparing Word16 and Word64 over bits 0-7" $+      forAll (choose (0, 8 :: Count)) $ \(i :: Count) (w :: Word8) ->+        rank0 w i == rank0 (fromIntegral w :: Word64) i+    it "when comparing Word16 and Word64 over bits 0-15" $ property $+      forAll (choose (0, 16 :: Count)) $ \(i :: Count) (w :: Word16) ->+        rank0 w i == rank0 (fromIntegral w :: Word64) i+    it "when comparing Word32 and Word64 over bits 0-31" $ property $+      forAll (choose (0, 32 :: Count)) $ \(i :: Count) (w :: Word32) ->+        rank0 w i == rank0 (fromIntegral w :: Word64) i+    it "when comparing Word32 and Word64 over bits 32-64" $ property $+      forAll (choose (0, 32 :: Count)) $ \(i :: Count) (v :: Word32) (w :: Word32) ->+        let v64 = fromIntegral v :: Word64 in+        let w64 = fromIntegral w :: Word64 in+        rank0 v i + popCount0 w == rank0 ((v64 .<. 32) .|. w64) (i + 32)+    it "when comparing select1 for Word64 form a galois connection" $ property $+      forAll (choose (0, 32 :: Count)) $ \(i :: Count) (w :: Word32) ->+        1 <= i && i <= popCount0 w ==>+          rank0 w (select0 w i) == i && select0 w (rank0 w (fromIntegral i)) <= fromIntegral i
+ test/HaskellWorks/Data/Succinct/RankSelect/Binary/Basic/Rank1Spec.hs view
@@ -0,0 +1,89 @@+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1Spec+  ( genRank1UpTo8Spec+  , genRank1UpTo16Spec+  , spec+  ) where++import           Data.Maybe+import           Data.Typeable+import qualified Data.Vector                                                as DV+import qualified Data.Vector.Storable                                       as DVS+import           Data.Word+import           HaskellWorks.Data.Bits.BitRead+import           HaskellWorks.Data.Bits.BitWise+import           HaskellWorks.Data.Bits.PopCount.PopCount1+import           HaskellWorks.Data.Positioning+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1+import           Test.Hspec+import           Test.QuickCheck++{-# ANN module ("HLint: ignore Redundant do" :: String) #-}+{-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}++genRank1UpTo8Spec :: forall s. (Typeable s, BitRead s, Rank1 s) => s -> Spec+genRank1UpTo8Spec _ = describe ("Generically up to 8 bits for " ++ show (typeOf (undefined :: s))) $ do+  it "rank1 10010010 over [0..8] should be 011122233" $ do+    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]++spec :: Spec+spec = describe "HaskellWorks.Data.Succinct.RankSelect.InternalSpec" $ do+  genRank1UpTo8Spec (undefined :: Word8)+  genRank1UpTo8Spec (undefined :: Word16)+  genRank1UpTo8Spec (undefined :: Word32)+  genRank1UpTo8Spec (undefined :: Word64)+  genRank1UpTo8Spec (undefined :: [Word8])+  genRank1UpTo16Spec (undefined :: [Word8])+  genRank1UpTo8Spec (undefined :: [Word16])+  genRank1UpTo16Spec (undefined :: [Word16])+  genRank1UpTo8Spec (undefined :: [Word32])+  genRank1UpTo16Spec (undefined :: [Word32])+  genRank1UpTo8Spec (undefined :: [Word64])+  genRank1UpTo16Spec (undefined :: [Word64])+  genRank1UpTo8Spec (undefined :: DV.Vector Word8)+  genRank1UpTo16Spec (undefined :: DV.Vector Word8)+  genRank1UpTo8Spec (undefined :: DV.Vector Word16)+  genRank1UpTo16Spec (undefined :: DV.Vector Word16)+  genRank1UpTo8Spec (undefined :: DV.Vector Word32)+  genRank1UpTo16Spec (undefined :: DV.Vector Word32)+  genRank1UpTo8Spec (undefined :: DV.Vector Word64)+  genRank1UpTo16Spec (undefined :: DV.Vector Word64)+  genRank1UpTo8Spec (undefined :: DVS.Vector Word8)+  genRank1UpTo16Spec (undefined :: DVS.Vector Word8)+  genRank1UpTo8Spec (undefined :: DVS.Vector Word16)+  genRank1UpTo16Spec (undefined :: DVS.Vector Word16)+  genRank1UpTo8Spec (undefined :: DVS.Vector Word32)+  genRank1UpTo16Spec (undefined :: DVS.Vector Word32)+  genRank1UpTo8Spec (undefined :: DVS.Vector Word64)+  genRank1UpTo16Spec (undefined :: DVS.Vector Word64)+  describe "For Word8-Word64" $ do+    it "rank1 for Word16 and Word64 should give same answer for bits 0-7" $+      forAll (choose (0, 8)) $ \(i :: Count) (w :: Word8) ->+        rank1 w i == rank1 (fromIntegral w :: Word64) i+    it "rank1 for Word16 and Word64 should give same answer for bits 0-15" $+      forAll (choose (0, 16)) $ \(i :: Count) (w :: Word16) ->+        rank1 w i == rank1 (fromIntegral w :: Word64) i+    it "rank1 for Word32 and Word64 should give same answer for bits 0-31" $+      forAll (choose (0, 32)) $ \(i :: Count) (w :: Word32) ->+        rank1 w i == rank1 (fromIntegral w :: Word64) i+    it "rank1 for Word32 and Word64 should give same answer for bits 32-64" $+      forAll (choose (0, 32)) $ \(i :: Count) (v :: Word32) (w :: Word32) ->+        let v64 = fromIntegral v :: Word64 in+        let w64 = fromIntegral w :: Word64 in+        rank1 v i + popCount1 w == rank1 ((v64 .<. 32) .|. w64) (i + 32)+    it "rank1 and select1 for Word64 form a galois connection" $+      forAll (choose (0, 32)) $ \(i :: Count) (w :: Word32) -> 1 <= i && i <= popCount1 w ==>+        rank1 w (select1 w i) == i && select1 w (rank1 w (fromIntegral i)) <= fromIntegral i
+ test/HaskellWorks/Data/Succinct/RankSelect/Binary/Basic/Select0Spec.hs view
@@ -0,0 +1,116 @@+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select0Spec+  ( genSelect0UpTo8Spec+  , genSelect0UpTo16Spec+  , genSelect0UpTo32Spec+  , spec+  ) where++import           Data.Maybe+import           Data.Typeable+import qualified Data.Vector                                                as DV+import qualified Data.Vector.Storable                                       as DVS+import           Data.Word+import           HaskellWorks.Data.Bits.BitRead+import           HaskellWorks.Data.Bits.BitWise+import           HaskellWorks.Data.Bits.PopCount.PopCount0+import           HaskellWorks.Data.Positioning+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank0+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select0+import           Test.Hspec+import           Test.QuickCheck++{-# ANN module ("HLint: ignore Redundant do" :: String) #-}+{-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}++genSelect0UpTo8Spec :: forall s. (Typeable s, BitRead s, Select0 s) => s -> Spec+genSelect0UpTo8Spec _ = describe ("Generically up to 8 bits for " ++ show (typeOf (undefined :: s))) $ do+  it "select0 10010010 over [0..5] should be 023568" $ do+    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]++spec :: Spec+spec = describe "HaskellWorks.Data.Succinct.RankSelect.InternalSpec" $ do+  genSelect0UpTo8Spec  (undefined :: Word8)+  genSelect0UpTo8Spec  (undefined :: Word16)+  genSelect0UpTo8Spec  (undefined :: Word32)+  genSelect0UpTo8Spec  (undefined :: Word64)+  genSelect0UpTo16Spec (undefined :: Word16)+  genSelect0UpTo16Spec (undefined :: Word32)+  genSelect0UpTo16Spec (undefined :: Word64)+  genSelect0UpTo32Spec (undefined :: Word32)+  genSelect0UpTo32Spec (undefined :: Word64)+  genSelect0UpTo8Spec  (undefined :: [Bool])+  genSelect0UpTo16Spec (undefined :: [Bool])+  genSelect0UpTo32Spec (undefined :: [Bool])+  genSelect0UpTo8Spec  (undefined :: [Word8])+  genSelect0UpTo16Spec (undefined :: [Word8])+  genSelect0UpTo32Spec (undefined :: [Word8])+  genSelect0UpTo8Spec  (undefined :: [Word16])+  genSelect0UpTo16Spec (undefined :: [Word16])+  genSelect0UpTo32Spec (undefined :: [Word16])+  genSelect0UpTo8Spec  (undefined :: [Word32])+  genSelect0UpTo16Spec (undefined :: [Word32])+  genSelect0UpTo32Spec (undefined :: [Word32])+  genSelect0UpTo8Spec  (undefined :: [Word64])+  genSelect0UpTo16Spec (undefined :: [Word64])+  genSelect0UpTo32Spec (undefined :: [Word64])+  genSelect0UpTo8Spec  (undefined :: DV.Vector Word8)+  genSelect0UpTo16Spec (undefined :: DV.Vector Word8)+  genSelect0UpTo32Spec (undefined :: DV.Vector Word8)+  genSelect0UpTo8Spec  (undefined :: DV.Vector Word16)+  genSelect0UpTo16Spec (undefined :: DV.Vector Word16)+  genSelect0UpTo32Spec (undefined :: DV.Vector Word16)+  genSelect0UpTo8Spec  (undefined :: DV.Vector Word32)+  genSelect0UpTo16Spec (undefined :: DV.Vector Word32)+  genSelect0UpTo32Spec (undefined :: DV.Vector Word32)+  genSelect0UpTo8Spec  (undefined :: DV.Vector Word64)+  genSelect0UpTo16Spec (undefined :: DV.Vector Word64)+  genSelect0UpTo32Spec (undefined :: DV.Vector Word64)+  genSelect0UpTo8Spec  (undefined :: DVS.Vector Word8)+  genSelect0UpTo16Spec (undefined :: DVS.Vector Word8)+  genSelect0UpTo32Spec (undefined :: DVS.Vector Word8)+  genSelect0UpTo8Spec  (undefined :: DVS.Vector Word16)+  genSelect0UpTo16Spec (undefined :: DVS.Vector Word16)+  genSelect0UpTo32Spec (undefined :: DVS.Vector Word16)+  genSelect0UpTo8Spec  (undefined :: DVS.Vector Word32)+  genSelect0UpTo16Spec (undefined :: DVS.Vector Word32)+  genSelect0UpTo32Spec (undefined :: DVS.Vector Word32)+  genSelect0UpTo8Spec  (undefined :: DVS.Vector Word64)+  genSelect0UpTo16Spec (undefined :: DVS.Vector Word64)+  genSelect0UpTo32Spec (undefined :: DVS.Vector Word64)+  describe "For Word8-Word64" $ do+    it "rank0 for Word16 and Word64 should give same answer for bits 0-7" $+      forAll (choose (0, 8)) $ \(i :: Count) (w :: Word8) ->+        rank0 w i == rank0 (fromIntegral w :: Word64) i+    it "rank0 for Word16 and Word64 should give same answer for bits 0-15" $+      forAll (choose (0, 16)) $ \(i :: Count) (w :: Word16) ->+        rank0 w i == rank0 (fromIntegral w :: Word64) i+    it "rank0 for Word32 and Word64 should give same answer for bits 0-31" $+      forAll (choose (0, 32)) $ \(i :: Count) (w :: Word32) ->+        rank0 w i == rank0 (fromIntegral w :: Word64) i+    it "rank0 for Word32 and Word64 should give same answer for bits 32-64" $+      forAll (choose (0, 32)) $ \(i :: Count) (v :: Word32) (w :: Word32) ->+        let v64 = fromIntegral v :: Word64 in+        let w64 = fromIntegral w :: Word64 in+        rank0 v i + popCount0 w == rank0 ((v64 .<. 32) .|. w64) (i + 32)+    it "rank0 and select0 for Word64 form a galois connection" $ property $+      forAll (choose (0, 32)) $ \(i :: Count) (w :: Word32) -> 1 <= i && i <= popCount0 w ==>+        rank0 w (select0 w i) == i && select0 w (rank0 w (fromIntegral i)) <= fromIntegral i
+ test/HaskellWorks/Data/Succinct/RankSelect/Binary/Basic/Select1Spec.hs view
@@ -0,0 +1,122 @@+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1Spec+  ( genSelect1UpTo8Spec+  , genSelect1UpTo16Spec+  , genSelect1UpTo32Spec+  , spec+  ) where++import           Data.Maybe+import           Data.Typeable+import qualified Data.Vector                                                as DV+import qualified Data.Vector.Storable                                       as DVS+import           Data.Word+import           HaskellWorks.Data.Bits.BitRead+import           HaskellWorks.Data.Bits.BitWise+import           HaskellWorks.Data.Bits.PopCount.PopCount1+import           HaskellWorks.Data.Positioning+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1+import           Test.Hspec+import           Test.QuickCheck++{-# ANN module ("HLint: ignore Redundant do" :: String) #-}+{-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}++genSelect1UpTo8Spec :: forall s. (Typeable s, BitRead s, Select1 s) => s -> Spec+genSelect1UpTo8Spec _ = describe ("Generically up to 8 bits for " ++ show (typeOf (undefined :: s))) $ do+  it "select1 10010010 over [0..3] should be 0147" $ do+    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]++spec :: Spec+spec = describe "HaskellWorks.Data.Succinct.RankSelect.InternalSpec" $ do+  genSelect1UpTo8Spec  (undefined :: Word8)+  genSelect1UpTo8Spec  (undefined :: Word16)+  genSelect1UpTo8Spec  (undefined :: Word32)+  genSelect1UpTo8Spec  (undefined :: Word64)+  genSelect1UpTo16Spec (undefined :: Word16)+  genSelect1UpTo16Spec (undefined :: Word32)+  genSelect1UpTo16Spec (undefined :: Word64)+  genSelect1UpTo32Spec (undefined :: Word32)+  genSelect1UpTo32Spec (undefined :: Word64)+  genSelect1UpTo8Spec  (undefined :: [Bool])+  genSelect1UpTo16Spec (undefined :: [Bool])+  genSelect1UpTo32Spec (undefined :: [Bool])+  genSelect1UpTo8Spec  (undefined :: [Word8])+  genSelect1UpTo16Spec (undefined :: [Word8])+  genSelect1UpTo32Spec (undefined :: [Word8])+  genSelect1UpTo8Spec  (undefined :: [Word16])+  genSelect1UpTo16Spec (undefined :: [Word16])+  genSelect1UpTo32Spec (undefined :: [Word16])+  genSelect1UpTo8Spec  (undefined :: [Word32])+  genSelect1UpTo16Spec (undefined :: [Word32])+  genSelect1UpTo32Spec (undefined :: [Word32])+  genSelect1UpTo8Spec  (undefined :: [Word64])+  genSelect1UpTo16Spec (undefined :: [Word64])+  genSelect1UpTo32Spec (undefined :: [Word64])+  genSelect1UpTo8Spec  (undefined :: DV.Vector Word8)+  genSelect1UpTo16Spec (undefined :: DV.Vector Word8)+  genSelect1UpTo32Spec (undefined :: DV.Vector Word8)+  genSelect1UpTo8Spec  (undefined :: DV.Vector Word16)+  genSelect1UpTo16Spec (undefined :: DV.Vector Word16)+  genSelect1UpTo32Spec (undefined :: DV.Vector Word16)+  genSelect1UpTo8Spec  (undefined :: DV.Vector Word32)+  genSelect1UpTo16Spec (undefined :: DV.Vector Word32)+  genSelect1UpTo32Spec (undefined :: DV.Vector Word32)+  genSelect1UpTo8Spec  (undefined :: DV.Vector Word64)+  genSelect1UpTo16Spec (undefined :: DV.Vector Word64)+  genSelect1UpTo32Spec (undefined :: DV.Vector Word64)+  genSelect1UpTo8Spec  (undefined :: DVS.Vector Word8)+  genSelect1UpTo16Spec (undefined :: DVS.Vector Word8)+  genSelect1UpTo32Spec (undefined :: DVS.Vector Word8)+  genSelect1UpTo8Spec  (undefined :: DVS.Vector Word16)+  genSelect1UpTo16Spec (undefined :: DVS.Vector Word16)+  genSelect1UpTo32Spec (undefined :: DVS.Vector Word16)+  genSelect1UpTo8Spec  (undefined :: DVS.Vector Word32)+  genSelect1UpTo16Spec (undefined :: DVS.Vector Word32)+  genSelect1UpTo32Spec (undefined :: DVS.Vector Word32)+  genSelect1UpTo8Spec  (undefined :: DVS.Vector Word64)+  genSelect1UpTo16Spec (undefined :: DVS.Vector Word64)+  genSelect1UpTo32Spec (undefined :: DVS.Vector Word64)+  describe "For Word64" $ do+    it "rank1 for Word16 and Word64 should give same answer for bits 0-7" $ property $+      forAll (choose (0, 8)) $ \(i :: Count) (w :: Word8) ->+        rank1 w i == rank1 (fromIntegral w :: Word64) i+    it "rank1 for Word16 and Word64 should give same answer for bits 0-15" $ property $+      forAll (choose (0, 16)) $ \(i :: Count) (w :: Word16) ->+        rank1 w i == rank1 (fromIntegral w :: Word64) i+    it "rank1 for Word32 and Word64 should give same answer for bits 0-31" $ property $+      forAll (choose (0, 32)) $ \(i :: Count) (w :: Word32) ->+        rank1 w i == rank1 (fromIntegral w :: Word64) i+    it "rank1 for Word32 and Word64 should give same answer for bits 32-64" $ property $+      forAll (choose (0, 32)) $ \(i :: Count) (v :: Word32) (w :: Word32) ->+        let v64 = fromIntegral v :: Word64 in+        let w64 = fromIntegral w :: Word64 in+        rank1 v i + popCount1 w == rank1 ((v64 .<. 32) .|. w64) (i + 32)+    it "rank1 and select1 for Word64 form a galois connection" $ property $+      forAll (choose (0, 32)) $ \(i :: Count) (w :: Word32) -> 1 <= i && i <= popCount1 w ==>+        rank1 w (select1 w i) == i && select1 w (rank1 w (fromIntegral i)) <= fromIntegral i
+ test/HaskellWorks/Data/Succinct/RankSelect/Binary/BasicGen.hs view
@@ -0,0 +1,31 @@+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.Succinct.RankSelect.Binary.BasicGen+  ( genBinaryRankSelectSpec+  ) where++import           Data.Typeable+import           HaskellWorks.Data.Bits.BitRead+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank0+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank0Spec   hiding (spec)+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1Spec   hiding (spec)+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select0+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select0Spec hiding (spec)+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1Spec hiding (spec)+import           Test.Hspec++genBinaryRankSelectSpec :: forall s. (Typeable s, BitRead s, Rank0 s, Rank1 s, Select0 s, Select1 s) => s -> Spec+genBinaryRankSelectSpec s = describe "Generically" $ do+  genRank0UpTo8Spec     s+  genRank0UpTo16Spec    s+  genRank1UpTo8Spec     s+  genRank1UpTo16Spec    s+  genSelect0UpTo8Spec   s+  genSelect0UpTo16Spec  s+  genSelect0UpTo32Spec  s+  genSelect1UpTo8Spec   s+  genSelect1UpTo16Spec  s+  genSelect1UpTo32Spec  s
+ test/HaskellWorks/Data/Succinct/RankSelect/Binary/Poppy512Spec.hs view
@@ -0,0 +1,131 @@+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE ScopedTypeVariables        #-}++module HaskellWorks.Data.Succinct.RankSelect.Binary.Poppy512Spec (spec) where++import           GHC.Exts+import qualified Data.Vector.Storable                                       as DVS+import           Data.Word+import           HaskellWorks.Data.Bits.BitShow+import           HaskellWorks.Data.Bits.PopCount.PopCount0+import           HaskellWorks.Data.Bits.PopCount.PopCount1+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank0+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select0+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1+import           HaskellWorks.Data.Succinct.RankSelect.Binary.BasicGen+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Poppy512+import           HaskellWorks.Data.Vector.VectorLike+import           Test.Hspec+import           Test.QuickCheck++{-# ANN module ("HLint: ignore Redundant do" :: String) #-}+{-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}++newtype ShowVector a = ShowVector a deriving (Eq, BitShow)++instance BitShow a => Show (ShowVector a) where+  show = bitShow++vectorSizedBetween :: Int -> Int -> Gen (ShowVector (DVS.Vector Word64))+vectorSizedBetween a b = do+  n   <- choose (a, b)+  xs  <- sequence [ arbitrary | _ <- [1 .. n] ]+  return $ ShowVector (fromList xs)++spec :: Spec+spec = describe "HaskellWorks.Data.Succinct.RankSelect.Binary.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, vLength 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, vLength 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, vLength 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, vLength 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, vLength 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, vLength 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
+ test/HaskellWorks/Data/Succinct/RankSelect/InternalSpec.hs view
@@ -0,0 +1,34 @@+{-# 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.Succinct.RankSelect.Internal+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
+ test/HaskellWorks/Data/Succinct/SimpleSpec.hs view
@@ -0,0 +1,52 @@+{-# 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.Succinct.RankSelect.Binary.Basic.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
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}