hw-rankselect 0.13.0.0 → 0.13.1.0

raw patch · 8 files changed

+460/−19 lines, 8 filesdep +hw-fingertreedep ~hedgehogdep ~hspecdep ~hw-balancedparensPVP ok

version bump matches the API change (PVP)

Dependencies added: hw-fingertree

Dependency ranges changed: hedgehog, hspec, hw-balancedparens, hw-prim

API changes (from Hackage documentation)

Files

• gen/HaskellWorks/Data/RankSelect/Gen.hs +16/−0
• hw-rankselect.cabal +31/−14
• src/HaskellWorks/Data/RankSelect/BitSeq.hs +87/−0
• src/HaskellWorks/Data/RankSelect/Internal/BitSeq.hs +152/−0
• src/HaskellWorks/Data/RankSelect/Internal/List.hs +18/−0
• src/HaskellWorks/Data/RankSelect/Internal/Word.hs +30/−0
• test/HaskellWorks/Data/RankSelect/BitSeqSpec.hs +119/−0
• test/HaskellWorks/Data/RankSelect/InternalSpec.hs +7/−5

@@ -0,0 +1,16 @@+module HaskellWorks.Data.RankSelect.Gen+  ( bitSeq+  ) where++import HaskellWorks.Data.Positioning+import HaskellWorks.Data.RankSelect.BitSeq (BitSeq)+import Hedgehog++import qualified HaskellWorks.Data.RankSelect.BitSeq as BS+import qualified Hedgehog.Gen                        as G++bools :: MonadGen m => Range Count -> m [Bool]+bools r = G.list (fmap fromIntegral r) G.bool++bitSeq :: MonadGen m => Range Count -> m BitSeq+bitSeq r = BS.fromBools <$> bools r

@@ -1,7 +1,7 @@ cabal-version:  2.2  name:           hw-rankselect-version:        0.13.0.0+version:        0.13.1.0 synopsis:       Rank-select description:    Please see README.md category:       Data, Bit, Succinct Data Structures, Data Structures@@ -12,7 +12,7 @@ copyright:      2016-2019 John Ky license:        BSD-3-Clause license-file:   LICENSE-tested-with:    GHC == 8.4.2, GHC == 8.2.2, GHC == 8.0.2, GHC == 7.10.3+tested-with:    GHC == 8.6.5, GHC == 8.4.4, GHC == 8.2.2 build-type:     Simple extra-source-files:     README.md@@ -37,13 +37,14 @@ common deepseq              { build-depends: deepseq              >= 1.4        && < 1.5    } common directory            { build-depends: directory            >= 1.2        && < 1.5    } common generic-lens         { build-depends: generic-lens         >= 1.0.0.0    && < 1.2    }-common hedgehog             { build-depends: hedgehog             >= 0.5        && < 0.7    }+common hedgehog             { build-depends: hedgehog             >= 1.0        && < 1.1    } common hspec                { build-depends: hspec                >= 2.4        && < 2.6    }-common hw-balancedparens    { build-depends: hw-balancedparens    >= 0.1.0.0    && < 0.3    }+common hw-balancedparens    { build-depends: hw-balancedparens    >= 0.2.2.0    && < 0.3    } common hw-bits              { build-depends: hw-bits              >= 0.4.0.0    && < 0.8    }+common hw-fingertree        { build-depends: hw-fingertree        >= 0.1.1.0    && < 1.2    } common hw-hedgehog          { build-depends: hw-hedgehog          >= 0.1.0.1    && < 0.2    } common hw-hspec-hedgehog    { build-depends: hw-hspec-hedgehog    >= 0.1        && < 0.2    }-common hw-prim              { build-depends: hw-prim              >= 0.6        && < 0.8    }+common hw-prim              { build-depends: hw-prim              >= 0.6.2.23   && < 0.7    } common hw-rankselect-base   { build-depends: hw-rankselect-base   >= 0.2.0.0    && < 0.4    } common lens                 { build-depends: lens                 >= 4          && < 5      } common mmap                 { build-depends: mmap                 >= 0.5        && < 0.6    }@@ -53,7 +54,7 @@ common transformers         { build-depends: transformers         >= 0.4        && < 0.6    } common vector               { build-depends: vector               >= 0.12       && < 0.13   } -common common+common config   default-language: Haskell2010   if (impl(ghc >= 8.0.1))     ghc-options: -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints@@ -63,15 +64,16 @@   ghc-options:   -O2 -Wall -msse4.2  library-  import:   base-          , common+  import:   base, config           , deepseq           , hw-balancedparens           , hw-bits+          , hw-fingertree           , hw-prim           , hw-rankselect-base           , vector   exposed-modules:+      HaskellWorks.Data.RankSelect.BitSeq       HaskellWorks.Data.RankSelect.CsPoppy       HaskellWorks.Data.RankSelect.CsPoppy0       HaskellWorks.Data.RankSelect.CsPoppy1@@ -82,14 +84,30 @@       HaskellWorks.Data.RankSelect.CsPoppy.Internal.Nice       HaskellWorks.Data.RankSelect.CsPoppy.Internal.Reference       HaskellWorks.Data.RankSelect.CsPoppy.Internal.Vector+      HaskellWorks.Data.RankSelect.Internal.BitSeq+      HaskellWorks.Data.RankSelect.Internal.List+      HaskellWorks.Data.RankSelect.Internal.Word       HaskellWorks.Data.RankSelect.Poppy512   other-modules:    Paths_hw_rankselect   autogen-modules:  Paths_hw_rankselect   hs-source-dirs:   src +library hw-rankselect-gen+  import:   base, config+          , deepseq+          , hedgehog+          , hspec+          , hw-prim+          , vector+  exposed-modules:+    HaskellWorks.Data.RankSelect.Gen+    Paths_hw_rankselect+  build-depends:      hw-rankselect+  hs-source-dirs:     gen+  autogen-modules:    Paths_hw_rankselect+ executable hw-rankselect-  import:   base-          , common+  import:   base, config           , directory           , generic-lens           , hw-bits@@ -116,8 +134,7 @@   ghc-options:        -threaded -rtsopts -with-rtsopts=-N  test-suite hw-rankselect-test-  import:   base-          , common+  import:   base, config           , QuickCheck           , directory           , hedgehog@@ -136,6 +153,7 @@   other-modules:       HaskellWorks.Data.RankSelect.BasicGen       HaskellWorks.Data.RankSelect.BinarySearchSpec+      HaskellWorks.Data.RankSelect.BitSeqSpec       HaskellWorks.Data.RankSelect.CsPoppy.InternalSpec       HaskellWorks.Data.RankSelect.CsPoppySpec       HaskellWorks.Data.RankSelect.Gen@@ -152,8 +170,7 @@   ghc-options:        -threaded -rtsopts -with-rtsopts=-N  benchmark bench-  import:   base-          , common+  import:   base, config           , bytestring                   , conduit           , criterion

@@ -0,0 +1,87 @@+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module HaskellWorks.Data.RankSelect.BitSeq+  ( BitSeq(..)+  , mempty+  , size+  , fromWord64s+  , fromPartialWord64s+  , toPartialWord64s+  , fromBools+  , toBools+  , BS.splitAt+  , take+  , drop+  , (<|), (><), (|>)+  , select1+  ) where++import Data.Coerce+import Data.Foldable+import Data.Monoid+import Data.Word+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.FingerTree                 (ViewL (..), ViewR (..), (<|), (><), (|>))+import HaskellWorks.Data.Positioning+import HaskellWorks.Data.RankSelect.Base.Select1    (select1)+import HaskellWorks.Data.RankSelect.Internal.BitSeq (BitSeq (BitSeq), BitSeqFt, Elem (Elem))+import Prelude                                      hiding (drop, max, min, splitAt, take)++import qualified Data.List                                    as L+import qualified HaskellWorks.Data.FingerTree                 as FT+import qualified HaskellWorks.Data.RankSelect.Internal.BitSeq as BS+import qualified HaskellWorks.Data.RankSelect.Internal.Word   as W++empty :: BitSeq+empty = BitSeq FT.empty++size :: BitSeq -> Count+size (BitSeq parens) = BS.measureBitCount (FT.measure parens)++-- TODO Needs optimisation+fromWord64s :: Traversable f => f Word64 -> BitSeq+fromWord64s = foldl go empty+  where go :: BitSeq -> Word64 -> BitSeq+        go ps w = BitSeq (BS.parens ps |> Elem w 64)++-- TODO Needs optimisation+fromPartialWord64s :: Traversable f => f (Word64, Count) -> BitSeq+fromPartialWord64s = foldl go empty+  where go :: BitSeq -> (Word64, Count) -> BitSeq+        go ps (w, n) = BitSeq (BS.parens ps |> Elem w n)++toPartialWord64s :: BitSeq -> [(Word64, Count)]+toPartialWord64s = L.unfoldr go . coerce+  where go :: BitSeqFt -> Maybe ((Word64, Count), BitSeqFt)+        go ft = case FT.viewl ft of+          BS.Elem w n :< rt -> Just ((w, coerce n), rt)+          FT.EmptyL         -> Nothing++fromBools :: [Bool] -> BitSeq+fromBools = go empty+  where go :: BitSeq -> [Bool] -> BitSeq+        go (BitSeq ps) (b:bs) = case FT.viewr ps of+          FT.EmptyR      -> go (BitSeq (FT.singleton (Elem b' 1))) bs+          lt :> Elem w n ->+            let newPs = if n >= 64+                then ps |> Elem b' 1+                else lt |> Elem (w .|. (b' .<. fromIntegral n)) (n + 1)+            in go (BitSeq newPs) bs+          where b' = if b then 1 else 0 :: Word64+        go ps [] = ps++toBools :: BitSeq -> [Bool]+toBools ps = toBoolsDiff ps []++toBoolsDiff :: BitSeq -> [Bool] -> [Bool]+toBoolsDiff ps = mconcat (fmap go (toPartialWord64s ps))+  where go :: (Word64, Count) -> [Bool] -> [Bool]+        go (w, n) = W.partialToBoolsDiff (fromIntegral n) w++drop :: Count -> BitSeq -> BitSeq+drop n ps = snd (BS.splitAt n ps)++take :: Count -> BitSeq -> BitSeq+take n ps = fst (BS.splitAt n ps)

@@ -0,0 +1,152 @@+{-# LANGUAGE DeriveGeneric              #-}+{-# LANGUAGE DuplicateRecordFields      #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE InstanceSigs               #-}+{-# LANGUAGE MultiParamTypeClasses      #-}+{-# LANGUAGE TypeFamilies               #-}++module HaskellWorks.Data.RankSelect.Internal.BitSeq+  ( Elem(..)+  , Measure(..)+  , BitSeq(..)+  , BitSeqFt+  , (|>#)+  , (#<|)+  , ftSplit+  , atBitCountBelow+  , atPopCountBelow+  , splitAt+  ) where++import Control.DeepSeq+import Data.Monoid                               (Monoid)+import Data.Semigroup                            (Semigroup (..))+import Data.Word+import GHC.Generics+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Bits.PopCount.PopCount1+import HaskellWorks.Data.FingerTree              (ViewL (..), ViewR (..), (<|), (><), (|>))+import HaskellWorks.Data.Positioning+import HaskellWorks.Data.RankSelect.Base.Rank1+import HaskellWorks.Data.RankSelect.Base.Select1+import Prelude                                   hiding (max, min, splitAt)++import qualified HaskellWorks.Data.Cons       as HW+import qualified HaskellWorks.Data.Container  as HW+import qualified HaskellWorks.Data.FingerTree as FT+import qualified HaskellWorks.Data.Snoc       as HW++data Elem = Elem+  { elemBits :: {-# UNPACK #-} !Word64+  , elemSize :: {-# UNPACK #-} !Count+  } deriving (Eq, Show, Generic)++instance NFData Elem++data Measure = Measure+  { measureBitCount :: {-# UNPACK #-} !Count+  , measurePopCount :: {-# UNPACK #-} !Count+  } deriving (Eq, Ord, Show, Generic)++instance NFData Measure++type BitSeqFt = FT.FingerTree Measure Elem++newtype BitSeq = BitSeq+  { parens :: BitSeqFt+  } deriving (Show, NFData, Generic)++instance Semigroup Measure where+  a <> b = Measure+    { measureBitCount = measureBitCount a + measureBitCount b+    , measurePopCount = measurePopCount a + measurePopCount b+    }++instance Monoid Measure where+  mempty = Measure 0 0++instance FT.Measured Measure Elem where+  measure (Elem w size) = Measure+    { measureBitCount = size+    , measurePopCount = popCount1 w+    }++instance HW.Container BitSeq where+  type Elem BitSeq = Bool++instance HW.Cons BitSeq where+  cons b (BitSeq ft) = BitSeq $ case FT.viewl ft of+    Elem w nw :< rt -> if nw >= 0 && nw < 64+      then Elem ((w .<. 1) .|. bw) (nw + 1) <| rt+      else Elem bw 1                        <| ft+    FT.EmptyL        -> FT.singleton (Elem bw 1)+    where bw = if b then 1 else 0++instance HW.Snoc BitSeq where+  snoc (BitSeq ft) b = BitSeq $ case FT.viewr ft of+    lt :> Elem w nw -> if nw >= 0 && nw < 64+      then Elem (w .|. (bw .<. nw)) (nw + 1) <| lt+      else Elem bw 1                         <| lt+    FT.EmptyR        -> FT.singleton (Elem bw 1)+    where bw = if b then 1 else 0++instance Semigroup BitSeq where+  BitSeq tl <> BitSeq tr = BitSeq $ case FT.viewr tl of+    tll :> Elem wl nwl -> case FT.viewl tr of+      Elem wr nwr :< trr -> let nw = nwl + nwr in if nw <= 64+        then (tll |> Elem (wl .|. (wr .<. nwl)) nw) >< trr+        else tl >< tr+      FT.EmptyL -> tr+    FT.EmptyR -> FT.empty++instance Select1 BitSeq where+  select1 (BitSeq ft) n = case FT.split (atPopCountBelow n) ft of+    (lt, _) -> case FT.viewr lt of+      FT.EmptyR       -> 0+      llt :> Elem w _ ->+        let llpc = measurePopCount (FT.measure llt :: Measure) in+        let llbc = measureBitCount (FT.measure llt :: Measure) in+        llbc + select1 w (n - llpc)++instance Rank1 BitSeq where+  rank1 bs n = let (lt, _) = splitAt n bs in popCount1 lt++instance PopCount1 BitSeq where+  popCount1 (BitSeq ft) = measureBitCount (FT.measure ft :: Measure)++(|>#) :: BitSeqFt -> Elem -> BitSeqFt+(|>#) ft e@(Elem _ wn) = if wn > 0 then ft |> e else ft++(#<|) :: Elem ->BitSeqFt -> BitSeqFt+(#<|) e@(Elem _ wn) ft = if wn > 0 then e <| ft else ft++ftSplit :: (Measure -> Bool) -> BitSeqFt -> (BitSeqFt, BitSeqFt)+ftSplit p ft = case FT.viewl rt of+  Elem w nw :< rrt -> let c = go w nw nw in (lt |># Elem w c, Elem (w .>. c) (nw - c) #<| rrt)+  FT.EmptyL        -> (ft, FT.empty)+  where (lt, rt) = FT.split p ft+        ltm = FT.measure lt+        go :: Word64 -> Count -> Count -> Count+        go w c nw = if c > 0+          then if p (ltm <> FT.measure (Elem (w .<. (64 - c) .>. (64 - c)) c))+            then go w (c - 1) nw+            else c+          else 0++atBitCountBelow :: Count -> Measure -> Bool+atBitCountBelow n m = n < measureBitCount (m :: Measure)++atPopCountBelow :: Count -> Measure -> Bool+atPopCountBelow n m = n < measurePopCount (m :: Measure)++splitAt :: Count -> BitSeq -> (BitSeq, BitSeq)+splitAt n (BitSeq ft) = case FT.split (atBitCountBelow n) ft of+  (lt, rt) -> let+    n' = n - measureBitCount (FT.measure lt)+    u  = 64 - n'+    in case FT.viewl rt of+      Elem w nw :< rrt -> if n' >= nw+        then (BitSeq  lt                              , BitSeq                               rrt )+        else (BitSeq (lt |> Elem ((w .<. u) .>. u) n'), BitSeq (Elem (w .>. n') (nw - n') <| rrt))+      FT.EmptyL          -> (BitSeq lt, BitSeq FT.empty)

@@ -0,0 +1,18 @@+module HaskellWorks.Data.RankSelect.Internal.List+  ( chunkBy+  , toBools+  ) where++import Data.Word++import qualified HaskellWorks.Data.BalancedParens.Internal.Word as W++chunkBy :: Int -> [a] -> [[a]]+chunkBy n bs = case (take n bs, drop n bs) of+  (as, zs) -> if null zs then [as] else as:chunkBy n zs++toBoolsDiff :: [Word64] -> [Bool] -> [Bool]+toBoolsDiff = foldr ((.) . W.toBoolsDiff) id++toBools :: [Word64] -> [Bool]+toBools ws = toBoolsDiff ws []

@@ -0,0 +1,30 @@+module HaskellWorks.Data.RankSelect.Internal.Word+  ( toBools+  , toBoolsDiff+  , partialToBoolsDiff+  ) where++import Data.Word+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Positioning++toBools :: Word64 -> [Bool]+toBools w = toBoolsDiff w []++partialToBoolsDiff :: Count -> Word64 -> [Bool] -> [Bool]+partialToBoolsDiff n w | n > 0 = partialToBoolsDiff (n - 1) w . ((w .?. fromIntegral (n - 1)):)+partialToBoolsDiff 0 _ = id+partialToBoolsDiff _ _ = error "Invalid size"++toBoolsDiff :: Word64 -> [Bool] -> [Bool]+toBoolsDiff w =+  go 0x00 . go 0x01 . go 0x02 . go 0x03 . go 0x04 . go 0x05 . go 0x06 . go 0x07 .+  go 0x08 . go 0x09 . go 0x0a . go 0x0b . go 0x0c . go 0x0d . go 0x0e . go 0x0f .+  go 0x10 . go 0x11 . go 0x12 . go 0x13 . go 0x14 . go 0x15 . go 0x16 . go 0x17 .+  go 0x18 . go 0x19 . go 0x1a . go 0x1b . go 0x1c . go 0x1d . go 0x1e . go 0x1f .+  go 0x20 . go 0x21 . go 0x22 . go 0x23 . go 0x24 . go 0x25 . go 0x26 . go 0x27 .+  go 0x28 . go 0x29 . go 0x2a . go 0x2b . go 0x2c . go 0x2d . go 0x2e . go 0x2f .+  go 0x30 . go 0x31 . go 0x32 . go 0x33 . go 0x34 . go 0x35 . go 0x36 . go 0x37 .+  go 0x38 . go 0x39 . go 0x3a . go 0x3b . go 0x3c . go 0x3d . go 0x3e . go 0x3f+  where go :: Position -> [Bool] -> [Bool]+        go p = ((w .?. p):)

@@ -0,0 +1,119 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE ScopedTypeVariables        #-}++module HaskellWorks.Data.RankSelect.BitSeqSpec where++import Data.Semigroup                            ((<>))+import HaskellWorks.Data.Bits.PopCount.PopCount1+import HaskellWorks.Data.RankSelect.Base.Rank1+import HaskellWorks.Data.RankSelect.Base.Select1+import HaskellWorks.Data.RankSelect.BitSeq       ((<|), (><), (|>))+import HaskellWorks.Hspec.Hedgehog+import Hedgehog+import Test.Hspec++import qualified HaskellWorks.Data.RankSelect.BitSeq        as BS+import qualified HaskellWorks.Data.RankSelect.Gen           as G+import qualified HaskellWorks.Data.RankSelect.Internal.List as L+import qualified Hedgehog.Gen                               as G+import qualified Hedgehog.Range                             as R++{-# ANN module ("HLint: Ignore Redundant do"        :: String) #-}+{-# ANN module ("HLint: Ignore Reduce duplication"  :: String) #-}++spec :: Spec+spec = describe "HaskellWorks.Data.RankSelect.Internal.BitSeqSpec" $ do+  it "fromWord64s should produce Rmm of the right size" $ requireProperty $ do+    ws <- forAll $ G.list (R.linear 0 10) (G.word64 R.constantBounded)++    BS.size (BS.fromWord64s ws) === fromIntegral (length ws * 64)+  it "fromWord64s should produce Rmm with the right data" $ requireProperty $ do+    wns <- forAll $ G.list (R.linear 0 10) $ (,)+      <$> G.word64 R.constantBounded+      <*> G.count (R.linear 1 64)++    BS.size (BS.fromPartialWord64s wns) === sum (snd <$> wns)+  it "fromWord64s should produce Rmm with the right data" $ requireProperty $ do+    ws <- forAll $ G.list (R.linear 0 10) (G.word64 R.constantBounded)++    BS.toPartialWord64s (BS.fromWord64s ws) === zip ws (repeat 64)+  it "fromPartialWord64s should produce Rmm with the right data" $ requireProperty $ do+    wns <- forAll $ G.list (R.linear 0 10) $ (,)+      <$> G.word64 R.constantBounded+      <*> G.count (R.linear 1 64)++    BS.toPartialWord64s (BS.fromPartialWord64s wns) === wns+  it "fromBools should produce Rmm with the right data" $ requireProperty $ do+    ws <- forAll $ G.list (R.linear 0 10) (G.word64 R.constantBounded)++    BS.toPartialWord64s (BS.fromBools (L.toBools ws)) === zip ws (repeat 64)+  it "drop should drop the right amount of data" $ requireProperty $ do+    ws <- forAll $ G.list (R.linear 0 10) (G.word64 R.constantBounded)+    let ps = BS.fromWord64s ws+    n  <- forAll $ G.count (R.linear 0 (BS.size ps))++    BS.size (BS.drop n ps) === BS.size ps - n+  it "take should take the right amount of data" $ requireProperty $ do+    ws <- forAll $ G.list (R.linear 0 10) (G.word64 R.constantBounded)+    let ps = BS.fromWord64s ws+    n  <- forAll $ G.count (R.linear 0 (BS.size ps))++    BS.size (BS.take n ps) === n+  it "splitAt should split at the correct point" $ requireProperty $ do+    ws <- forAll $ G.list (R.linear 0 10) (G.word64 R.constantBounded)+    let ps = BS.fromWord64s ws+    n  <- forAll $ G.count (R.linear 0 (BS.size ps))++    let (lt, rt) = BS.splitAt n ps+    BS.size lt === n+    BS.size rt === BS.size ps - n+    BS.toBools lt >< BS.toBools rt === BS.toBools ps+  it "firstChild should choose the first child" $ requireProperty $ do+    ws <- forAll $ G.list (R.linear 0 10) (G.word64 R.constantBounded)+    let ps = BS.fromWord64s ws+    n  <- forAll $ G.count (R.linear 0 (BS.size ps))++    BS.size (BS.drop n ps) === BS.size ps - n+  it "rose tree should be generatable" $ requireProperty $ do+    bs <- forAll $ G.list (R.linear 1 1000) G.bool++    BS.toBools (BS.fromBools bs) === bs+  it "(><) should append" $ requireTest $ do+    bs1       <- forAll $ G.list (R.linear 1 1000) G.bool+    bs2       <- forAll $ G.list (R.linear 1 1000) G.bool+    ps1       <- forAll $ pure $ BS.fromBools bs1+    ps2       <- forAll $ pure $ BS.fromBools bs2++    BS.toBools (ps1 >< ps2) === BS.toBools ps1 >< BS.toBools ps2+  it "(<|) should cons" $ requireTest $ do+    b         <- forAll $ G.bool+    bs        <- forAll $ G.list (R.linear 1 1000) G.bool+    ps        <- forAll $ pure $ BS.fromBools bs++    BS.toBools (b <| ps) === b:BS.toBools ps+  it "(|>) should snoc" $ requireTest $ do+    b         <- forAll $ G.bool+    bs        <- forAll $ G.list (R.linear 1 1000) G.bool+    ps        <- forAll $ pure $ BS.fromBools bs++    BS.toBools (ps |> b) === BS.toBools ps <> [b]+  it "select1" $ requireTest $ do+    n         <- forAll $ G.count (R.linear 0 1000)+    bools     <- forAll $ G.list (R.singleton (fromIntegral n)) G.bool+    bs        <- forAll $ pure $ BS.fromBools bools+    i         <- forAll $ G.count (R.linear 0 n)++    select1 bools i === select1 bs i+  it "rank1" $ requireTest $ do+    n         <- forAll $ G.count (R.linear 0 1000)+    bools     <- forAll $ G.list (R.singleton (fromIntegral n)) G.bool+    bs        <- forAll $ pure $ BS.fromBools bools+    i         <- forAll $ G.count (R.linear 0 (popCount1 bools))++    rank1 bools i === rank1 bs i+  it "popCount1" $ requireTest $ do+    bools     <- forAll $ G.list (R.linear 0 1000) G.bool+    bs        <- forAll $ pure $ BS.fromBools bools++    popCount1 bools === popCount1 bs

@@ -1,8 +1,10 @@-{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}+ module HaskellWorks.Data.RankSelect.InternalSpec (spec) where +import Data.Maybe import HaskellWorks.Data.Bits.BitRead import HaskellWorks.Data.Bits.PopCount.PopCount1 import HaskellWorks.Data.RankSelect.Base.Rank@@ -22,16 +24,16 @@ spec = describe "HaskellWorks.Data.RankSelect.InternalSpec" $ do   describe "For [Bool]" $ do     it "rank True 10010010 over [0..8] should be 011122233" $ requireProperty $ do-      let (Just bs) = bitRead "10010010" :: Maybe [Bool]+      let bs = fromJust $ bitRead "10010010" :: [Bool]       fmap (rank True bs) [0..8] === [0, 1, 1, 1, 2, 2, 2, 3, 3]     it "rank True 10010010 over [0..8] should be 001223445" $ requireProperty $ do-      let (Just bs) = bitRead "10010010" :: Maybe [Bool]+      let bs = fromJust $ bitRead "10010010" :: [Bool]       fmap (rank False bs) [0..8] === [0, 0, 1, 2, 2, 3, 4, 4, 5]     it "select True 10010010 over [0..3] should be 0147" $ requireProperty $ do-      let (Just bs) = bitRead "10010010" :: Maybe [Bool]+      let bs = fromJust $ bitRead "10010010" :: [Bool]       fmap (select True bs) [0..3] === [0, 1, 4, 7]     it "select False 10010010 over [0..5] should be 023568" $ requireProperty $ do-      let (Just bs) = bitRead "10010010" :: Maybe [Bool]+      let bs = fromJust $ bitRead "10010010" :: [Bool]       fmap (select False bs) [0..5] === [0, 2, 3, 5, 6, 8]     it "Rank and select form a galois connection" $ requireProperty $ do       bs <- forAll $ G.list (R.linear 0 70) G.bool