hw-rankselect-base (empty) → 0.0.0.1
raw patch · 17 files changed
+1302/−0 lines, 17 filesdep +QuickCheckdep +basedep +hspecsetup-changed
Dependencies added: QuickCheck, base, hspec, hw-bits, hw-prim, hw-rankselect-base, hw-string-parse, safe, vector
Files
- LICENSE +21/−0
- README.md +9/−0
- Setup.hs +2/−0
- hw-rankselect-base.cabal +57/−0
- src/HaskellWorks/Data/RankSelect/Binary.hs +5/−0
- src/HaskellWorks/Data/RankSelect/Binary/Basic.hs +8/−0
- src/HaskellWorks/Data/RankSelect/Binary/Basic/Rank0.hs +133/−0
- src/HaskellWorks/Data/RankSelect/Binary/Basic/Rank1.hs +170/−0
- src/HaskellWorks/Data/RankSelect/Binary/Basic/Select0.hs +162/−0
- src/HaskellWorks/Data/RankSelect/Binary/Basic/Select1.hs +251/−0
- src/HaskellWorks/Data/RankSelect/Internal.hs +25/−0
- test/HaskellWorks/Data/RankSelect/Binary/Basic/Rank0Spec.hs +90/−0
- test/HaskellWorks/Data/RankSelect/Binary/Basic/Rank1Spec.hs +89/−0
- test/HaskellWorks/Data/RankSelect/Binary/Basic/Select0Spec.hs +116/−0
- test/HaskellWorks/Data/RankSelect/Binary/Basic/Select1Spec.hs +122/−0
- test/HaskellWorks/Data/RankSelect/Binary/BasicGen.hs +41/−0
- test/Spec.hs +1/−0
+ LICENSE view
@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2016 John Ky++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ README.md view
@@ -0,0 +1,9 @@+# hw-rankselect+[](https://circleci.com/gh/haskell-works/hw-rankselect/tree/0.0-branch)++Rank and select operations.++```+cabal repl hw-rankselect-test+λ> :trace main+```
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ hw-rankselect-base.cabal view
@@ -0,0 +1,57 @@+name: hw-rankselect-base+version: 0.0.0.1+synopsis: Conduits for tokenizing streams.+description: Please see README.md+homepage: http://github.com/haskell-works/hw-rankselect-base#readme+license: MIT+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.22++library+ hs-source-dirs: src+ exposed-modules: HaskellWorks.Data.RankSelect.Binary+ , HaskellWorks.Data.RankSelect.Binary.Basic+ , HaskellWorks.Data.RankSelect.Binary.Basic.Rank0+ , HaskellWorks.Data.RankSelect.Binary.Basic.Rank1+ , HaskellWorks.Data.RankSelect.Binary.Basic.Select0+ , HaskellWorks.Data.RankSelect.Binary.Basic.Select1+ , HaskellWorks.Data.RankSelect.Internal+ build-depends: base >= 4 && < 5+ , hw-bits >= 0.3.0.0+ , hw-prim >= 0.3.0.5+ , hw-string-parse >= 0.0.0.2+ , safe+ , vector++ default-language: Haskell2010+ ghc-options: -Wall -O2 -msse4.2++test-suite hw-rankselect-base-test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Spec.hs+ other-modules: HaskellWorks.Data.RankSelect.Binary.Basic.Rank0Spec+ , HaskellWorks.Data.RankSelect.Binary.Basic.Rank1Spec+ , HaskellWorks.Data.RankSelect.Binary.Basic.Select0Spec+ , HaskellWorks.Data.RankSelect.Binary.Basic.Select1Spec+ , HaskellWorks.Data.RankSelect.Binary.BasicGen++ build-depends: base >= 4 && < 5+ , hspec+ , hw-bits >= 0.3.0.0+ , hw-prim >= 0.3.0.5+ , hw-rankselect-base+ , QuickCheck+ , 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-base
+ src/HaskellWorks/Data/RankSelect/Binary.hs view
@@ -0,0 +1,5 @@+module HaskellWorks.Data.RankSelect.Binary+ ( module X+ ) where++import HaskellWorks.Data.RankSelect.Binary.Basic as X
+ src/HaskellWorks/Data/RankSelect/Binary/Basic.hs view
@@ -0,0 +1,8 @@+module HaskellWorks.Data.RankSelect.Binary.Basic+ ( module X+ ) where++import HaskellWorks.Data.RankSelect.Binary.Basic.Rank0 as X+import HaskellWorks.Data.RankSelect.Binary.Basic.Rank1 as X+import HaskellWorks.Data.RankSelect.Binary.Basic.Select0 as X+import HaskellWorks.Data.RankSelect.Binary.Basic.Select1 as X
+ src/HaskellWorks/Data/RankSelect/Binary/Basic/Rank0.hs view
@@ -0,0 +1,133 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE StandaloneDeriving #-}++module HaskellWorks.Data.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.AtIndex+import HaskellWorks.Data.Bits.BitShown+import HaskellWorks.Data.Bits.ElemFixedBitSize+import HaskellWorks.Data.Bits.PopCount.PopCount0+import HaskellWorks.Data.Positioning+import HaskellWorks.Data.RankSelect.Binary.Basic.Rank1 as X+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+ {-# INLINE rank0 #-}++instance Rank0 Word16 where+ rank0 v s0 = s0 - rank1 v s0+ {-# INLINE rank0 #-}++instance Rank0 Word32 where+ rank0 v s0 = s0 - rank1 v s0+ {-# INLINE rank0 #-}++instance Rank0 Word64 where+ rank0 v s0 = s0 - rank1 v s0+ {-# INLINE 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"+ {-# INLINE 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+ {-# INLINE 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+ {-# INLINE 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+ {-# INLINE 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+ {-# INLINE 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+ {-# INLINE 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+ {-# INLINE 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+ {-# INLINE 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+ {-# INLINE 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+ {-# INLINE 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+ {-# INLINE 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+ {-# INLINE 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+ {-# INLINE rank0 #-}
+ src/HaskellWorks/Data/RankSelect/Binary/Basic/Rank1.hs view
@@ -0,0 +1,170 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE StandaloneDeriving #-}++module HaskellWorks.Data.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.AtIndex+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.Widen.Widen64+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+ widen64 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+ widen64 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+ widen64 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+ 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/RankSelect/Binary/Basic/Select0.hs view
@@ -0,0 +1,162 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE StandaloneDeriving #-}++module HaskellWorks.Data.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.AtIndex+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.RankSelect.Binary.Basic.Select1++{-# 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/RankSelect/Binary/Basic/Select1.hs view
@@ -0,0 +1,251 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE StandaloneDeriving #-}++module HaskellWorks.Data.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.AtIndex+import HaskellWorks.Data.Bits.BitShown+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Bits.ElemFixedBitSize+import HaskellWorks.Data.Bits.PopCount.PopCount1+import HaskellWorks.Data.Narrow+import HaskellWorks.Data.Positioning+import Prelude as P++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+ {-# INLINE 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 - narrow16 rn 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+ {-# INLINE 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 - narrow32 rn 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+ {-# INLINE 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 - narrow64 rn 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+ {-# INLINE select1 #-}++instance Select1 [Bool] where+ select1 = go 0+ where go r _ 0 = r+ go r (True :bs) c = go (r + 1) bs (c - 1)+ go r (False:bs) c = go (r + 1) bs c+ go _ [] _ = error "Out of range"+ {-# INLINE select1 #-}++instance Select1 [Word8] where+ select1 v c = go v c 0+ where go :: [Word8] -> Count -> Count -> Count+ go _ 0 acc = acc+ go u d acc = let w = head u in+ case popCount1 w of+ pc | d <= pc -> select1 w d + acc+ pc -> go (tail u) (d - pc) (acc + elemFixedBitSize u)+ {-# INLINE select1 #-}++instance Select1 [Word16] where+ select1 v c = go v c 0+ where go :: [Word16] -> Count -> Count -> Count+ go _ 0 acc = acc+ go u d acc = let w = head u in+ case popCount1 w of+ pc | d <= pc -> select1 w d + acc+ pc -> go (tail u) (d - pc) (acc + elemFixedBitSize u)+ {-# INLINE select1 #-}++instance Select1 [Word32] where+ select1 v c = go v c 0+ where go :: [Word32] -> Count -> Count -> Count+ go _ 0 acc = acc+ go u d acc = let w = head u in+ case popCount1 w of+ pc | d <= pc -> select1 w d + acc+ pc -> go (tail u) (d - pc) (acc + elemFixedBitSize u)+ {-# INLINE select1 #-}++instance Select1 [Word64] where+ select1 v c = go v c 0+ where go :: [Word64] -> Count -> Count -> Count+ go _ 0 acc = acc+ go u d acc = let w = head u in+ case popCount1 w of+ pc | d <= pc -> select1 w d + acc+ pc -> go (tail u) (d - pc) (acc + elemFixedBitSize u)+ {-# INLINE select1 #-}++instance Select1 (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)+ {-# INLINE 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)+ {-# INLINE 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)+ {-# INLINE 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)+ {-# INLINE 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)+ {-# INLINE 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)+ {-# INLINE 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)+ {-# INLINE 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)+ {-# INLINE select1 #-}
+ src/HaskellWorks/Data/RankSelect/Internal.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module HaskellWorks.Data.RankSelect.Internal+ ( -- * Rank & Select+ Rank(..)+ , Select(..)+ ) where++import HaskellWorks.Data.Positioning+import HaskellWorks.Data.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/RankSelect/Binary/Basic/Rank0Spec.hs view
@@ -0,0 +1,90 @@+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.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.RankSelect.Binary.Basic.Rank0+import HaskellWorks.Data.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.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/RankSelect/Binary/Basic/Rank1Spec.hs view
@@ -0,0 +1,89 @@+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.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.RankSelect.Binary.Basic.Rank1+import HaskellWorks.Data.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.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/RankSelect/Binary/Basic/Select0Spec.hs view
@@ -0,0 +1,116 @@+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.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.RankSelect.Binary.Basic.Rank0+import HaskellWorks.Data.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.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/RankSelect/Binary/Basic/Select1Spec.hs view
@@ -0,0 +1,122 @@+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.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.RankSelect.Binary.Basic.Rank1+import HaskellWorks.Data.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.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/RankSelect/Binary/BasicGen.hs view
@@ -0,0 +1,41 @@+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.Succinct.RankSelect.Binary.BasicGen+ ( genBinaryRankSelectSpec+ , genBinaryRank0Select0Spec+ , genBinaryRank1Select1Spec+ ) 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++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
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}