hw-rankselect 0.2.0.0 → 0.2.0.1
raw patch · 26 files changed
+1664/−521 lines, 26 filesdep ~hw-prim
Dependency ranges changed: hw-prim
Files
- hw-rankselect.cabal +13/−2
- src/HaskellWorks/Data/Succinct/BalancedParens/Internal.hs +131/−80
- src/HaskellWorks/Data/Succinct/BalancedParens/NewCloseAt.hs +60/−0
- src/HaskellWorks/Data/Succinct/BalancedParens/NewOpenAt.hs +59/−0
- src/HaskellWorks/Data/Succinct/BalancedParens/RangeMinMax.hs +7/−89
- src/HaskellWorks/Data/Succinct/BalancedParens/RangeMinMax/Internal.hs +38/−0
- src/HaskellWorks/Data/Succinct/BalancedParens/RangeMinMax/L0.hs +119/−0
- src/HaskellWorks/Data/Succinct/BalancedParens/RangeMinMax/L1.hs +122/−0
- src/HaskellWorks/Data/Succinct/BalancedParens/RangeMinMax/L2.hs +123/−0
- src/HaskellWorks/Data/Succinct/BalancedParens/RangeMinMax/L3.hs +124/−0
- src/HaskellWorks/Data/Succinct/BalancedParens/RangeMinMax/Simple.hs +72/−0
- src/HaskellWorks/Data/Succinct/BalancedParens/Simple.hs +1/−1
- src/HaskellWorks/Data/Succinct/Excess/MinMaxExcess0.hs +109/−8
- src/HaskellWorks/Data/Succinct/Excess/MinMaxExcess1.hs +109/−8
- src/HaskellWorks/Data/Succinct/RankSelect/Binary/Basic/Rank0.hs +17/−17
- src/HaskellWorks/Data/Succinct/RankSelect/Binary/Basic/Select1.hs +17/−17
- src/HaskellWorks/Data/Succinct/RankSelect/Binary/Poppy512.hs +19/−13
- src/HaskellWorks/Data/Succinct/RankSelect/Binary/Poppy512S.hs +11/−7
- test/HaskellWorks/Data/Succinct/BalancedParens/RangeMinMax/L0Spec.hs +56/−0
- test/HaskellWorks/Data/Succinct/BalancedParens/RangeMinMax/L1Spec.hs +72/−0
- test/HaskellWorks/Data/Succinct/BalancedParens/RangeMinMax/L2Spec.hs +72/−0
- test/HaskellWorks/Data/Succinct/BalancedParens/RangeMinMax/L3Spec.hs +72/−0
- test/HaskellWorks/Data/Succinct/BalancedParens/RangeMinMaxSpec.hs +0/−57
- test/HaskellWorks/Data/Succinct/BalancedParens/SimpleSpec.hs +55/−36
- test/HaskellWorks/Data/Succinct/Excess/MinMaxExcess0Spec.hs +93/−93
- test/HaskellWorks/Data/Succinct/Excess/MinMaxExcess1Spec.hs +93/−93
hw-rankselect.cabal view
@@ -1,5 +1,5 @@ name: hw-rankselect-version: 0.2.0.0+version: 0.2.0.1 synopsis: Conduits for tokenizing streams. description: Please see README.md homepage: http://github.com/haskell-works/hw-rankselect#readme@@ -25,7 +25,15 @@ hs-source-dirs: src exposed-modules: HaskellWorks.Data.Succinct.BalancedParens , HaskellWorks.Data.Succinct.BalancedParens.Internal+ , HaskellWorks.Data.Succinct.BalancedParens.NewCloseAt+ , HaskellWorks.Data.Succinct.BalancedParens.NewOpenAt , HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax+ , HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax.Internal+ , HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax.L0+ , HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax.L1+ , HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax.L2+ , HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax.L3+ , HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax.Simple , HaskellWorks.Data.Succinct.BalancedParens.Simple , HaskellWorks.Data.Succinct.Excess , HaskellWorks.Data.Succinct.Excess.Excess0@@ -57,7 +65,10 @@ type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Spec.hs- other-modules: HaskellWorks.Data.Succinct.BalancedParens.RangeMinMaxSpec+ other-modules: HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax.L0Spec+ , HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax.L1Spec+ , HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax.L2Spec+ , HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax.L3Spec , HaskellWorks.Data.Succinct.BalancedParens.SimpleSpec , HaskellWorks.Data.Succinct.Excess.MinMaxExcess0Spec , HaskellWorks.Data.Succinct.Excess.MinMaxExcess1Spec
src/HaskellWorks/Data/Succinct/BalancedParens/Internal.hs view
@@ -2,7 +2,9 @@ module HaskellWorks.Data.Succinct.BalancedParens.Internal ( BalancedParens(..)- -- , depth+ , OpenAt(..)+ , CloseAt(..)+ , depth , subtreeSize ) where @@ -13,37 +15,46 @@ import HaskellWorks.Data.Bits.BitShown import HaskellWorks.Data.Bits.BitWise import HaskellWorks.Data.Positioning--- import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank0--- import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1+import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank0+import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1 -class BalancedParens v where+class OpenAt v where openAt :: v -> Count -> Bool++class CloseAt v where closeAt :: v -> Count -> Bool++class (OpenAt v, CloseAt v) => BalancedParens v where -- TODO Second argument should be Int- -- findOpenN :: v -> Count -> Count -> Maybe Count+ findOpenN :: v -> Count -> Count -> Maybe Count findCloseN :: v -> Count -> Count -> Maybe Count - -- enclose :: v -> Count -> Maybe Count+ enclose :: v -> Count -> Maybe Count firstChild :: v -> Count -> Maybe Count nextSibling :: v -> Count -> Maybe Count- -- parent :: v -> Count -> Maybe Count- -- findOpen :: v -> Count -> Maybe Count+ parent :: v -> Count -> Maybe Count+ findOpen :: v -> Count -> Maybe Count findClose :: v -> Count -> Maybe Count- -- findOpen v p = if v `openAt` p then Just p else findOpenN v (Count 1) (p - 1)+ findOpen v p = if v `openAt` p then Just p else findOpenN v (Count 0) (p - 1) findClose v p = if v `closeAt` p then Just p else findCloseN v (Count 1) (p + 1) firstChild v p = if openAt v p && openAt v (p + 1) then Just (p + 1) else Nothing- nextSibling v p = if closeAt v p then Nothing else openAt v `mfilter` (findClose v p >>= (\q -> if p /= q then return (q + 1) else Nothing))- -- parent v p = enclose v p >>= (\r -> if r >= 1 then return r else Nothing)- -- enclose v = findOpenN v (Count 1)- -- {-# INLINE findOpen #-}+ nextSibling v p = if closeAt v p+ then Nothing+ else openAt v `mfilter` (findClose v p >>= (\q ->+ if p /= q+ then return (q + 1)+ else Nothing))+ parent v p = enclose v p >>= (\r -> if r >= 1 then return r else Nothing)+ enclose v = findOpenN v (Count 1)+ {-# INLINE findOpen #-} {-# INLINE findClose #-} {-# INLINE firstChild #-} {-# INLINE nextSibling #-}- -- {-# INLINE parent #-}- -- {-# INLINE enclose #-}+ {-# INLINE parent #-}+ {-# INLINE enclose #-} --- depth :: (BalancedParens v, Rank0 v, Rank1 v) => v -> Count -> Maybe Count--- depth v p = (\q -> rank1 v q - rank0 v q) <$> findOpen v p+depth :: (BalancedParens v, Rank0 v, Rank1 v) => v -> Count -> Maybe Count+depth v p = (\q -> rank1 v q - rank0 v q) <$> findOpen v p subtreeSize :: BalancedParens v => v -> Count -> Maybe Count subtreeSize v p = (\q -> (q - p + 1) `quot` 2) <$> findClose v p@@ -52,21 +63,21 @@ closeAt' v c = not (v .?. toPosition (c - 1)) {-# INLINE closeAt' #-} -openAt' :: TestBit a => a -> Count -> Bool-openAt' v c = v .?. toPosition (c - 1)+openAt' :: (BitLength a, TestBit a) => a -> Count -> Bool+openAt' v c = (0 <= c && c < bitLength v) && (v .?. toPosition (c - 1)) {-# INLINE openAt' #-} ----- --- findOpen' :: (BitLength a, TestBit a) => a -> Count -> Count -> Maybe Count--- findOpen' v c p = if 0 < p && p <= bitLength v--- then if v `openAt'` p--- then if c == 0--- then Just p--- else findOpen' v (c - 1) (p - 1)--- else findOpen' v (c + 1) (p - 1)--- else Nothing--- {-# INLINE findOpen' #-}+findOpen' :: (BitLength a, TestBit a) => a -> Count -> Count -> Maybe Count+findOpen' v c p = if 0 < p && p <= bitLength v+ then if v `openAt'` p+ then if c == 0+ then Just p+ else findOpen' v (c - 1) (p - 1)+ else findOpen' v (c + 1) (p - 1)+ else Nothing+{-# INLINE findOpen' #-} findClose' :: (BitLength a, TestBit a) => a -> Count -> Count -> Maybe Count findClose' v c p = if 0 < p && p <= bitLength v@@ -78,102 +89,142 @@ else Nothing {-# INLINE findClose' #-} -instance (BalancedParens a, TestBit a, BitLength a) => BalancedParens (BitShown a) where- openAt = openAt' . bitShown- closeAt = closeAt' . bitShown- -- findOpenN = findOpen' . bitShown- findCloseN = findClose' . bitShown+instance (BitLength a, TestBit a) => OpenAt (BitShown a) where+ openAt = openAt' . bitShown {-# INLINE openAt #-}++instance (BitLength a, TestBit a) => CloseAt (BitShown a) where+ closeAt = closeAt' . bitShown {-# INLINE closeAt #-}- -- {-# INLINE findOpenN #-}++instance (BalancedParens a, TestBit a, BitLength a) => BalancedParens (BitShown a) where+ findOpenN = findOpen' . bitShown+ findCloseN = findClose' . bitShown+ {-# INLINE findOpenN #-} {-# INLINE findCloseN #-} +instance OpenAt [Bool] where+ openAt = openAt'+ {-# INLINE openAt #-}++instance CloseAt [Bool] where+ closeAt = closeAt'+ {-# INLINE closeAt #-}+ instance BalancedParens [Bool] where- openAt = openAt'- closeAt = closeAt'- -- findOpenN = findOpen'+ findOpenN = findOpen' findCloseN = findClose'+ {-# INLINE findOpenN #-}+ {-# INLINE findCloseN #-}++instance OpenAt (DVS.Vector Word8) where+ openAt = openAt' {-# INLINE openAt #-}++instance CloseAt (DVS.Vector Word8) where+ closeAt = closeAt' {-# INLINE closeAt #-}- -- {-# INLINE findOpenN #-}- {-# INLINE findCloseN #-} instance BalancedParens (DVS.Vector Word8) where- openAt = openAt'- closeAt = closeAt'- -- findOpenN = findOpen'+ findOpenN = findOpen' findCloseN = findClose'+ {-# INLINE findOpenN #-}+ {-# INLINE findCloseN #-}++instance OpenAt (DVS.Vector Word16) where+ openAt = openAt' {-# INLINE openAt #-}++instance CloseAt (DVS.Vector Word16) where+ closeAt = closeAt' {-# INLINE closeAt #-}- -- {-# INLINE findOpenN #-}- {-# INLINE findCloseN #-} instance BalancedParens (DVS.Vector Word16) where- openAt = openAt'- closeAt = closeAt'- -- findOpenN = findOpen'+ findOpenN = findOpen' findCloseN = findClose'+ {-# INLINE findOpenN #-}+ {-# INLINE findCloseN #-}++instance OpenAt (DVS.Vector Word32) where+ openAt = openAt' {-# INLINE openAt #-}++instance CloseAt (DVS.Vector Word32) where+ closeAt = closeAt' {-# INLINE closeAt #-}- -- {-# INLINE findOpenN #-}- {-# INLINE findCloseN #-} instance BalancedParens (DVS.Vector Word32) where- openAt = openAt'- closeAt = closeAt'- -- findOpenN = findOpen'+ findOpenN = findOpen' findCloseN = findClose'+ {-# INLINE findOpenN #-}+ {-# INLINE findCloseN #-}++instance OpenAt (DVS.Vector Word64) where+ openAt = openAt' {-# INLINE openAt #-}++instance CloseAt (DVS.Vector Word64) where+ closeAt = closeAt' {-# INLINE closeAt #-}- -- {-# INLINE findOpenN #-}- {-# INLINE findCloseN #-} instance BalancedParens (DVS.Vector Word64) where- openAt = openAt'- closeAt = closeAt'- -- findOpenN = findOpen'+ findOpenN = findOpen' findCloseN = findClose'+ {-# INLINE findOpenN #-}+ {-# INLINE findCloseN #-}++instance OpenAt Word8 where+ openAt = openAt' {-# INLINE openAt #-}++instance CloseAt Word8 where+ closeAt = closeAt' {-# INLINE closeAt #-}- -- {-# INLINE findOpenN #-}- {-# INLINE findCloseN #-} instance BalancedParens Word8 where- openAt = openAt'- closeAt = closeAt'- -- findOpenN = findOpen'+ findOpenN = findOpen' findCloseN = findClose'+ {-# INLINE findOpenN #-}+ {-# INLINE findCloseN #-}++instance OpenAt Word16 where+ openAt = openAt' {-# INLINE openAt #-}++instance CloseAt Word16 where+ closeAt = closeAt' {-# INLINE closeAt #-}- -- {-# INLINE findOpenN #-}- {-# INLINE findCloseN #-} instance BalancedParens Word16 where- openAt = openAt'- closeAt = closeAt'- -- findOpenN = findOpen'+ findOpenN = findOpen' findCloseN = findClose'+ {-# INLINE findOpenN #-}+ {-# INLINE findCloseN #-}++instance OpenAt Word32 where+ openAt = openAt' {-# INLINE openAt #-}++instance CloseAt Word32 where+ closeAt = closeAt' {-# INLINE closeAt #-}- -- {-# INLINE findOpenN #-}- {-# INLINE findCloseN #-} instance BalancedParens Word32 where- openAt = openAt'- closeAt = closeAt'- -- findOpenN = findOpen'+ findOpenN = findOpen' findCloseN = findClose'+ {-# INLINE findOpenN #-}+ {-# INLINE findCloseN #-}++instance OpenAt Word64 where+ openAt = openAt' {-# INLINE openAt #-}++instance CloseAt Word64 where+ closeAt = closeAt' {-# INLINE closeAt #-}- -- {-# INLINE findOpenN #-}- {-# INLINE findCloseN #-} instance BalancedParens Word64 where- openAt = openAt'- closeAt = closeAt'- -- findOpenN = findOpen'+ findOpenN = findOpen' findCloseN = findClose'- {-# INLINE openAt #-}- {-# INLINE closeAt #-}- -- {-# INLINE findOpenN #-}+ {-# INLINE findOpenN #-} {-# INLINE findCloseN #-}
+ src/HaskellWorks/Data/Succinct/BalancedParens/NewCloseAt.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE FlexibleInstances #-}++module HaskellWorks.Data.Succinct.BalancedParens.NewCloseAt+ ( NewCloseAt(..)+ , newCloseAt'+ ) where++import qualified Data.Vector.Storable as DVS+import Data.Word+import HaskellWorks.Data.Bits.BitLength+import HaskellWorks.Data.Bits.BitShown+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Positioning++class NewCloseAt v where+ newCloseAt :: v -> Count -> Bool++newCloseAt' :: TestBit a => a -> Count -> Bool+newCloseAt' v c = not (v .?. toPosition c)+{-# INLINE newCloseAt' #-}++instance (BitLength a, TestBit a) => NewCloseAt (BitShown a) where+ newCloseAt = newCloseAt' . bitShown+ {-# INLINE newCloseAt #-}++instance NewCloseAt [Bool] where+ newCloseAt = newCloseAt'+ {-# INLINE newCloseAt #-}++instance NewCloseAt (DVS.Vector Word8) where+ newCloseAt = newCloseAt'+ {-# INLINE newCloseAt #-}++instance NewCloseAt (DVS.Vector Word16) where+ newCloseAt = newCloseAt'+ {-# INLINE newCloseAt #-}++instance NewCloseAt (DVS.Vector Word32) where+ newCloseAt = newCloseAt'+ {-# INLINE newCloseAt #-}++instance NewCloseAt (DVS.Vector Word64) where+ newCloseAt = newCloseAt'+ {-# INLINE newCloseAt #-}++instance NewCloseAt Word8 where+ newCloseAt = newCloseAt'+ {-# INLINE newCloseAt #-}++instance NewCloseAt Word16 where+ newCloseAt = newCloseAt'+ {-# INLINE newCloseAt #-}++instance NewCloseAt Word32 where+ newCloseAt = newCloseAt'+ {-# INLINE newCloseAt #-}++instance NewCloseAt Word64 where+ newCloseAt = newCloseAt'+ {-# INLINE newCloseAt #-}
+ src/HaskellWorks/Data/Succinct/BalancedParens/NewOpenAt.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE FlexibleInstances #-}++module HaskellWorks.Data.Succinct.BalancedParens.NewOpenAt+ ( NewOpenAt(..)+ ) where++import qualified Data.Vector.Storable as DVS+import Data.Word+import HaskellWorks.Data.Bits.BitLength+import HaskellWorks.Data.Bits.BitShown+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Positioning++class NewOpenAt v where+ newOpenAt :: v -> Count -> Bool++newOpenAt' :: (BitLength a, TestBit a) => a -> Count -> Bool+newOpenAt' v c = (0 <= c && c < bitLength v) && (v .?. toPosition c)+{-# INLINE newOpenAt' #-}++instance (BitLength a, TestBit a) => NewOpenAt (BitShown a) where+ newOpenAt = newOpenAt' . bitShown+ {-# INLINE newOpenAt #-}++instance NewOpenAt [Bool] where+ newOpenAt = newOpenAt'+ {-# INLINE newOpenAt #-}++instance NewOpenAt (DVS.Vector Word8) where+ newOpenAt = newOpenAt'+ {-# INLINE newOpenAt #-}++instance NewOpenAt (DVS.Vector Word16) where+ newOpenAt = newOpenAt'+ {-# INLINE newOpenAt #-}++instance NewOpenAt (DVS.Vector Word32) where+ newOpenAt = newOpenAt'+ {-# INLINE newOpenAt #-}++instance NewOpenAt (DVS.Vector Word64) where+ newOpenAt = newOpenAt'+ {-# INLINE newOpenAt #-}++instance NewOpenAt Word8 where+ newOpenAt = newOpenAt'+ {-# INLINE newOpenAt #-}++instance NewOpenAt Word16 where+ newOpenAt = newOpenAt'+ {-# INLINE newOpenAt #-}++instance NewOpenAt Word32 where+ newOpenAt = newOpenAt'+ {-# INLINE newOpenAt #-}++instance NewOpenAt Word64 where+ newOpenAt = newOpenAt'+ {-# INLINE newOpenAt #-}
src/HaskellWorks/Data/Succinct/BalancedParens/RangeMinMax.hs view
@@ -1,93 +1,11 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE InstanceSigs #-} module HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax- ( RangeMinMaxL0(..)- , mkRangeMinMaxL0+ ( module X ) where -import Data.Int-import qualified Data.Vector as DV-import qualified Data.Vector.Storable as DVS-import Data.Word-import HaskellWorks.Data.Bits.BitLength-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.Excess.MinMaxExcess1-import HaskellWorks.Data.Vector.VectorLike--data RangeMinMaxL0 v = RangeMinMaxL0- { rangeMinMaxBP :: v- , rangeMinMaxL0Min :: DVS.Vector Int8- , rangeMinMaxL0Max :: DVS.Vector Int8- , rangeMinMaxL0Excess :: DVS.Vector Int8- }--mkRangeMinMaxL0 :: (VectorLike v, MinMaxExcess1 (Elem v)) => v -> RangeMinMaxL0 v-mkRangeMinMaxL0 bp = RangeMinMaxL0- { rangeMinMaxBP = bp- , rangeMinMaxL0Min = DVS.constructN (len0 + 1) (\v -> let (minE, _, _) = allMinMax DV.! DVS.length v in fromIntegral minE)- , rangeMinMaxL0Max = DVS.constructN (len0 + 1) (\v -> let (_, _, maxE) = allMinMax DV.! DVS.length v in fromIntegral maxE)- , rangeMinMaxL0Excess = DVS.constructN (len0 + 1) (\v -> let (_, e, _) = allMinMax DV.! DVS.length v in fromIntegral e)- }- where len0 = fromIntegral (vLength bp) :: Int- allMinMax = DV.constructN (len0 + 1) genMinMax- genMinMax v = let len = DV.length v in- if len == len0- then (0, 0, 0)- else minMaxExcess1 (bp !!! fromIntegral len)--instance TestBit (RangeMinMaxL0 (DVS.Vector Word64)) where- (.?.) = (.?.) . rangeMinMaxBP- {-# INLINE (.?.) #-}--instance Rank1 (RangeMinMaxL0 (DVS.Vector Word64)) where- rank1 = rank1 . rangeMinMaxBP- {-# INLINE rank1 #-}--instance Rank0 (RangeMinMaxL0 (DVS.Vector Word64)) where- rank0 = rank0 . rangeMinMaxBP- {-# INLINE rank0 #-}--instance BitLength (RangeMinMaxL0 (DVS.Vector Word64)) where- bitLength = bitLength . rangeMinMaxBP- {-# INLINE bitLength #-}--rangeMinMaxFindCloseN :: RangeMinMaxL0 (DVS.Vector Word64) -> Int -> Count -> Maybe Count-rangeMinMaxFindCloseN v s p = result- where bp = rangeMinMaxBP v- mins = rangeMinMaxL0Min v- excesses = rangeMinMaxL0Excess v- findCloseN' = if v `closeAt` p- then if s <= 1- then Just p- else rangeMinMaxFindCloseN v (s - 1) (p + 1)- else rangeMinMaxFindCloseN v (s + 1) (p + 1)- result = if 0 < p && p <= bitLength v- then if (p - 1) `mod` elemBitLength bp == 0- then let i = (p - 1) `div` elemBitLength bp in- let minE = fromIntegral (mins !!! fromIntegral i) :: Int in- if fromIntegral s + minE <= 0- then findCloseN'- else if v `closeAt` p && s <= 1- then Just p- else let excess = fromIntegral (excesses !!! fromIntegral i) :: Int in- rangeMinMaxFindCloseN v (fromIntegral (excess + fromIntegral s)) (p + 64)- else findCloseN'- else Nothing-{-# INLINE rangeMinMaxFindCloseN #-}--instance BalancedParens (RangeMinMaxL0 (DVS.Vector Word64)) where- openAt = openAt . rangeMinMaxBP- closeAt = closeAt . rangeMinMaxBP- -- findOpenN = findOpenN . rangeMinMaxBP- findCloseN v s = rangeMinMaxFindCloseN v (fromIntegral s)-- {-# INLINE openAt #-}- {-# INLINE closeAt #-}- -- {-# INLINE findOpenN #-}- {-# INLINE findCloseN #-}+import HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax.Internal as X+import HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax.L0 as X+import HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax.L1 as X+import HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax.L2 as X+import HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax.L3 as X+import HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax.Simple as X
+ src/HaskellWorks/Data/Succinct/BalancedParens/RangeMinMax/Internal.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE TypeFamilies #-}++module HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax.Internal+ ( RangeMinMax(..)+ , RangeMinMaxDerived(..)+ , RangeMinMaxLevel(..)+ , (<||>)+ ) where++import HaskellWorks.Data.Bits.BitLength+import HaskellWorks.Data.Positioning+import HaskellWorks.Data.Succinct.BalancedParens.Internal++class RangeMinMaxLevel v where+ rmmFactor :: v -> Int+ rmmBinWords :: v -> Int+ rmmBins :: v -> Int+ rmmBinBits :: v -> Count+ rmmBinBits v = fromIntegral (rmmBinWords v * 64)+ {-# INLINE rmmBinBits #-}++class RangeMinMaxDerived v where+ type RangeMinMaxBase v+ rmmBase :: v -> RangeMinMaxBase v++class (OpenAt v, CloseAt v, BitLength v) => RangeMinMax v where+ rmmFindCloseDispatch :: v -> Int -> Count -> Maybe Count+ rmmFindCloseN :: v -> Int -> Count -> Maybe Count+ rmmFindClose :: v -> Int -> Count -> Maybe Count+ rmmFindClose v s p = if 0 <= p && p < bitLength v+ then rmmFindCloseDispatch v s p+ else Nothing+ {-# INLINE rmmFindClose #-}++(<||>) :: Maybe a -> Maybe a -> Maybe a+(<||>) ma mb = case ma of+ Just _ -> ma+ Nothing -> mb
+ src/HaskellWorks/Data/Succinct/BalancedParens/RangeMinMax/L0.hs view
@@ -0,0 +1,119 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE TypeFamilies #-}++module HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax.L0+ ( RangeMinMaxL0(..)+ , mkRangeMinMaxL0+ ) where++import Data.Int+import qualified Data.Vector as DV+import qualified Data.Vector.Storable as DVS+import Data.Word+import HaskellWorks.Data.Bits.BitLength+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Succinct.BalancedParens.Internal+import HaskellWorks.Data.Succinct.BalancedParens.NewCloseAt+import HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax.Internal+import HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax.Simple+import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank0+import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1+import HaskellWorks.Data.Succinct.Excess.MinMaxExcess1+import HaskellWorks.Data.Vector.VectorLike++data RangeMinMaxL0 = RangeMinMaxL0+ { rangeMinMaxSimple :: !RangeMinMaxSimple+ , rangeMinMaxL0Min :: !(DVS.Vector Int8)+ , rangeMinMaxL0Max :: !(DVS.Vector Int8)+ , rangeMinMaxL0Excess :: !(DVS.Vector Int8)+ }++instance RangeMinMaxLevel RangeMinMaxL0 where+ rmmFactor _ = 1+ rmmBinWords _ = 1+ rmmBins = DVS.length . rangeMinMaxL0Min+ {-# INLINE rmmFactor #-}+ {-# INLINE rmmBinWords #-}+ {-# INLINE rmmBins #-}++class MkRangeMinMaxL0 a where+ mkRangeMinMaxL0 :: a -> RangeMinMaxL0++instance MkRangeMinMaxL0 RangeMinMaxSimple where+ mkRangeMinMaxL0 simple = RangeMinMaxL0+ { rangeMinMaxSimple = simple+ , rangeMinMaxL0Min = DVS.constructN (len0 + 1) (\v -> let (minE, _, _) = allMinMax DV.! DVS.length v in fromIntegral minE)+ , rangeMinMaxL0Max = DVS.constructN (len0 + 1) (\v -> let (_, _, maxE) = allMinMax DV.! DVS.length v in fromIntegral maxE)+ , rangeMinMaxL0Excess = DVS.constructN (len0 + 1) (\v -> let (_, e, _) = allMinMax DV.! DVS.length v in fromIntegral e)+ }+ where len0 = fromIntegral (vLength (rangeMinMaxSimpleBP simple)) :: Int+ allMinMax = DV.constructN (len0 + 1) genMinMax+ genMinMax v = let len = DV.length v in+ if len == len0+ then (0, 0, 0)+ else minMaxExcess1 (rangeMinMaxSimpleBP simple !!! fromIntegral len)+ {-# INLINE mkRangeMinMaxL0 #-}++instance MkRangeMinMaxL0 (DVS.Vector Word64) where+ mkRangeMinMaxL0 = mkRangeMinMaxL0 . mkRangeMinMaxSimple+ {-# INLINE mkRangeMinMaxL0 #-}++instance RangeMinMaxDerived RangeMinMaxL0 where+ type RangeMinMaxBase RangeMinMaxL0 = RangeMinMaxSimple+ rmmBase = rangeMinMaxSimple+ {-# INLINE rmmBase #-}++instance TestBit RangeMinMaxL0 where+ (.?.) = (.?.) . rangeMinMaxSimple+ {-# INLINE (.?.) #-}++instance Rank1 RangeMinMaxL0 where+ rank1 = rank1 . rangeMinMaxSimple+ {-# INLINE rank1 #-}++instance Rank0 RangeMinMaxL0 where+ rank0 = rank0 . rangeMinMaxSimple+ {-# INLINE rank0 #-}++instance BitLength RangeMinMaxL0 where+ bitLength = bitLength . rangeMinMaxSimple+ {-# INLINE bitLength #-}++instance OpenAt RangeMinMaxL0 where+ openAt = openAt . rangeMinMaxSimple+ {-# INLINE openAt #-}++instance CloseAt RangeMinMaxL0 where+ closeAt = closeAt . rangeMinMaxSimple+ {-# INLINE closeAt #-}++instance NewCloseAt RangeMinMaxL0 where+ newCloseAt = newCloseAt . rangeMinMaxSimple+ {-# INLINE newCloseAt #-}++instance RangeMinMax RangeMinMaxL0 where+ rmmFindCloseDispatch v s p = if p `mod` 64 == 0+ then rmmFindCloseN v s p+ else rmmFindCloseDispatch (rangeMinMaxSimple v) s p+ rmmFindCloseN v s p =+ let i = p `div` 64 in+ let minE = fromIntegral (mins !!! fromIntegral i) :: Int in+ if fromIntegral s + minE <= 0+ then rmmFindCloseN (rangeMinMaxSimple v) s p+ else if v `newCloseAt` p && s <= 1+ then Just p+ else let excess = fromIntegral (excesses !!! fromIntegral i) :: Int in+ rmmFindClose v (fromIntegral (excess + fromIntegral s)) (p + 64)+ where mins = rangeMinMaxL0Min v+ excesses = rangeMinMaxL0Excess v+ {-# INLINE rmmFindCloseDispatch #-}+ {-# INLINE rmmFindCloseN #-}++instance BalancedParens RangeMinMaxL0 where+ findOpenN = findOpenN . rangeMinMaxSimple+ findCloseN v s p = (+ 1) `fmap` rmmFindClose v (fromIntegral s) (p - 1)++ {-# INLINE findOpenN #-}+ {-# INLINE findCloseN #-}
+ src/HaskellWorks/Data/Succinct/BalancedParens/RangeMinMax/L1.hs view
@@ -0,0 +1,122 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE TypeFamilies #-}++module HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax.L1+ ( RangeMinMaxL1(..)+ , mkRangeMinMaxL1+ ) where++import Data.Int+import qualified Data.Vector as DV+import qualified Data.Vector.Storable as DVS+import Data.Word+import HaskellWorks.Data.Bits.BitLength+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Succinct.BalancedParens.Internal+import HaskellWorks.Data.Succinct.BalancedParens.NewCloseAt+import HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax.Internal+import HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax.L0+import HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax.Simple+import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank0+import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1+import HaskellWorks.Data.Succinct.Excess.MinMaxExcess1+import HaskellWorks.Data.Vector.VectorLike++data RangeMinMaxL1 = RangeMinMaxL1+ { rangeMinMaxL1Base :: !RangeMinMaxL0+ , rangeMinMaxL1Min :: !(DVS.Vector Int16)+ , rangeMinMaxL1Max :: !(DVS.Vector Int16)+ , rangeMinMaxL1Excess :: !(DVS.Vector Int16)+ }++instance RangeMinMaxLevel RangeMinMaxL1 where+ rmmFactor _ = 32+ rmmBinWords v = rmmFactor v * rmmBinWords (rmmBase v)+ rmmBins = DVS.length . rangeMinMaxL1Min+ {-# INLINE rmmFactor #-}+ {-# INLINE rmmBinWords #-}+ {-# INLINE rmmBins #-}++class MkRangeMinMaxL1 a where+ mkRangeMinMaxL1 :: a -> RangeMinMaxL1++instance MkRangeMinMaxL1 RangeMinMaxL0 where+ mkRangeMinMaxL1 rmmL0 = result+ where bp = rangeMinMaxSimpleBP (rangeMinMaxSimple rmmL0)+ lenL1 = (DVS.length (rangeMinMaxL0Min rmmL0) `div` rmmFactor result) + 1 :: Int+ allMinMaxL1 = DV.constructN lenL1 genMinMaxL1+ genMinMaxL1 v = let len = DV.length v in minMaxExcess1 (DVS.take (rmmBinWords result) (DVS.drop (len * rmmBinWords result) bp))+ rangeMinMaxL1ExcessA = DVS.constructN lenL1 (\v -> let (_, e, _) = allMinMaxL1 DV.! DVS.length v in fromIntegral e) :: DVS.Vector Int16+ result = RangeMinMaxL1+ { rangeMinMaxL1Base = rmmL0+ , rangeMinMaxL1Min = DVS.constructN lenL1 (\v -> let (minE, _, _) = allMinMaxL1 DV.! DVS.length v in fromIntegral minE)+ , rangeMinMaxL1Max = DVS.constructN lenL1 (\v -> let (_, _, maxE) = allMinMaxL1 DV.! DVS.length v in fromIntegral maxE)+ , rangeMinMaxL1Excess = rangeMinMaxL1ExcessA+ }++instance MkRangeMinMaxL1 RangeMinMaxSimple where+ mkRangeMinMaxL1 = mkRangeMinMaxL1 . mkRangeMinMaxL0++instance MkRangeMinMaxL1 (DVS.Vector Word64) where+ mkRangeMinMaxL1 = mkRangeMinMaxL1 . mkRangeMinMaxSimple+ {-# INLINE mkRangeMinMaxL1 #-}++instance TestBit RangeMinMaxL1 where+ (.?.) = (.?.) . rangeMinMaxL1Base+ {-# INLINE (.?.) #-}++instance Rank1 RangeMinMaxL1 where+ rank1 = rank1 . rangeMinMaxL1Base+ {-# INLINE rank1 #-}++instance Rank0 RangeMinMaxL1 where+ rank0 = rank0 . rangeMinMaxL1Base+ {-# INLINE rank0 #-}++instance BitLength RangeMinMaxL1 where+ bitLength = bitLength . rangeMinMaxL1Base+ {-# INLINE bitLength #-}++instance RangeMinMaxDerived RangeMinMaxL1 where+ type RangeMinMaxBase RangeMinMaxL1 = RangeMinMaxL0+ rmmBase = rangeMinMaxL1Base+ {-# INLINE rmmBase #-}++instance RangeMinMax RangeMinMaxL1 where+ rmmFindCloseDispatch v s p = if p `mod` rmmBinBits v == 0+ then rmmFindCloseN v s p+ else rmmFindCloseDispatch (rmmBase v) s p+ rmmFindCloseN v s p =+ let i = p `div` rmmBinBits v in+ let minE = fromIntegral (mins !!! fromIntegral i) :: Int in+ if fromIntegral s + minE <= 0+ then rmmFindCloseN (rmmBase v) s p+ else if v `newCloseAt` p && s <= 1+ then Just p+ else let excess = fromIntegral (excesses !!! fromIntegral i) :: Int in+ rmmFindClose v (fromIntegral (excess + fromIntegral s)) (p + rmmBinBits v)+ where mins = rangeMinMaxL1Min v+ excesses = rangeMinMaxL1Excess v+ {-# INLINE rmmFindCloseDispatch #-}+ {-# INLINE rmmFindCloseN #-}++instance OpenAt RangeMinMaxL1 where+ openAt = openAt . rangeMinMaxL1Base+ {-# INLINE openAt #-}++instance CloseAt RangeMinMaxL1 where+ closeAt = closeAt . rangeMinMaxL1Base+ {-# INLINE closeAt #-}++instance NewCloseAt RangeMinMaxL1 where+ newCloseAt = newCloseAt . rangeMinMaxL1Base+ {-# INLINE newCloseAt #-}++instance BalancedParens RangeMinMaxL1 where+ findOpenN = findOpenN . rangeMinMaxL1Base+ findCloseN v s p = (+ 1) `fmap` rmmFindClose v (fromIntegral s) (p - 1)++ {-# INLINE findOpenN #-}+ {-# INLINE findCloseN #-}
+ src/HaskellWorks/Data/Succinct/BalancedParens/RangeMinMax/L2.hs view
@@ -0,0 +1,123 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE TypeFamilies #-}++module HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax.L2+ ( RangeMinMaxL2(..)+ , mkRangeMinMaxL2+ ) where++import Data.Int+import qualified Data.Vector as DV+import qualified Data.Vector.Storable as DVS+import Data.Word+import HaskellWorks.Data.Bits.BitLength+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Succinct.BalancedParens.Internal+import HaskellWorks.Data.Succinct.BalancedParens.NewCloseAt+import HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax.Internal+import HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax.L0+import HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax.L1+import HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax.Simple+import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank0+import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1+import HaskellWorks.Data.Succinct.Excess.MinMaxExcess1+import HaskellWorks.Data.Vector.VectorLike++data RangeMinMaxL2 = RangeMinMaxL2+ { rangeMinMaxL2Base :: !RangeMinMaxL1+ , rangeMinMaxL2Min :: !(DVS.Vector Int16)+ , rangeMinMaxL2Max :: !(DVS.Vector Int16)+ , rangeMinMaxL2Excess :: !(DVS.Vector Int16)+ }++instance RangeMinMaxLevel RangeMinMaxL2 where+ rmmFactor _ = 32+ rmmBinWords v = rmmFactor v * rmmBinWords (rmmBase v)+ rmmBins = DVS.length . rangeMinMaxL2Min+ {-# INLINE rmmFactor #-}+ {-# INLINE rmmBinWords #-}+ {-# INLINE rmmBins #-}++class MkRangeMinMaxL2 a where+ mkRangeMinMaxL2 :: a -> RangeMinMaxL2++instance MkRangeMinMaxL2 RangeMinMaxL1 where+ mkRangeMinMaxL2 rmmL1 = result+ where bp = rangeMinMaxSimpleBP (rangeMinMaxSimple (rangeMinMaxL1Base rmmL1))+ lenL2 = (DVS.length (rangeMinMaxL1Min rmmL1) `div` rmmFactor result) + 1 :: Int+ allMinMaxL2 = DV.constructN lenL2 genMinMaxL2+ genMinMaxL2 v = let len = DV.length v in minMaxExcess1 (DVS.take (rmmBinWords result) (DVS.drop (len * rmmBinWords result) bp))+ rangeMinMaxL2ExcessA = DVS.constructN lenL2 (\v -> let (_, e, _) = allMinMaxL2 DV.! DVS.length v in fromIntegral e) :: DVS.Vector Int16+ result = RangeMinMaxL2+ { rangeMinMaxL2Base = rmmL1+ , rangeMinMaxL2Min = DVS.constructN lenL2 (\v -> let (minE, _, _) = allMinMaxL2 DV.! DVS.length v in fromIntegral minE)+ , rangeMinMaxL2Max = DVS.constructN lenL2 (\v -> let (_, _, maxE) = allMinMaxL2 DV.! DVS.length v in fromIntegral maxE)+ , rangeMinMaxL2Excess = rangeMinMaxL2ExcessA+ }++instance MkRangeMinMaxL2 RangeMinMaxSimple where+ mkRangeMinMaxL2 = mkRangeMinMaxL2 . mkRangeMinMaxL1++instance MkRangeMinMaxL2 (DVS.Vector Word64) where+ mkRangeMinMaxL2 = mkRangeMinMaxL2 . mkRangeMinMaxSimple+ {-# INLINE mkRangeMinMaxL2 #-}++instance TestBit RangeMinMaxL2 where+ (.?.) = (.?.) . rangeMinMaxL2Base+ {-# INLINE (.?.) #-}++instance Rank1 RangeMinMaxL2 where+ rank1 = rank1 . rangeMinMaxL2Base+ {-# INLINE rank1 #-}++instance Rank0 RangeMinMaxL2 where+ rank0 = rank0 . rangeMinMaxL2Base+ {-# INLINE rank0 #-}++instance BitLength RangeMinMaxL2 where+ bitLength = bitLength . rangeMinMaxL2Base+ {-# INLINE bitLength #-}++instance RangeMinMaxDerived RangeMinMaxL2 where+ type RangeMinMaxBase RangeMinMaxL2 = RangeMinMaxL1+ rmmBase = rangeMinMaxL2Base+ {-# INLINE rmmBase #-}++instance RangeMinMax RangeMinMaxL2 where+ rmmFindCloseDispatch v s p = if p `mod` rmmBinBits v == 0+ then rmmFindCloseN v s p+ else rmmFindCloseDispatch (rmmBase v) s p+ rmmFindCloseN v s p =+ let i = p `div` rmmBinBits v in+ let minE = fromIntegral (mins !!! fromIntegral i) :: Int in+ if fromIntegral s + minE <= 0+ then rmmFindCloseN (rmmBase v) s p+ else if v `newCloseAt` p && s <= 1+ then Just p+ else let excess = fromIntegral (excesses !!! fromIntegral i) :: Int in+ rmmFindClose v (fromIntegral (excess + fromIntegral s)) (p + rmmBinBits v)+ where mins = rangeMinMaxL2Min v+ excesses = rangeMinMaxL2Excess v+ {-# INLINE rmmFindCloseDispatch #-}+ {-# INLINE rmmFindCloseN #-}++instance OpenAt RangeMinMaxL2 where+ openAt = openAt . rangeMinMaxL2Base+ {-# INLINE openAt #-}++instance CloseAt RangeMinMaxL2 where+ closeAt = closeAt . rangeMinMaxL2Base+ {-# INLINE closeAt #-}++instance NewCloseAt RangeMinMaxL2 where+ newCloseAt = newCloseAt . rangeMinMaxL2Base+ {-# INLINE newCloseAt #-}++instance BalancedParens RangeMinMaxL2 where+ findOpenN = findOpenN . rangeMinMaxL2Base+ findCloseN v s p = (+ 1) `fmap` rmmFindClose v (fromIntegral s) (p - 1)++ {-# INLINE findOpenN #-}+ {-# INLINE findCloseN #-}
+ src/HaskellWorks/Data/Succinct/BalancedParens/RangeMinMax/L3.hs view
@@ -0,0 +1,124 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE TypeFamilies #-}++module HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax.L3+ ( RangeMinMaxL3(..)+ , mkRangeMinMaxL3+ ) where++import Data.Int+import qualified Data.Vector as DV+import qualified Data.Vector.Storable as DVS+import Data.Word+import HaskellWorks.Data.Bits.BitLength+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Succinct.BalancedParens.Internal+import HaskellWorks.Data.Succinct.BalancedParens.NewCloseAt+import HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax.Internal+import HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax.L0+import HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax.L1+import HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax.L2+import HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax.Simple+import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank0+import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1+import HaskellWorks.Data.Succinct.Excess.MinMaxExcess1+import HaskellWorks.Data.Vector.VectorLike++data RangeMinMaxL3 = RangeMinMaxL3+ { rangeMinMaxL3Base :: !RangeMinMaxL2+ , rangeMinMaxL3Min :: !(DVS.Vector Int16)+ , rangeMinMaxL3Max :: !(DVS.Vector Int16)+ , rangeMinMaxL3Excess :: !(DVS.Vector Int16)+ }++instance RangeMinMaxLevel RangeMinMaxL3 where+ rmmFactor _ = 32+ rmmBinWords v = rmmFactor v * rmmBinWords (rmmBase v)+ rmmBins = DVS.length . rangeMinMaxL3Min+ {-# INLINE rmmFactor #-}+ {-# INLINE rmmBinWords #-}+ {-# INLINE rmmBins #-}++class MkRangeMinMaxL3 a where+ mkRangeMinMaxL3 :: a -> RangeMinMaxL3++instance MkRangeMinMaxL3 RangeMinMaxL2 where+ mkRangeMinMaxL3 rmmL2 = result+ where bp = rangeMinMaxSimpleBP (rangeMinMaxSimple (rangeMinMaxL1Base (rangeMinMaxL2Base rmmL2)))+ lenL3 = (DVS.length (rangeMinMaxL2Min rmmL2) `div` rmmFactor result) + 1 :: Int+ allMinMaxL3 = DV.constructN lenL3 genMinMaxL3+ genMinMaxL3 v = let len = DV.length v in minMaxExcess1 (DVS.take (rmmBinWords result) (DVS.drop (len * rmmBinWords result) bp))+ rangeMinMaxL3ExcessA = DVS.constructN lenL3 (\v -> let (_, e, _) = allMinMaxL3 DV.! DVS.length v in fromIntegral e) :: DVS.Vector Int16+ result = RangeMinMaxL3+ { rangeMinMaxL3Base = rmmL2+ , rangeMinMaxL3Min = DVS.constructN lenL3 (\v -> let (minE, _, _) = allMinMaxL3 DV.! DVS.length v in fromIntegral minE)+ , rangeMinMaxL3Max = DVS.constructN lenL3 (\v -> let (_, _, maxE) = allMinMaxL3 DV.! DVS.length v in fromIntegral maxE)+ , rangeMinMaxL3Excess = rangeMinMaxL3ExcessA+ }++instance MkRangeMinMaxL3 RangeMinMaxSimple where+ mkRangeMinMaxL3 = mkRangeMinMaxL3 . mkRangeMinMaxL2++instance MkRangeMinMaxL3 (DVS.Vector Word64) where+ mkRangeMinMaxL3 = mkRangeMinMaxL3 . mkRangeMinMaxSimple+ {-# INLINE mkRangeMinMaxL3 #-}++instance TestBit RangeMinMaxL3 where+ (.?.) = (.?.) . rangeMinMaxL3Base+ {-# INLINE (.?.) #-}++instance Rank1 RangeMinMaxL3 where+ rank1 = rank1 . rangeMinMaxL3Base+ {-# INLINE rank1 #-}++instance Rank0 RangeMinMaxL3 where+ rank0 = rank0 . rangeMinMaxL3Base+ {-# INLINE rank0 #-}++instance BitLength RangeMinMaxL3 where+ bitLength = bitLength . rangeMinMaxL3Base+ {-# INLINE bitLength #-}++instance RangeMinMaxDerived RangeMinMaxL3 where+ type RangeMinMaxBase RangeMinMaxL3 = RangeMinMaxL2+ rmmBase = rangeMinMaxL3Base+ {-# INLINE rmmBase #-}++instance RangeMinMax RangeMinMaxL3 where+ rmmFindCloseDispatch v s p = if p `mod` rmmBinBits v == 0+ then rmmFindCloseN v s p+ else rmmFindCloseDispatch (rmmBase v) s p+ rmmFindCloseN v s p =+ let i = p `div` rmmBinBits v in+ let minE = fromIntegral (mins !!! fromIntegral i) :: Int in+ if fromIntegral s + minE <= 0+ then rmmFindCloseN (rmmBase v) s p+ else if v `newCloseAt` p && s <= 1+ then Just p+ else let excess = fromIntegral (excesses !!! fromIntegral i) :: Int in+ rmmFindClose v (fromIntegral (excess + fromIntegral s)) (p + rmmBinBits v)+ where mins = rangeMinMaxL3Min v+ excesses = rangeMinMaxL3Excess v+ {-# INLINE rmmFindCloseDispatch #-}+ {-# INLINE rmmFindCloseN #-}++instance OpenAt RangeMinMaxL3 where+ openAt = openAt . rangeMinMaxL3Base+ {-# INLINE openAt #-}++instance CloseAt RangeMinMaxL3 where+ closeAt = closeAt . rangeMinMaxL3Base+ {-# INLINE closeAt #-}++instance NewCloseAt RangeMinMaxL3 where+ newCloseAt = newCloseAt . rangeMinMaxL3Base+ {-# INLINE newCloseAt #-}++instance BalancedParens RangeMinMaxL3 where+ findOpenN = findOpenN . rangeMinMaxL3Base+ findCloseN v s p = (+ 1) `fmap` rmmFindClose v (fromIntegral s) (p - 1)++ {-# INLINE findOpenN #-}+ {-# INLINE findCloseN #-}
+ src/HaskellWorks/Data/Succinct/BalancedParens/RangeMinMax/Simple.hs view
@@ -0,0 +1,72 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE InstanceSigs #-}++module HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax.Simple+ ( RangeMinMaxSimple(..)+ , mkRangeMinMaxSimple+ ) where++import qualified Data.Vector.Storable as DVS+import Data.Word+import HaskellWorks.Data.Bits.BitLength+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Succinct.BalancedParens.Internal+import HaskellWorks.Data.Succinct.BalancedParens.NewCloseAt+import HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax.Internal+import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank0+import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1++data RangeMinMaxSimple = RangeMinMaxSimple+ { rangeMinMaxSimpleBP :: !(DVS.Vector Word64)+ }++mkRangeMinMaxSimple :: DVS.Vector Word64 -> RangeMinMaxSimple+mkRangeMinMaxSimple bp = RangeMinMaxSimple+ { rangeMinMaxSimpleBP = bp+ }++instance TestBit RangeMinMaxSimple where+ (.?.) = (.?.) . rangeMinMaxSimpleBP+ {-# INLINE (.?.) #-}++instance Rank1 RangeMinMaxSimple where+ rank1 = rank1 . rangeMinMaxSimpleBP+ {-# INLINE rank1 #-}++instance Rank0 RangeMinMaxSimple where+ rank0 = rank0 . rangeMinMaxSimpleBP+ {-# INLINE rank0 #-}++instance BitLength RangeMinMaxSimple where+ bitLength = bitLength . rangeMinMaxSimpleBP+ {-# INLINE bitLength #-}++instance RangeMinMax RangeMinMaxSimple where+ rmmFindCloseDispatch = rmmFindCloseN+ rmmFindCloseN v s p = if v `newCloseAt` p+ then if s <= 1+ then Just p+ else rmmFindClose v (s - 1) (p + 1)+ else rmmFindClose v (s + 1) (p + 1)+ {-# INLINE rmmFindCloseDispatch #-}+ {-# INLINE rmmFindCloseN #-}++instance OpenAt RangeMinMaxSimple where+ openAt = openAt . rangeMinMaxSimpleBP+ {-# INLINE openAt #-}++instance CloseAt RangeMinMaxSimple where+ closeAt = closeAt . rangeMinMaxSimpleBP+ {-# INLINE closeAt #-}++instance NewCloseAt RangeMinMaxSimple where+ newCloseAt = newCloseAt . rangeMinMaxSimpleBP+ {-# INLINE newCloseAt #-}++instance BalancedParens RangeMinMaxSimple where+ findOpenN = findOpenN . rangeMinMaxSimpleBP+ findCloseN v s p = (+ 1) `fmap` rmmFindClose v (fromIntegral s) (p - 1)++ {-# INLINE findOpenN #-}+ {-# INLINE findCloseN #-}
src/HaskellWorks/Data/Succinct/BalancedParens/Simple.hs view
@@ -17,7 +17,7 @@ import Prelude as P newtype SimpleBalancedParens a = SimpleBalancedParens a- deriving (BalancedParens, BitLength, BitShow, Eq, Rank0, Rank1, Select0, Select1, TestBit)+ deriving (BalancedParens, OpenAt, CloseAt, BitLength, BitShow, Eq, Rank0, Rank1, Select0, Select1, TestBit) instance Functor SimpleBalancedParens where fmap f (SimpleBalancedParens a) = SimpleBalancedParens (f a)
src/HaskellWorks/Data/Succinct/Excess/MinMaxExcess0.hs view
@@ -10,6 +10,7 @@ import Data.Word import HaskellWorks.Data.Bits.BitWise import HaskellWorks.Data.Bits.FixedBitSize+import HaskellWorks.Data.Naive type MinExcess = Int type MaxExcess = Int@@ -23,51 +24,151 @@ where go minE maxE e (x:xs) = let ne = if x then e - 1 else e + 1 in go (minE `min` ne) (maxE `max` ne) ne xs go minE maxE e _ = (minE, e, maxE)+ {-# INLINE minMaxExcess0 #-} -instance MinMaxExcess0 Word8 where- minMaxExcess0 = go 0 0 0 0+instance MinMaxExcess0 (Naive Word8) where+ minMaxExcess0 = go 0 0 0 0 . getNaive where go minE maxE e n w | n < fixedBitSize w = let ne = if w .?. fromIntegral n then e - 1 else e + 1 in go (minE `min` ne) (maxE `max` ne) ne (n + 1) w go minE maxE e _ _ = (minE, e, maxE)+ {-# INLINE minMaxExcess0 #-} -instance MinMaxExcess0 Word16 where- minMaxExcess0 = go 0 0 0 0+instance MinMaxExcess0 (Naive Word16) where+ minMaxExcess0 = go 0 0 0 0 . getNaive where go minE maxE e n w | n < fixedBitSize w = let ne = if w .?. fromIntegral n then e - 1 else e + 1 in go (minE `min` ne) (maxE `max` ne) ne (n + 1) w go minE maxE e _ _ = (minE, e, maxE)+ {-# INLINE minMaxExcess0 #-} -instance MinMaxExcess0 Word32 where- minMaxExcess0 = go 0 0 0 0+instance MinMaxExcess0 (Naive Word32) where+ minMaxExcess0 = go 0 0 0 0 . getNaive where go minE maxE e n w | n < fixedBitSize w = let ne = if w .?. fromIntegral n then e - 1 else e + 1 in go (minE `min` ne) (maxE `max` ne) ne (n + 1) w go minE maxE e _ _ = (minE, e, maxE)+ {-# INLINE minMaxExcess0 #-} -instance MinMaxExcess0 Word64 where- minMaxExcess0 = go 0 0 0 0+instance MinMaxExcess0 (Naive Word64) where+ minMaxExcess0 = go 0 0 0 0 . getNaive where go minE maxE e n w | n < fixedBitSize w = let ne = if w .?. fromIntegral n then e - 1 else e + 1 in go (minE `min` ne) (maxE `max` ne) ne (n + 1) w go minE maxE e _ _ = (minE, e, maxE)+ {-# INLINE minMaxExcess0 #-} +instance MinMaxExcess0 Word8 where+ minMaxExcess0 w = ( word8Excess0Min DVS.! fromIntegral w+ , word8Excess0 DVS.! fromIntegral w+ , word8Excess0Max DVS.! fromIntegral w+ )+ {-# INLINE minMaxExcess0 #-}++instance MinMaxExcess0 Word16 where+ minMaxExcess0 w = ( minExcessA `min` (minExcessB + allExcessA)+ , allExcessA + allExcessB+ , maxExcessA `max` (maxExcessB + allExcessA))+ where (minExcessA, allExcessA, maxExcessA) = minMaxExcess0 (fromIntegral w :: Word8)+ (minExcessB, allExcessB, maxExcessB) = minMaxExcess0 (fromIntegral (w .>. 8) :: Word8)+ {-# INLINE minMaxExcess0 #-}++instance MinMaxExcess0 Word32 where+ minMaxExcess0 w = ( minExcessA `min` (minExcessB + allExcessA)+ , allExcessA + allExcessB+ , maxExcessA `max` (maxExcessB + allExcessA))+ where (minExcessA, allExcessA, maxExcessA) = minMaxExcess0 (fromIntegral w :: Word16)+ (minExcessB, allExcessB, maxExcessB) = minMaxExcess0 (fromIntegral (w .>. 16) :: Word16)+ {-# INLINE minMaxExcess0 #-}++instance MinMaxExcess0 Word64 where+ minMaxExcess0 w = ( minExcessA `min` (minExcessB + allExcessA)+ , allExcessA + allExcessB+ , maxExcessA `max` (maxExcessB + allExcessA))+ where (minExcessA, allExcessA, maxExcessA) = minMaxExcess0 (fromIntegral w :: Word32)+ (minExcessB, allExcessB, maxExcessB) = minMaxExcess0 (fromIntegral (w .>. 32) :: Word32)+ {-# INLINE minMaxExcess0 #-}+ instance MinMaxExcess0 (DVS.Vector Word8) where minMaxExcess0 = DVS.foldl gen (0, 0, 0) where gen :: (MinExcess, Excess, MaxExcess) -> Word8 -> (MinExcess, Excess, MaxExcess) gen (minE, e, maxE) w = let (wMinE, wE, wMaxE) = minMaxExcess0 w in (minE `min` (wMinE + e), e + wE, maxE `max` (wMaxE + e))+ {-# INLINE minMaxExcess0 #-} instance MinMaxExcess0 (DVS.Vector Word16) where minMaxExcess0 = DVS.foldl gen (0, 0, 0) where gen :: (MinExcess, Excess, MaxExcess) -> Word16 -> (MinExcess, Excess, MaxExcess) gen (minE, e, maxE) w = let (wMinE, wE, wMaxE) = minMaxExcess0 w in (minE `min` (wMinE + e), e + wE, maxE `max` (wMaxE + e))+ {-# INLINE minMaxExcess0 #-} instance MinMaxExcess0 (DVS.Vector Word32) where minMaxExcess0 = DVS.foldl gen (0, 0, 0) where gen :: (MinExcess, Excess, MaxExcess) -> Word32 -> (MinExcess, Excess, MaxExcess) gen (minE, e, maxE) w = let (wMinE, wE, wMaxE) = minMaxExcess0 w in (minE `min` (wMinE + e), e + wE, maxE `max` (wMaxE + e))+ {-# INLINE minMaxExcess0 #-} instance MinMaxExcess0 (DVS.Vector Word64) where minMaxExcess0 = DVS.foldl gen (0, 0, 0) where gen :: (MinExcess, Excess, MaxExcess) -> Word64 -> (MinExcess, Excess, MaxExcess) gen (minE, e, maxE) w = let (wMinE, wE, wMaxE) = minMaxExcess0 w in (minE `min` (wMinE + e), e + wE, maxE `max` (wMaxE + e))+ {-# INLINE minMaxExcess0 #-}++word8Excess0Min :: DVS.Vector Int+word8Excess0Min = DVS.fromList+ [ 0, -1, 0, -2, 0, -1, -1, -3, 0, -1, 0, -2, 0, -2, -2, -4+ , 0, -1, 0, -2, 0, -1, -1, -3, 0, -1, -1, -3, -1, -3, -3, -5+ , 0, -1, 0, -2, 0, -1, -1, -3, 0, -1, 0, -2, 0, -2, -2, -4+ , 0, -1, 0, -2, 0, -2, -2, -4, 0, -2, -2, -4, -2, -4, -4, -6+ , 0, -1, 0, -2, 0, -1, -1, -3, 0, -1, 0, -2, 0, -2, -2, -4+ , 0, -1, 0, -2, 0, -1, -1, -3, 0, -1, -1, -3, -1, -3, -3, -5+ , 0, -1, 0, -2, 0, -1, -1, -3, 0, -1, -1, -3, -1, -3, -3, -5+ , 0, -1, -1, -3, -1, -3, -3, -5, -1, -3, -3, -5, -3, -5, -5, -7+ , 0, -1, 0, -2, 0, -1, -1, -3, 0, -1, 0, -2, 0, -2, -2, -4+ , 0, -1, 0, -2, 0, -1, -1, -3, 0, -1, -1, -3, -1, -3, -3, -5+ , 0, -1, 0, -2, 0, -1, -1, -3, 0, -1, 0, -2, 0, -2, -2, -4+ , 0, -1, 0, -2, 0, -2, -2, -4, 0, -2, -2, -4, -2, -4, -4, -6+ , 0, -1, 0, -2, 0, -1, -1, -3, 0, -1, 0, -2, 0, -2, -2, -4+ , 0, -1, 0, -2, 0, -2, -2, -4, 0, -2, -2, -4, -2, -4, -4, -6+ , 0, -1, 0, -2, 0, -2, -2, -4, 0, -2, -2, -4, -2, -4, -4, -6+ , 0, -2, -2, -4, -2, -4, -4, -6, -2, -4, -4, -6, -4, -6, -6, -8+ ]++word8Excess0 :: DVS.Vector Int+word8Excess0 = DVS.fromList+ [ 8, 6, 6, 4, 6, 4, 4, 2, 6, 4, 4, 2, 4, 2, 2, 0+ , 6, 4, 4, 2, 4, 2, 2, 0, 4, 2, 2, 0, 2, 0, 0, -2+ , 6, 4, 4, 2, 4, 2, 2, 0, 4, 2, 2, 0, 2, 0, 0, -2+ , 4, 2, 2, 0, 2, 0, 0, -2, 2, 0, 0, -2, 0, -2, -2, -4+ , 6, 4, 4, 2, 4, 2, 2, 0, 4, 2, 2, 0, 2, 0, 0, -2+ , 4, 2, 2, 0, 2, 0, 0, -2, 2, 0, 0, -2, 0, -2, -2, -4+ , 4, 2, 2, 0, 2, 0, 0, -2, 2, 0, 0, -2, 0, -2, -2, -4+ , 2, 0, 0, -2, 0, -2, -2, -4, 0, -2, -2, -4, -2, -4, -4, -6+ , 6, 4, 4, 2, 4, 2, 2, 0, 4, 2, 2, 0, 2, 0, 0, -2+ , 4, 2, 2, 0, 2, 0, 0, -2, 2, 0, 0, -2, 0, -2, -2, -4+ , 4, 2, 2, 0, 2, 0, 0, -2, 2, 0, 0, -2, 0, -2, -2, -4+ , 2, 0, 0, -2, 0, -2, -2, -4, 0, -2, -2, -4, -2, -4, -4, -6+ , 4, 2, 2, 0, 2, 0, 0, -2, 2, 0, 0, -2, 0, -2, -2, -4+ , 2, 0, 0, -2, 0, -2, -2, -4, 0, -2, -2, -4, -2, -4, -4, -6+ , 2, 0, 0, -2, 0, -2, -2, -4, 0, -2, -2, -4, -2, -4, -4, -6+ , 0, -2, -2, -4, -2, -4, -4, -6, -2, -4, -4, -6, -4, -6, -6, -8+ ]++word8Excess0Max :: DVS.Vector Int+word8Excess0Max = DVS.fromList+ [ 8, 6, 6, 4, 6, 4, 4, 2, 6, 4, 4, 2, 4, 2, 2, 0+ , 6, 4, 4, 2, 4, 2, 2, 0, 4, 2, 2, 0, 2, 0, 1, 0+ , 6, 4, 4, 2, 4, 2, 2, 0, 4, 2, 2, 0, 2, 0, 1, 0+ , 4, 2, 2, 0, 2, 0, 1, 0, 3, 1, 1, 0, 2, 0, 1, 0+ , 6, 4, 4, 2, 4, 2, 2, 0, 4, 2, 2, 0, 2, 0, 1, 0+ , 4, 2, 2, 0, 2, 0, 1, 0, 3, 1, 1, 0, 2, 0, 1, 0+ , 5, 3, 3, 1, 3, 1, 1, 0, 3, 1, 1, 0, 2, 0, 1, 0+ , 4, 2, 2, 0, 2, 0, 1, 0, 3, 1, 1, 0, 2, 0, 1, 0+ , 7, 5, 5, 3, 5, 3, 3, 1, 5, 3, 3, 1, 3, 1, 1, 0+ , 5, 3, 3, 1, 3, 1, 1, 0, 3, 1, 1, 0, 2, 0, 1, 0+ , 5, 3, 3, 1, 3, 1, 1, 0, 3, 1, 1, 0, 2, 0, 1, 0+ , 4, 2, 2, 0, 2, 0, 1, 0, 3, 1, 1, 0, 2, 0, 1, 0+ , 6, 4, 4, 2, 4, 2, 2, 0, 4, 2, 2, 0, 2, 0, 1, 0+ , 4, 2, 2, 0, 2, 0, 1, 0, 3, 1, 1, 0, 2, 0, 1, 0+ , 5, 3, 3, 1, 3, 1, 1, 0, 3, 1, 1, 0, 2, 0, 1, 0+ , 4, 2, 2, 0, 2, 0, 1, 0, 3, 1, 1, 0, 2, 0, 1, 0+ ]
src/HaskellWorks/Data/Succinct/Excess/MinMaxExcess1.hs view
@@ -10,6 +10,7 @@ import Data.Word import HaskellWorks.Data.Bits.BitWise import HaskellWorks.Data.Bits.FixedBitSize+import HaskellWorks.Data.Naive type MinExcess = Int type MaxExcess = Int@@ -23,51 +24,151 @@ where go minE maxE e (x:xs) = let ne = if x then e + 1 else e - 1 in go (minE `min` ne) (maxE `max` ne) ne xs go minE maxE e _ = (minE, e, maxE)+ {-# INLINE minMaxExcess1 #-} -instance MinMaxExcess1 Word8 where- minMaxExcess1 = go 0 0 0 0+instance MinMaxExcess1 (Naive Word8) where+ minMaxExcess1 = go 0 0 0 0 . getNaive where go minE maxE e n w | n < fixedBitSize w = let ne = if w .?. fromIntegral n then e + 1 else e - 1 in go (minE `min` ne) (maxE `max` ne) ne (n + 1) w go minE maxE e _ _ = (minE, e, maxE)+ {-# INLINE minMaxExcess1 #-} -instance MinMaxExcess1 Word16 where- minMaxExcess1 = go 0 0 0 0+instance MinMaxExcess1 (Naive Word16) where+ minMaxExcess1 = go 0 0 0 0 . getNaive where go minE maxE e n w | n < fixedBitSize w = let ne = if w .?. fromIntegral n then e + 1 else e - 1 in go (minE `min` ne) (maxE `max` ne) ne (n + 1) w go minE maxE e _ _ = (minE, e, maxE)+ {-# INLINE minMaxExcess1 #-} -instance MinMaxExcess1 Word32 where- minMaxExcess1 = go 0 0 0 0+instance MinMaxExcess1 (Naive Word32) where+ minMaxExcess1 = go 0 0 0 0 . getNaive where go minE maxE e n w | n < fixedBitSize w = let ne = if w .?. fromIntegral n then e + 1 else e - 1 in go (minE `min` ne) (maxE `max` ne) ne (n + 1) w go minE maxE e _ _ = (minE, e, maxE)+ {-# INLINE minMaxExcess1 #-} -instance MinMaxExcess1 Word64 where- minMaxExcess1 = go 0 0 0 0+instance MinMaxExcess1 (Naive Word64) where+ minMaxExcess1 = go 0 0 0 0 . getNaive where go minE maxE e n w | n < fixedBitSize w = let ne = if w .?. fromIntegral n then e + 1 else e - 1 in go (minE `min` ne) (maxE `max` ne) ne (n + 1) w go minE maxE e _ _ = (minE, e, maxE)+ {-# INLINE minMaxExcess1 #-} +instance MinMaxExcess1 Word8 where+ minMaxExcess1 w = ( word8Excess1Min DVS.! fromIntegral w+ , word8Excess1 DVS.! fromIntegral w+ , word8Excess1Max DVS.! fromIntegral w+ )+ {-# INLINE minMaxExcess1 #-}++instance MinMaxExcess1 Word16 where+ minMaxExcess1 w = ( minExcessA `min` (minExcessB + allExcessA)+ , allExcessA + allExcessB+ , maxExcessA `max` (maxExcessB + allExcessA))+ where (minExcessA, allExcessA, maxExcessA) = minMaxExcess1 (fromIntegral w :: Word8)+ (minExcessB, allExcessB, maxExcessB) = minMaxExcess1 (fromIntegral (w .>. 8) :: Word8)+ {-# INLINE minMaxExcess1 #-}++instance MinMaxExcess1 Word32 where+ minMaxExcess1 w = ( minExcessA `min` (minExcessB + allExcessA)+ , allExcessA + allExcessB+ , maxExcessA `max` (maxExcessB + allExcessA))+ where (minExcessA, allExcessA, maxExcessA) = minMaxExcess1 (fromIntegral w :: Word16)+ (minExcessB, allExcessB, maxExcessB) = minMaxExcess1 (fromIntegral (w .>. 16) :: Word16)+ {-# INLINE minMaxExcess1 #-}++instance MinMaxExcess1 Word64 where+ minMaxExcess1 w = ( minExcessA `min` (minExcessB + allExcessA)+ , allExcessA + allExcessB+ , maxExcessA `max` (maxExcessB + allExcessA))+ where (minExcessA, allExcessA, maxExcessA) = minMaxExcess1 (fromIntegral w :: Word32)+ (minExcessB, allExcessB, maxExcessB) = minMaxExcess1 (fromIntegral (w .>. 32) :: Word32)+ {-# INLINE minMaxExcess1 #-}+ instance MinMaxExcess1 (DVS.Vector Word8) where minMaxExcess1 = DVS.foldl gen (0, 0, 0) where gen :: (MinExcess, Excess, MaxExcess) -> Word8 -> (MinExcess, Excess, MaxExcess) gen (minE, e, maxE) w = let (wMinE, wE, wMaxE) = minMaxExcess1 w in (minE `min` (wMinE + e), e + wE, maxE `max` (wMaxE + e))+ {-# INLINE minMaxExcess1 #-} instance MinMaxExcess1 (DVS.Vector Word16) where minMaxExcess1 = DVS.foldl gen (0, 0, 0) where gen :: (MinExcess, Excess, MaxExcess) -> Word16 -> (MinExcess, Excess, MaxExcess) gen (minE, e, maxE) w = let (wMinE, wE, wMaxE) = minMaxExcess1 w in (minE `min` (wMinE + e), e + wE, maxE `max` (wMaxE + e))+ {-# INLINE minMaxExcess1 #-} instance MinMaxExcess1 (DVS.Vector Word32) where minMaxExcess1 = DVS.foldl gen (0, 0, 0) where gen :: (MinExcess, Excess, MaxExcess) -> Word32 -> (MinExcess, Excess, MaxExcess) gen (minE, e, maxE) w = let (wMinE, wE, wMaxE) = minMaxExcess1 w in (minE `min` (wMinE + e), e + wE, maxE `max` (wMaxE + e))+ {-# INLINE minMaxExcess1 #-} instance MinMaxExcess1 (DVS.Vector Word64) where minMaxExcess1 = DVS.foldl gen (0, 0, 0) where gen :: (MinExcess, Excess, MaxExcess) -> Word64 -> (MinExcess, Excess, MaxExcess) gen (minE, e, maxE) w = let (wMinE, wE, wMaxE) = minMaxExcess1 w in (minE `min` (wMinE + e), e + wE, maxE `max` (wMaxE + e))+ {-# INLINE minMaxExcess1 #-}++word8Excess1Min :: DVS.Vector Int+word8Excess1Min = DVS.fromList+ [ -8, -6, -6, -4, -6, -4, -4, -2, -6, -4, -4, -2, -4, -2, -2, 0+ , -6, -4, -4, -2, -4, -2, -2, 0, -4, -2, -2, 0, -2, 0, -1, 0+ , -6, -4, -4, -2, -4, -2, -2, 0, -4, -2, -2, 0, -2, 0, -1, 0+ , -4, -2, -2, 0, -2, 0, -1, 0, -3, -1, -1, 0, -2, 0, -1, 0+ , -6, -4, -4, -2, -4, -2, -2, 0, -4, -2, -2, 0, -2, 0, -1, 0+ , -4, -2, -2, 0, -2, 0, -1, 0, -3, -1, -1, 0, -2, 0, -1, 0+ , -5, -3, -3, -1, -3, -1, -1, 0, -3, -1, -1, 0, -2, 0, -1, 0+ , -4, -2, -2, 0, -2, 0, -1, 0, -3, -1, -1, 0, -2, 0, -1, 0+ , -7, -5, -5, -3, -5, -3, -3, -1, -5, -3, -3, -1, -3, -1, -1, 0+ , -5, -3, -3, -1, -3, -1, -1, 0, -3, -1, -1, 0, -2, 0, -1, 0+ , -5, -3, -3, -1, -3, -1, -1, 0, -3, -1, -1, 0, -2, 0, -1, 0+ , -4, -2, -2, 0, -2, 0, -1, 0, -3, -1, -1, 0, -2, 0, -1, 0+ , -6, -4, -4, -2, -4, -2, -2, 0, -4, -2, -2, 0, -2, 0, -1, 0+ , -4, -2, -2, 0, -2, 0, -1, 0, -3, -1, -1, 0, -2, 0, -1, 0+ , -5, -3, -3, -1, -3, -1, -1, 0, -3, -1, -1, 0, -2, 0, -1, 0+ , -4, -2, -2, 0, -2, 0, -1, 0, -3, -1, -1, 0, -2, 0, -1, 0+ ]++word8Excess1 :: DVS.Vector Int+word8Excess1 = DVS.fromList+ [ -8, -6, -6, -4, -6, -4, -4, -2, -6, -4, -4, -2, -4, -2, -2, 0+ , -6, -4, -4, -2, -4, -2, -2, 0, -4, -2, -2, 0, -2, 0, 0, 2+ , -6, -4, -4, -2, -4, -2, -2, 0, -4, -2, -2, 0, -2, 0, 0, 2+ , -4, -2, -2, 0, -2, 0, 0, 2, -2, 0, 0, 2, 0, 2, 2, 4+ , -6, -4, -4, -2, -4, -2, -2, 0, -4, -2, -2, 0, -2, 0, 0, 2+ , -4, -2, -2, 0, -2, 0, 0, 2, -2, 0, 0, 2, 0, 2, 2, 4+ , -4, -2, -2, 0, -2, 0, 0, 2, -2, 0, 0, 2, 0, 2, 2, 4+ , -2, 0, 0, 2, 0, 2, 2, 4, 0, 2, 2, 4, 2, 4, 4, 6+ , -6, -4, -4, -2, -4, -2, -2, 0, -4, -2, -2, 0, -2, 0, 0, 2+ , -4, -2, -2, 0, -2, 0, 0, 2, -2, 0, 0, 2, 0, 2, 2, 4+ , -4, -2, -2, 0, -2, 0, 0, 2, -2, 0, 0, 2, 0, 2, 2, 4+ , -2, 0, 0, 2, 0, 2, 2, 4, 0, 2, 2, 4, 2, 4, 4, 6+ , -4, -2, -2, 0, -2, 0, 0, 2, -2, 0, 0, 2, 0, 2, 2, 4+ , -2, 0, 0, 2, 0, 2, 2, 4, 0, 2, 2, 4, 2, 4, 4, 6+ , -2, 0, 0, 2, 0, 2, 2, 4, 0, 2, 2, 4, 2, 4, 4, 6+ , 0, 2, 2, 4, 2, 4, 4, 6, 2, 4, 4, 6, 4, 6, 6, 8+ ]++word8Excess1Max :: DVS.Vector Int+word8Excess1Max = DVS.fromList+ [ 0, 1, 0, 2, 0, 1, 1, 3, 0, 1, 0, 2, 0, 2, 2, 4+ , 0, 1, 0, 2, 0, 1, 1, 3, 0, 1, 1, 3, 1, 3, 3, 5+ , 0, 1, 0, 2, 0, 1, 1, 3, 0, 1, 0, 2, 0, 2, 2, 4+ , 0, 1, 0, 2, 0, 2, 2, 4, 0, 2, 2, 4, 2, 4, 4, 6+ , 0, 1, 0, 2, 0, 1, 1, 3, 0, 1, 0, 2, 0, 2, 2, 4+ , 0, 1, 0, 2, 0, 1, 1, 3, 0, 1, 1, 3, 1, 3, 3, 5+ , 0, 1, 0, 2, 0, 1, 1, 3, 0, 1, 1, 3, 1, 3, 3, 5+ , 0, 1, 1, 3, 1, 3, 3, 5, 1, 3, 3, 5, 3, 5, 5, 7+ , 0, 1, 0, 2, 0, 1, 1, 3, 0, 1, 0, 2, 0, 2, 2, 4+ , 0, 1, 0, 2, 0, 1, 1, 3, 0, 1, 1, 3, 1, 3, 3, 5+ , 0, 1, 0, 2, 0, 1, 1, 3, 0, 1, 0, 2, 0, 2, 2, 4+ , 0, 1, 0, 2, 0, 2, 2, 4, 0, 2, 2, 4, 2, 4, 4, 6+ , 0, 1, 0, 2, 0, 1, 1, 3, 0, 1, 0, 2, 0, 2, 2, 4+ , 0, 1, 0, 2, 0, 2, 2, 4, 0, 2, 2, 4, 2, 4, 4, 6+ , 0, 1, 0, 2, 0, 2, 2, 4, 0, 2, 2, 4, 2, 4, 4, 6+ , 0, 2, 2, 4, 2, 4, 4, 6, 2, 4, 4, 6, 4, 6, 6, 8+ ]
src/HaskellWorks/Data/Succinct/RankSelect/Binary/Basic/Rank0.hs view
@@ -26,19 +26,19 @@ instance Rank0 Word8 where rank0 v s0 = s0 - rank1 v s0- {-# INLINABLE rank0 #-}+ {-# INLINE rank0 #-} instance Rank0 Word16 where rank0 v s0 = s0 - rank1 v s0- {-# INLINABLE rank0 #-}+ {-# INLINE rank0 #-} instance Rank0 Word32 where rank0 v s0 = s0 - rank1 v s0- {-# INLINABLE rank0 #-}+ {-# INLINE rank0 #-} instance Rank0 Word64 where rank0 v s0 = s0 - rank1 v s0- {-# INLINABLE rank0 #-}+ {-# INLINE rank0 #-} instance Rank0 [Bool] where rank0 = go 0@@ -46,88 +46,88 @@ 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 #-}+ {-# 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- {-# INLINABLE rank0 #-}+ {-# 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- {-# INLINABLE rank0 #-}+ {-# 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- {-# INLINABLE rank0 #-}+ {-# 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- {-# INLINABLE rank0 #-}+ {-# 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- {-# INLINABLE rank0 #-}+ {-# 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- {-# INLINABLE rank0 #-}+ {-# 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- {-# INLINABLE rank0 #-}+ {-# 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- {-# INLINABLE rank0 #-}+ {-# 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- {-# INLINABLE rank0 #-}+ {-# 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- {-# INLINABLE rank0 #-}+ {-# 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- {-# INLINABLE rank0 #-}+ {-# 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- {-# INLINABLE rank0 #-}+ {-# INLINE rank0 #-}
src/HaskellWorks/Data/Succinct/RankSelect/Binary/Basic/Select1.hs view
@@ -28,7 +28,7 @@ instance Select1 Word8 where select1 _ 0 = 0 select1 v p = select1 (fromIntegral v :: Word16) p- {-# INLINABLE select1 #-}+ {-# INLINE select1 #-} -- TODO: Remove redundant code to optimise instance Select1 Word16 where@@ -61,7 +61,7 @@ let t5 = (v .>. fromIntegral (s5 - 1)) .&. 0x1 in let s6 = s5 - ((t5 - r5) .&. 256) .>. 8 in fromIntegral s6- {-# INLINABLE select1 #-}+ {-# INLINE select1 #-} -- TODO: Remove redundant code to optimise instance Select1 Word32 where@@ -95,7 +95,7 @@ let t5 = (v .>. fromIntegral (s5 - 1)) .&. 0x1 in let s6 = s5 - ((t5 - r5) .&. 256) .>. 8 in fromIntegral s6- {-# INLINABLE select1 #-}+ {-# INLINE select1 #-} instance Select1 Word64 where select1 _ 0 = 0@@ -129,7 +129,7 @@ let t5 = (v .>. fromIntegral (s5 - 1)) .&. 0x1 in let s6 = s5 - ((t5 - r5) .&. 256) .>. 8 in fromIntegral s6- {-# INLINABLE select1 #-}+ {-# INLINE select1 #-} instance Select1 [Bool] where select1 = go 0@@ -137,7 +137,7 @@ 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 #-}+ {-# INLINE select1 #-} instance Select1 [Word8] where select1 v c = go v c 0@@ -147,7 +147,7 @@ case popCount1 w of pc | d <= pc -> select1 w d + acc pc -> go (tail u) (d - pc) (acc + elemFixedBitSize u)- {-# INLINABLE select1 #-}+ {-# INLINE select1 #-} instance Select1 [Word16] where select1 v c = go v c 0@@ -157,7 +157,7 @@ case popCount1 w of pc | d <= pc -> select1 w d + acc pc -> go (tail u) (d - pc) (acc + elemFixedBitSize u)- {-# INLINABLE select1 #-}+ {-# INLINE select1 #-} instance Select1 [Word32] where select1 v c = go v c 0@@ -167,7 +167,7 @@ case popCount1 w of pc | d <= pc -> select1 w d + acc pc -> go (tail u) (d - pc) (acc + elemFixedBitSize u)- {-# INLINABLE select1 #-}+ {-# INLINE select1 #-} instance Select1 [Word64] where select1 v c = go v c 0@@ -177,7 +177,7 @@ case popCount1 w of pc | d <= pc -> select1 w d + acc pc -> go (tail u) (d - pc) (acc + elemFixedBitSize u)- {-# INLINABLE select1 #-}+ {-# INLINE select1 #-} instance Select1 (DVS.Vector Word8) where select1 v c = go 0 c 0@@ -186,7 +186,7 @@ case popCount1 w of pc | d <= pc -> select1 w d + acc pc -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)- {-# INLINABLE select1 #-}+ {-# INLINE select1 #-} instance Select1 (DVS.Vector Word16) where select1 v c = go 0 c 0@@ -195,7 +195,7 @@ case popCount1 w of pc | d <= pc -> select1 w d + acc pc -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)- {-# INLINABLE select1 #-}+ {-# INLINE select1 #-} instance Select1 (DVS.Vector Word32) where select1 v c = go 0 c 0@@ -204,7 +204,7 @@ case popCount1 w of pc | d <= pc -> select1 w d + acc pc -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)- {-# INLINABLE select1 #-}+ {-# INLINE select1 #-} instance Select1 (DVS.Vector Word64) where select1 v c = go 0 c 0@@ -213,7 +213,7 @@ case popCount1 w of pc | d <= pc -> select1 w d + acc pc -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)- {-# INLINABLE select1 #-}+ {-# INLINE select1 #-} instance Select1 (DV.Vector Word8) where select1 v c = go 0 c 0@@ -222,7 +222,7 @@ case popCount1 w of pc | d <= pc -> select1 w d + acc pc -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)- {-# INLINABLE select1 #-}+ {-# INLINE select1 #-} instance Select1 (DV.Vector Word16) where select1 v c = go 0 c 0@@ -231,7 +231,7 @@ case popCount1 w of pc | d <= pc -> select1 w d + acc pc -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)- {-# INLINABLE select1 #-}+ {-# INLINE select1 #-} instance Select1 (DV.Vector Word32) where select1 v c = go 0 c 0@@ -240,7 +240,7 @@ case popCount1 w of pc | d <= pc -> select1 w d + acc pc -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)- {-# INLINABLE select1 #-}+ {-# INLINE select1 #-} instance Select1 (DV.Vector Word64) where select1 v c = go 0 c 0@@ -249,4 +249,4 @@ case popCount1 w of pc | d <= pc -> select1 w d + acc pc -> go (n + 1) (d - pc) (acc + elemFixedBitSize v)- {-# INLINABLE select1 #-}+ {-# INLINE select1 #-}
src/HaskellWorks/Data/Succinct/RankSelect/Binary/Poppy512.hs view
@@ -38,7 +38,7 @@ instance BitLength Poppy512 where bitLength v = vLength (poppy512Bits v) * bitLength (poppy512Bits v !!! 0)- {-# INLINABLE bitLength #-}+ {-# INLINE bitLength #-} instance TestBit Poppy512 where (.?.) = (.?.) . poppy512Bits@@ -67,20 +67,26 @@ s = Count (fromIntegral q * 512 - (i !!! q)) wordAt o = fromIntegral o * 512 - (i !!! o) +instance OpenAt Poppy512 where+ openAt = openAt . poppy512Bits+ {-# INLINE openAt #-}++instance CloseAt Poppy512 where+ closeAt = closeAt . poppy512Bits+ {-# INLINE closeAt #-}+ instance BalancedParens Poppy512 where- openAt = openAt . poppy512Bits- closeAt = closeAt . poppy512Bits- -- findOpenN = findOpenN . poppy512Bits+ findOpenN = findOpenN . poppy512Bits findCloseN = findCloseN . poppy512Bits- -- findOpen = findOpen . poppy512Bits+ findOpen = findOpen . poppy512Bits findClose = findClose . poppy512Bits- -- enclose = enclose . poppy512Bits+ enclose = enclose . poppy512Bits firstChild = firstChild . poppy512Bits nextSibling = nextSibling . poppy512Bits- -- parent = parent . poppy512Bits- -- {-# INLINABLE findOpen #-}- {-# INLINABLE findClose #-}- -- {-# INLINABLE enclose #-}- {-# INLINABLE firstChild #-}- {-# INLINABLE nextSibling #-}- -- {-# INLINABLE parent #-}+ parent = parent . poppy512Bits+ {-# INLINE findOpen #-}+ {-# INLINE findClose #-}+ {-# INLINE enclose #-}+ {-# INLINE firstChild #-}+ {-# INLINE nextSibling #-}+ {-# INLINE parent #-}
src/HaskellWorks/Data/Succinct/RankSelect/Binary/Poppy512S.hs view
@@ -49,7 +49,7 @@ instance BitLength Poppy512S where bitLength v = vLength (poppy512SBits v) * bitLength (poppy512SBits v !!! 0)- {-# INLINABLE bitLength #-}+ {-# INLINE bitLength #-} instance TestBit Poppy512S where (.?.) = (.?.) . poppy512SBits@@ -88,12 +88,16 @@ iMin = fromIntegral $ (sampleMin - 1) `div` 512 :: Position iMax = fromIntegral $ ((sampleMax - 1) `div` 512) + 1 :: Position -instance BalancedParens Poppy512S where+instance OpenAt Poppy512S where openAt = openAt . poppy512SBits+ {-# INLINE openAt #-}++instance CloseAt Poppy512S where closeAt = closeAt . poppy512SBits- -- findOpenN = findOpenN . poppy512SBits+ {-# INLINE closeAt #-}++instance BalancedParens Poppy512S where+ findOpenN = findOpenN . poppy512SBits findCloseN = findCloseN . poppy512SBits- {-# INLINABLE openAt #-}- {-# INLINABLE closeAt #-}- -- {-# INLINABLE findOpenN #-}- {-# INLINABLE findCloseN #-}+ {-# INLINE findOpenN #-}+ {-# INLINE findCloseN #-}
+ test/HaskellWorks/Data/Succinct/BalancedParens/RangeMinMax/L0Spec.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax.L0Spec where++import qualified Data.Vector.Storable as DVS+import Data.Word+import HaskellWorks.Data.Bits.BitLength+import HaskellWorks.Data.Bits.BitShow+import HaskellWorks.Data.Bits.FromBitTextByteString+import HaskellWorks.Data.Succinct.BalancedParens+import HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax.L0+import Test.Hspec+import Test.QuickCheck++{-# ANN module ("HLint: Ignore Redundant do" :: String) #-}+{-# ANN module ("HLint: Ignore Reduce duplication" :: String) #-}++newtype ShowVector a = ShowVector a deriving (Eq, BitShow)++instance BitShow a => Show (ShowVector a) where+ show = bitShow++vectorSizedBetween :: Int -> Int -> Gen (ShowVector (DVS.Vector Word64))+vectorSizedBetween a b = do+ n <- choose (a, b)+ xs <- sequence [ arbitrary | _ <- [1 .. n] ]+ return $ ShowVector (DVS.fromList xs)++spec :: Spec+spec = describe "HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax.L0Spec" $ do+ it "XXX" $ do+ let v = fromBitTextByteString "11101111 10100101 01111110 10110010 10111011 10111011 00011111 11011100" :: DVS.Vector Word64+ let !rmm = mkRangeMinMaxL0 v+ findClose rmm 61 `shouldBe` findClose v 61+ it "findClose should return the same result" $ do+ forAll (vectorSizedBetween 1 4) $ \(ShowVector v) -> do+ let !rmm = mkRangeMinMaxL0 v+ let len = bitLength v+ [findClose rmm i | i <- [1..len]] `shouldBe `[findClose v i | i <- [1..len]]+ it "findClose should return the same result over all counts" $ do+ forAll (vectorSizedBetween 1 512) $ \(ShowVector v) -> do+ forAll (choose (1, bitLength v)) $ \p -> do+ let !rmm = mkRangeMinMaxL0 v+ findClose rmm p `shouldBe` findClose v p+ it "nextSibling should return the same result" $ do+ forAll (vectorSizedBetween 1 512) $ \(ShowVector v) -> do+ let !rmm = mkRangeMinMaxL0 v+ nextSibling rmm 0 `shouldBe` nextSibling v 0+ it "nextSibling should return the same result over all counts" $ do+ forAll (vectorSizedBetween 1 512) $ \(ShowVector v) -> do+ forAll (choose (1, bitLength v)) $ \p -> do+ let !rmm = mkRangeMinMaxL0 v+ nextSibling rmm p `shouldBe` nextSibling v p
+ test/HaskellWorks/Data/Succinct/BalancedParens/RangeMinMax/L1Spec.hs view
@@ -0,0 +1,72 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax.L1Spec where++import qualified Data.Vector.Storable as DVS+import Data.Word+import HaskellWorks.Data.Bits.AllExcess.AllExcess1+import HaskellWorks.Data.Bits.BitLength+import HaskellWorks.Data.Bits.BitShow+import HaskellWorks.Data.Bits.FromBitTextByteString+import HaskellWorks.Data.Succinct.BalancedParens+import HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax.L1+import Test.Hspec+import Test.QuickCheck++{-# ANN module ("HLint: Ignore Redundant do" :: String) #-}+{-# ANN module ("HLint: Ignore Reduce duplication" :: String) #-}++newtype ShowVector a = ShowVector a deriving (Eq, BitShow)++instance BitShow a => Show (ShowVector a) where+ show = bitShow++vectorSizedBetween :: Int -> Int -> Gen (ShowVector (DVS.Vector Word64))+vectorSizedBetween a b = do+ n <- choose (a, b)+ xs <- sequence [ arbitrary | _ <- [1 .. n] ]+ return $ ShowVector (DVS.fromList xs)++padVectorExcess :: DVS.Vector Word64 -> DVS.Vector Word64+padVectorExcess v = DVS.constructN paddedLen gen+ where wordBitLength = fromIntegral (elemBitLength v) :: Int+ paddedLen = DVS.length v + (((allExcess1 v + wordBitLength - 1) `div` wordBitLength) `max` 0)+ gen :: DVS.Vector Word64 -> Word64+ gen u = let i = DVS.length u in if i < DVS.length v then v DVS.! i else 0++spec :: Spec+spec = describe "HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax.L1Spec" $ do+ it "XXX" $ do+ let v = fromBitTextByteString "11101111 10100101 01111110 10110010 10111011 10111011 00011111 11011100" :: DVS.Vector Word64+ let !rmm = mkRangeMinMaxL1 v+ findClose rmm 61 `shouldBe` findClose v 61+ it "YYY" $ do+ let v = fromBitTextByteString "00100001 01011101 10000100 11100001 11100100 00110010 01011011 00010001 01101011 01111100 10111011 01110000 01111101 01110000 00000101 01111110 11110101 01011001 00000100 00010001 00101001 10001001 10110000 01011100 10001000 01011011 11011101 10011101 11111111 10000111 00100100 00100010 00111010 10111001 10010100 01110111 10011000 11011111 10000100 10100111 10000111 11110110 10001000 01110001 00100000 11110010 11110000 10111010 11111010 01100101 11101101 01111011 00100010 11011011 11000000 11111110 11101111 00111101 11000001 01001001 10001000 01011100 11010000 11101110 01001101 11011110 00100110 00000000 01000111 00001100 11101111 10100111 10000111 00100010 11101011 01111100 10000111 01101001 01100101 11001101 01111110 11100110 00101000 00110100 10111001 01100100 00000001 11110111 00010110 00100000 11110110 00011101 11001110 00011101 11101100 10110011 00110010 11100011 01110001 01000101 00011001 11100011 10110011 11010001 11011010 10100100 00001101 01011001 01101110 01011100 10001101 01011110 11001000 00001100 10011111 11000001 11101011 11000010 11010010 10100100 00111101 00000010 11100100 10010101 00110111 10111111 00100001 00111010 00010000 10100110 01010010 11111110 01110010 10101011 10111110 10111010 00011001 10101001 01000100 11100111 11010110 11001000 10111100 11001100 01100110 10101111 11011011 01001100 00001101 00110101 10010001 01101100 00101111 11101101 11110001 10111010 01110110 00100111 10010101 00101010 01001001 11000011 11011000 10000001 11100011 10110110 11111111 01111001 10100101 01110100 00000100 01111100 00101101 11101100 01111111 10100101 01100100 00011101 10011011 01011011 11110110 00011110 00110011 01101011 01011110 01110100 11000111 00110001 10110011 01010111 01000000 01001111 01011010 00111001 01000111 00001101 00000010 11001101 11000010 00011010 01001100 01010111 01110101 01100110 11010001 00000000 11011111 10010010 01000110 00111101 00000001 01010000 10001000 10100111 11111010 00010100 01000001 10011100 00000111 11000101 01100101 10011000 00011101 01110000 10101010 01101111 00100101 10011001 11010010 11111001 10010101 01000011 01111101 00110100 11001101 10101011 00010101 00111011 11010000 00100010 00101111 01111101 01100011 11100110 11111111 00000100 11010101 01111100 10010110 11101111 00101100 10001100 10000000 00101100 00100010 00100001 11010010 00010001 00000010 11001100 10000100 00011111 01000100 11011000 11110110 11101110 11110011 10101011 10110010 10000111 01010011 11000010 11111000 01100000 10010010 10011101 11110010 11111111 01001111 11110100 11010111 11010010 11011001 00110010 11001001 11111101 00111111 11100010 00001000 01011101 00011011 11111100 11001000 11101001 11011100 10000001 00101000 11110110 11011111 10011000 11000011 01010110 11111000 01001100 01011000 00100101 00110000 11111111 00100111 11000110 10011111 11000000 10101011 11010001 10100110 00110000 00100111 11111110 00001001 01011100 10110110 00010111 10011100 00010101 11101100 10111010 01100010 11001100 11100111 10100010 01011000 11000101 00101000 00010100 11101001 01110100 10001100 01111001 10010010 01000101 11010110 01111001 11010011 01100100 11000011 10101110 01101001 10010010 10000011 11110000 10111010 11100001 01001101 11110111 01111011 11000110 10111111 00101001 10100100 11110101 11110000 10000110 01010010 10110011 11010100 00110000 00101001 00101001 00000100 11111100 00010101 01010100 01000011 01100111 00000000 01111001 10100001 00110110 10000011 11010000 01100111 00110111 00000011 01111010 00100110 10010101 00000101 01011001 01001100 10011001 10100111 01010000 00101000 10111110 11001110 11001110 01111110 10110110 01001110 11110011 00110110 11011011 10110111 01010101 11001100 11011101 00011010 11011100 10000001 11001010 10100111 00010011 11110111 01101110 10011000 01011101 10000001 00001000 10111010 11011101 00111011 10001000 01001100 10100111 00100001 11000111 00001010 01001100 00111101 10110011 01101011 01001110 00000100 11010010 11110111 00110011 10010001 01000010 01001100 10000111 01001011 01001101 10001011 01001000 00011111 01000110 00011001 10000111 00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" :: DVS.Vector Word64+ let !rmm = mkRangeMinMaxL1 v+ let len = bitLength v+ [findClose rmm i | i <- [1..len]] `shouldBe `[findClose v i | i <- [1..len]]+ it "findClose should return the same result" $ do+ forAll (vectorSizedBetween 1 64) $ \(ShowVector u) -> do+ let v = padVectorExcess u+ let !rmm = mkRangeMinMaxL1 v+ let len = bitLength v+ [findClose rmm i | i <- [1..len]] `shouldBe `[findClose v i | i <- [1..len]]+ it "findClose should return the same result over all counts" $ do+ forAll (vectorSizedBetween 1 64) $ \(ShowVector u) -> do+ let v = padVectorExcess u+ forAll (choose (1, bitLength v)) $ \p -> do+ let !rmm = mkRangeMinMaxL1 v+ findClose rmm p `shouldBe` findClose v p+ it "nextSibling should return the same result" $ do+ forAll (vectorSizedBetween 1 64) $ \(ShowVector u) -> do+ let v = padVectorExcess u+ let !rmm = mkRangeMinMaxL1 v+ nextSibling rmm 0 `shouldBe` nextSibling v 0+ it "nextSibling should return the same result over all counts" $ do+ forAll (vectorSizedBetween 1 64) $ \(ShowVector u) -> do+ let v = padVectorExcess u+ let !rmm = mkRangeMinMaxL1 v+ [nextSibling rmm p | p <- [1..bitLength v]] `shouldBe` [nextSibling v p | p <- [1..bitLength v]]
+ test/HaskellWorks/Data/Succinct/BalancedParens/RangeMinMax/L2Spec.hs view
@@ -0,0 +1,72 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax.L2Spec where++import qualified Data.Vector.Storable as DVS+import Data.Word+import HaskellWorks.Data.Bits.AllExcess.AllExcess1+import HaskellWorks.Data.Bits.BitLength+import HaskellWorks.Data.Bits.BitShow+import HaskellWorks.Data.Bits.FromBitTextByteString+import HaskellWorks.Data.Succinct.BalancedParens+import HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax.L2+import Test.Hspec+import Test.QuickCheck++{-# ANN module ("HLint: Ignore Redundant do" :: String) #-}+{-# ANN module ("HLint: Ignore Reduce duplication" :: String) #-}++newtype ShowVector a = ShowVector a deriving (Eq, BitShow)++instance BitShow a => Show (ShowVector a) where+ show = bitShow++vectorSizedBetween :: Int -> Int -> Gen (ShowVector (DVS.Vector Word64))+vectorSizedBetween a b = do+ n <- choose (a, b)+ xs <- sequence [ arbitrary | _ <- [1 .. n] ]+ return $ ShowVector (DVS.fromList xs)++padVectorExcess :: DVS.Vector Word64 -> DVS.Vector Word64+padVectorExcess v = DVS.constructN paddedLen gen+ where wordBitLength = fromIntegral (elemBitLength v) :: Int+ paddedLen = DVS.length v + (((allExcess1 v + wordBitLength - 1) `div` wordBitLength) `max` 0)+ gen :: DVS.Vector Word64 -> Word64+ gen u = let i = DVS.length u in if i < DVS.length v then v DVS.! i else 0++spec :: Spec+spec = describe "HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax.L2Spec" $ do+ it "XXX" $ do+ let v = fromBitTextByteString "11101111 10100101 01111110 10110010 10111011 10111011 00011111 11011100" :: DVS.Vector Word64+ let !rmm = mkRangeMinMaxL2 v+ findClose rmm 61 `shouldBe` findClose v 61+ it "YYY" $ do+ let v = fromBitTextByteString "00100001 01011101 10000100 11100001 11100100 00110010 01011011 00010001 01101011 01111100 10111011 01110000 01111101 01110000 00000101 01111110 11110101 01011001 00000100 00010001 00101001 10001001 10110000 01011100 10001000 01011011 11011101 10011101 11111111 10000111 00100100 00100010 00111010 10111001 10010100 01110111 10011000 11011111 10000100 10100111 10000111 11110110 10001000 01110001 00100000 11110010 11110000 10111010 11111010 01100101 11101101 01111011 00100010 11011011 11000000 11111110 11101111 00111101 11000001 01001001 10001000 01011100 11010000 11101110 01001101 11011110 00100110 00000000 01000111 00001100 11101111 10100111 10000111 00100010 11101011 01111100 10000111 01101001 01100101 11001101 01111110 11100110 00101000 00110100 10111001 01100100 00000001 11110111 00010110 00100000 11110110 00011101 11001110 00011101 11101100 10110011 00110010 11100011 01110001 01000101 00011001 11100011 10110011 11010001 11011010 10100100 00001101 01011001 01101110 01011100 10001101 01011110 11001000 00001100 10011111 11000001 11101011 11000010 11010010 10100100 00111101 00000010 11100100 10010101 00110111 10111111 00100001 00111010 00010000 10100110 01010010 11111110 01110010 10101011 10111110 10111010 00011001 10101001 01000100 11100111 11010110 11001000 10111100 11001100 01100110 10101111 11011011 01001100 00001101 00110101 10010001 01101100 00101111 11101101 11110001 10111010 01110110 00100111 10010101 00101010 01001001 11000011 11011000 10000001 11100011 10110110 11111111 01111001 10100101 01110100 00000100 01111100 00101101 11101100 01111111 10100101 01100100 00011101 10011011 01011011 11110110 00011110 00110011 01101011 01011110 01110100 11000111 00110001 10110011 01010111 01000000 01001111 01011010 00111001 01000111 00001101 00000010 11001101 11000010 00011010 01001100 01010111 01110101 01100110 11010001 00000000 11011111 10010010 01000110 00111101 00000001 01010000 10001000 10100111 11111010 00010100 01000001 10011100 00000111 11000101 01100101 10011000 00011101 01110000 10101010 01101111 00100101 10011001 11010010 11111001 10010101 01000011 01111101 00110100 11001101 10101011 00010101 00111011 11010000 00100010 00101111 01111101 01100011 11100110 11111111 00000100 11010101 01111100 10010110 11101111 00101100 10001100 10000000 00101100 00100010 00100001 11010010 00010001 00000010 11001100 10000100 00011111 01000100 11011000 11110110 11101110 11110011 10101011 10110010 10000111 01010011 11000010 11111000 01100000 10010010 10011101 11110010 11111111 01001111 11110100 11010111 11010010 11011001 00110010 11001001 11111101 00111111 11100010 00001000 01011101 00011011 11111100 11001000 11101001 11011100 10000001 00101000 11110110 11011111 10011000 11000011 01010110 11111000 01001100 01011000 00100101 00110000 11111111 00100111 11000110 10011111 11000000 10101011 11010001 10100110 00110000 00100111 11111110 00001001 01011100 10110110 00010111 10011100 00010101 11101100 10111010 01100010 11001100 11100111 10100010 01011000 11000101 00101000 00010100 11101001 01110100 10001100 01111001 10010010 01000101 11010110 01111001 11010011 01100100 11000011 10101110 01101001 10010010 10000011 11110000 10111010 11100001 01001101 11110111 01111011 11000110 10111111 00101001 10100100 11110101 11110000 10000110 01010010 10110011 11010100 00110000 00101001 00101001 00000100 11111100 00010101 01010100 01000011 01100111 00000000 01111001 10100001 00110110 10000011 11010000 01100111 00110111 00000011 01111010 00100110 10010101 00000101 01011001 01001100 10011001 10100111 01010000 00101000 10111110 11001110 11001110 01111110 10110110 01001110 11110011 00110110 11011011 10110111 01010101 11001100 11011101 00011010 11011100 10000001 11001010 10100111 00010011 11110111 01101110 10011000 01011101 10000001 00001000 10111010 11011101 00111011 10001000 01001100 10100111 00100001 11000111 00001010 01001100 00111101 10110011 01101011 01001110 00000100 11010010 11110111 00110011 10010001 01000010 01001100 10000111 01001011 01001101 10001011 01001000 00011111 01000110 00011001 10000111 00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" :: DVS.Vector Word64+ let !rmm = mkRangeMinMaxL2 v+ let len = bitLength v+ [findClose rmm i | i <- [1..len]] `shouldBe `[findClose v i | i <- [1..len]]+ it "findClose should return the same result" $ do+ forAll (vectorSizedBetween 1 64) $ \(ShowVector u) -> do+ let v = padVectorExcess u+ let !rmm = mkRangeMinMaxL2 v+ let len = bitLength v+ [findClose rmm i | i <- [1..len]] `shouldBe `[findClose v i | i <- [1..len]]+ it "findClose should return the same result over all counts" $ do+ forAll (vectorSizedBetween 1 64) $ \(ShowVector u) -> do+ let v = padVectorExcess u+ forAll (choose (1, bitLength v)) $ \p -> do+ let !rmm = mkRangeMinMaxL2 v+ findClose rmm p `shouldBe` findClose v p+ it "nextSibling should return the same result" $ do+ forAll (vectorSizedBetween 1 64) $ \(ShowVector u) -> do+ let v = padVectorExcess u+ let !rmm = mkRangeMinMaxL2 v+ nextSibling rmm 0 `shouldBe` nextSibling v 0+ it "nextSibling should return the same result over all counts" $ do+ forAll (vectorSizedBetween 1 64) $ \(ShowVector u) -> do+ let v = padVectorExcess u+ let !rmm = mkRangeMinMaxL2 v+ [nextSibling rmm p | p <- [1..bitLength v]] `shouldBe` [nextSibling v p | p <- [1..bitLength v]]
+ test/HaskellWorks/Data/Succinct/BalancedParens/RangeMinMax/L3Spec.hs view
@@ -0,0 +1,72 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax.L3Spec where++import qualified Data.Vector.Storable as DVS+import Data.Word+import HaskellWorks.Data.Bits.AllExcess.AllExcess1+import HaskellWorks.Data.Bits.BitLength+import HaskellWorks.Data.Bits.BitShow+import HaskellWorks.Data.Bits.FromBitTextByteString+import HaskellWorks.Data.Succinct.BalancedParens+import HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax.L3+import Test.Hspec+import Test.QuickCheck++{-# ANN module ("HLint: Ignore Redundant do" :: String) #-}+{-# ANN module ("HLint: Ignore Reduce duplication" :: String) #-}++newtype ShowVector a = ShowVector a deriving (Eq, BitShow)++instance BitShow a => Show (ShowVector a) where+ show = bitShow++vectorSizedBetween :: Int -> Int -> Gen (ShowVector (DVS.Vector Word64))+vectorSizedBetween a b = do+ n <- choose (a, b)+ xs <- sequence [ arbitrary | _ <- [1 .. n] ]+ return $ ShowVector (DVS.fromList xs)++padVectorExcess :: DVS.Vector Word64 -> DVS.Vector Word64+padVectorExcess v = DVS.constructN paddedLen gen+ where wordBitLength = fromIntegral (elemBitLength v) :: Int+ paddedLen = DVS.length v + (((allExcess1 v + wordBitLength - 1) `div` wordBitLength) `max` 0)+ gen :: DVS.Vector Word64 -> Word64+ gen u = let i = DVS.length u in if i < DVS.length v then v DVS.! i else 0++spec :: Spec+spec = describe "HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax.L3Spec" $ do+ it "XXX" $ do+ let v = fromBitTextByteString "11101111 10100101 01111110 10110010 10111011 10111011 00011111 11011100" :: DVS.Vector Word64+ let !rmm = mkRangeMinMaxL3 v+ findClose rmm 61 `shouldBe` findClose v 61+ it "YYY" $ do+ let v = fromBitTextByteString "00100001 01011101 10000100 11100001 11100100 00110010 01011011 00010001 01101011 01111100 10111011 01110000 01111101 01110000 00000101 01111110 11110101 01011001 00000100 00010001 00101001 10001001 10110000 01011100 10001000 01011011 11011101 10011101 11111111 10000111 00100100 00100010 00111010 10111001 10010100 01110111 10011000 11011111 10000100 10100111 10000111 11110110 10001000 01110001 00100000 11110010 11110000 10111010 11111010 01100101 11101101 01111011 00100010 11011011 11000000 11111110 11101111 00111101 11000001 01001001 10001000 01011100 11010000 11101110 01001101 11011110 00100110 00000000 01000111 00001100 11101111 10100111 10000111 00100010 11101011 01111100 10000111 01101001 01100101 11001101 01111110 11100110 00101000 00110100 10111001 01100100 00000001 11110111 00010110 00100000 11110110 00011101 11001110 00011101 11101100 10110011 00110010 11100011 01110001 01000101 00011001 11100011 10110011 11010001 11011010 10100100 00001101 01011001 01101110 01011100 10001101 01011110 11001000 00001100 10011111 11000001 11101011 11000010 11010010 10100100 00111101 00000010 11100100 10010101 00110111 10111111 00100001 00111010 00010000 10100110 01010010 11111110 01110010 10101011 10111110 10111010 00011001 10101001 01000100 11100111 11010110 11001000 10111100 11001100 01100110 10101111 11011011 01001100 00001101 00110101 10010001 01101100 00101111 11101101 11110001 10111010 01110110 00100111 10010101 00101010 01001001 11000011 11011000 10000001 11100011 10110110 11111111 01111001 10100101 01110100 00000100 01111100 00101101 11101100 01111111 10100101 01100100 00011101 10011011 01011011 11110110 00011110 00110011 01101011 01011110 01110100 11000111 00110001 10110011 01010111 01000000 01001111 01011010 00111001 01000111 00001101 00000010 11001101 11000010 00011010 01001100 01010111 01110101 01100110 11010001 00000000 11011111 10010010 01000110 00111101 00000001 01010000 10001000 10100111 11111010 00010100 01000001 10011100 00000111 11000101 01100101 10011000 00011101 01110000 10101010 01101111 00100101 10011001 11010010 11111001 10010101 01000011 01111101 00110100 11001101 10101011 00010101 00111011 11010000 00100010 00101111 01111101 01100011 11100110 11111111 00000100 11010101 01111100 10010110 11101111 00101100 10001100 10000000 00101100 00100010 00100001 11010010 00010001 00000010 11001100 10000100 00011111 01000100 11011000 11110110 11101110 11110011 10101011 10110010 10000111 01010011 11000010 11111000 01100000 10010010 10011101 11110010 11111111 01001111 11110100 11010111 11010010 11011001 00110010 11001001 11111101 00111111 11100010 00001000 01011101 00011011 11111100 11001000 11101001 11011100 10000001 00101000 11110110 11011111 10011000 11000011 01010110 11111000 01001100 01011000 00100101 00110000 11111111 00100111 11000110 10011111 11000000 10101011 11010001 10100110 00110000 00100111 11111110 00001001 01011100 10110110 00010111 10011100 00010101 11101100 10111010 01100010 11001100 11100111 10100010 01011000 11000101 00101000 00010100 11101001 01110100 10001100 01111001 10010010 01000101 11010110 01111001 11010011 01100100 11000011 10101110 01101001 10010010 10000011 11110000 10111010 11100001 01001101 11110111 01111011 11000110 10111111 00101001 10100100 11110101 11110000 10000110 01010010 10110011 11010100 00110000 00101001 00101001 00000100 11111100 00010101 01010100 01000011 01100111 00000000 01111001 10100001 00110110 10000011 11010000 01100111 00110111 00000011 01111010 00100110 10010101 00000101 01011001 01001100 10011001 10100111 01010000 00101000 10111110 11001110 11001110 01111110 10110110 01001110 11110011 00110110 11011011 10110111 01010101 11001100 11011101 00011010 11011100 10000001 11001010 10100111 00010011 11110111 01101110 10011000 01011101 10000001 00001000 10111010 11011101 00111011 10001000 01001100 10100111 00100001 11000111 00001010 01001100 00111101 10110011 01101011 01001110 00000100 11010010 11110111 00110011 10010001 01000010 01001100 10000111 01001011 01001101 10001011 01001000 00011111 01000110 00011001 10000111 00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" :: DVS.Vector Word64+ let !rmm = mkRangeMinMaxL3 v+ let len = bitLength v+ [findClose rmm i | i <- [1..len]] `shouldBe `[findClose v i | i <- [1..len]]+ it "findClose should return the same result" $ do+ forAll (vectorSizedBetween 1 64) $ \(ShowVector u) -> do+ let v = padVectorExcess u+ let !rmm = mkRangeMinMaxL3 v+ let len = bitLength v+ [findClose rmm i | i <- [1..len]] `shouldBe `[findClose v i | i <- [1..len]]+ it "findClose should return the same result over all counts" $ do+ forAll (vectorSizedBetween 1 64) $ \(ShowVector u) -> do+ let v = padVectorExcess u+ forAll (choose (1, bitLength v)) $ \p -> do+ let !rmm = mkRangeMinMaxL3 v+ findClose rmm p `shouldBe` findClose v p+ it "nextSibling should return the same result" $ do+ forAll (vectorSizedBetween 1 64) $ \(ShowVector u) -> do+ let v = padVectorExcess u+ let !rmm = mkRangeMinMaxL3 v+ nextSibling rmm 0 `shouldBe` nextSibling v 0+ it "nextSibling should return the same result over all counts" $ do+ forAll (vectorSizedBetween 1 64) $ \(ShowVector u) -> do+ let v = padVectorExcess u+ let !rmm = mkRangeMinMaxL3 v+ [nextSibling rmm p | p <- [1..bitLength v]] `shouldBe` [nextSibling v p | p <- [1..bitLength v]]
− test/HaskellWorks/Data/Succinct/BalancedParens/RangeMinMaxSpec.hs
@@ -1,57 +0,0 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}--module HaskellWorks.Data.Succinct.BalancedParens.RangeMinMaxSpec where--import qualified Data.Vector.Storable as DVS-import Data.Word-import HaskellWorks.Data.Bits.BitLength-import HaskellWorks.Data.Bits.BitShow--- import HaskellWorks.Data.Bits.BitShown-import HaskellWorks.Data.Bits.FromBitTextByteString-import HaskellWorks.Data.Succinct.BalancedParens-import HaskellWorks.Data.Succinct.BalancedParens.RangeMinMax-import Test.Hspec-import Test.QuickCheck--{-# ANN module ("HLint: Ignore Redundant do" :: String) #-}-{-# ANN module ("HLint: Ignore Reduce duplication" :: String) #-}--newtype ShowVector a = ShowVector a deriving (Eq, BitShow)--instance BitShow a => Show (ShowVector a) where- show = bitShow--vectorSizedBetween :: Int -> Int -> Gen (ShowVector (DVS.Vector Word64))-vectorSizedBetween a b = do- n <- choose (a, b)- xs <- sequence [ arbitrary | _ <- [1 .. n] ]- return $ ShowVector (DVS.fromList xs)--spec :: Spec-spec = describe "HaskellWorks.Data.Succinct.BalancedParens.RangeMinMaxSpec" $ do- it "XXX" $ do- let v = fromBitTextByteString "11101111 10100101 01111110 10110010 10111011 10111011 00011111 11011100" :: DVS.Vector Word64- let !rmm = mkRangeMinMaxL0 v- findClose rmm 61 `shouldBe` findClose v 61- it "findClose should return the same result" $ do- forAll (vectorSizedBetween 1 4) $ \(ShowVector v) -> do- let !rmm = mkRangeMinMaxL0 v- let len = bitLength v- [findClose rmm i | i <- [1..len]] `shouldBe `[findClose v i | i <- [1..len]]- it "findClose should return the same result over all counts" $ do- forAll (vectorSizedBetween 1 512) $ \(ShowVector v) -> do- forAll (choose (1, bitLength v)) $ \p -> do- let !rmm = mkRangeMinMaxL0 v- findClose rmm p `shouldBe` findClose v p- it "nextSibling should return the same result" $ do- forAll (vectorSizedBetween 1 512) $ \(ShowVector v) -> do- let !rmm = mkRangeMinMaxL0 v- nextSibling rmm 0 `shouldBe` nextSibling v 0- it "nextSibling should return the same result over all counts" $ do- forAll (vectorSizedBetween 1 512) $ \(ShowVector v) -> do- forAll (choose (1, bitLength v)) $ \p -> do- let !rmm = mkRangeMinMaxL0 v- nextSibling rmm p `shouldBe` nextSibling v p
test/HaskellWorks/Data/Succinct/BalancedParens/SimpleSpec.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE ScopedTypeVariables #-} module HaskellWorks.Data.Succinct.BalancedParens.SimpleSpec where@@ -5,13 +6,27 @@ import Data.Maybe import qualified Data.Vector.Storable as DVS import Data.Word+import HaskellWorks.Data.Bits.BitLength import HaskellWorks.Data.Bits.BitRead+import HaskellWorks.Data.Bits.BitShow import HaskellWorks.Data.Succinct.BalancedParens import Test.Hspec+import Test.QuickCheck {-# ANN module ("HLint: Ignore Redundant do" :: String) #-} {-# ANN module ("HLint: Ignore Reduce duplication" :: String) #-} +newtype ShowVector a = ShowVector a deriving (Eq, BitShow)++instance BitShow a => Show (ShowVector a) where+ show = bitShow++vectorSizedBetween :: Int -> Int -> Gen (ShowVector (DVS.Vector Word64))+vectorSizedBetween a b = do+ n <- choose (a, b)+ xs <- sequence [ arbitrary | _ <- [1 .. n] ]+ return $ ShowVector (DVS.fromList xs)+ spec :: Spec spec = describe "HaskellWorks.Data.Succinct.BalancedParens.SimpleSpec" $ do describe "For (()(()())) 1101101000" $ do@@ -26,10 +41,10 @@ it "Test 1b" $ findClose bs 8 `shouldBe` Just 8 it "Test 1b" $ findClose bs 9 `shouldBe` Just 9 it "Test 1b" $ findClose bs 10 `shouldBe` Just 10- -- it "Test 2a" $ findOpen bs 10 `shouldBe` Just 1- -- it "Test 2b" $ findOpen bs 3 `shouldBe` Just 2- -- it "Test 3a" $ enclose bs 2 `shouldBe` Just 1- -- it "Test 3b" $ enclose bs 7 `shouldBe` Just 4+ it "Test 2a" $ findOpen bs 10 `shouldBe` Just 1+ it "Test 2b" $ findOpen bs 3 `shouldBe` Just 2+ it "Test 3a" $ enclose bs 2 `shouldBe` Just 1+ it "Test 3b" $ enclose bs 7 `shouldBe` Just 4 describe "For (()(()())) 1101101000" $ do let bs = SimpleBalancedParens (fromJust (bitRead "1101101000") :: [Bool]) it "Test 1a" $ findClose bs 1 `shouldBe` Just 10@@ -42,26 +57,26 @@ it "Test 1b" $ findClose bs 8 `shouldBe` Just 8 it "Test 1b" $ findClose bs 9 `shouldBe` Just 9 it "Test 1b" $ findClose bs 10 `shouldBe` Just 10- -- it "Test 2a" $ findOpen bs 10 `shouldBe` Just 1- -- it "Test 2b" $ findOpen bs 3 `shouldBe` Just 2- -- it "Test 3a" $ enclose bs 2 `shouldBe` Just 1- -- it "Test 3b" $ enclose bs 7 `shouldBe` Just 4+ it "Test 2a" $ findOpen bs 10 `shouldBe` Just 1+ it "Test 2b" $ findOpen bs 3 `shouldBe` Just 2+ it "Test 3a" $ enclose bs 2 `shouldBe` Just 1+ it "Test 3b" $ enclose bs 7 `shouldBe` Just 4 it "firstChild 1" $ firstChild bs 1 `shouldBe` Just 2 it "firstChild 4" $ firstChild bs 4 `shouldBe` Just 5 it "nextSibling 2" $ nextSibling bs 2 `shouldBe` Just 4 it "nextSibling 5" $ nextSibling bs 5 `shouldBe` Just 7- -- it "parent 2" $ parent bs 2 `shouldBe` Just 1- -- it "parent 5" $ parent bs 5 `shouldBe` Just 4- -- it "depth 1" $ depth bs 1 `shouldBe` Just 1- -- it "depth 2" $ depth bs 2 `shouldBe` Just 2- -- it "depth 3" $ depth bs 3 `shouldBe` Just 2- -- it "depth 4" $ depth bs 4 `shouldBe` Just 2- -- it "depth 5" $ depth bs 5 `shouldBe` Just 3- -- it "depth 6" $ depth bs 6 `shouldBe` Just 3- -- it "depth 7" $ depth bs 7 `shouldBe` Just 3- -- it "depth 8" $ depth bs 8 `shouldBe` Just 3- -- it "depth 9" $ depth bs 9 `shouldBe` Just 2- -- it "depth 10" $ depth bs 10 `shouldBe` Just 1+ it "parent 2" $ parent bs 2 `shouldBe` Just 1+ it "parent 5" $ parent bs 5 `shouldBe` Just 4+ it "depth 1" $ depth bs 1 `shouldBe` Just 1+ it "depth 2" $ depth bs 2 `shouldBe` Just 2+ it "depth 3" $ depth bs 3 `shouldBe` Just 2+ it "depth 4" $ depth bs 4 `shouldBe` Just 2+ it "depth 5" $ depth bs 5 `shouldBe` Just 3+ it "depth 6" $ depth bs 6 `shouldBe` Just 3+ it "depth 7" $ depth bs 7 `shouldBe` Just 3+ it "depth 8" $ depth bs 8 `shouldBe` Just 3+ it "depth 9" $ depth bs 9 `shouldBe` Just 2+ it "depth 10" $ depth bs 10 `shouldBe` Just 1 it "subtreeSize 1" $ subtreeSize bs 1 `shouldBe` Just 5 it "subtreeSize 2" $ subtreeSize bs 2 `shouldBe` Just 1 it "subtreeSize 3" $ subtreeSize bs 3 `shouldBe` Just 0@@ -84,26 +99,26 @@ it "Test 1b" $ findClose bs 8 `shouldBe` Just 8 it "Test 1b" $ findClose bs 9 `shouldBe` Just 9 it "Test 1b" $ findClose bs 10 `shouldBe` Just 10- -- it "Test 2a" $ findOpen bs 10 `shouldBe` Just 1- -- it "Test 2b" $ findOpen bs 3 `shouldBe` Just 2- -- it "Test 3a" $ enclose bs 2 `shouldBe` Just 1- -- it "Test 3b" $ enclose bs 7 `shouldBe` Just 4+ it "Test 2a" $ findOpen bs 10 `shouldBe` Just 1+ it "Test 2b" $ findOpen bs 3 `shouldBe` Just 2+ it "Test 3a" $ enclose bs 2 `shouldBe` Just 1+ it "Test 3b" $ enclose bs 7 `shouldBe` Just 4 it "firstChild 1" $ firstChild bs 1 `shouldBe` Just 2 it "firstChild 4" $ firstChild bs 4 `shouldBe` Just 5 it "nextSibling 2" $ nextSibling bs 2 `shouldBe` Just 4 it "nextSibling 5" $ nextSibling bs 5 `shouldBe` Just 7- -- it "parent 2" $ parent bs 2 `shouldBe` Just 1- -- it "parent 5" $ parent bs 5 `shouldBe` Just 4- -- it "depth 1" $ depth bs 1 `shouldBe` Just 1- -- it "depth 2" $ depth bs 2 `shouldBe` Just 2- -- it "depth 3" $ depth bs 3 `shouldBe` Just 2- -- it "depth 4" $ depth bs 4 `shouldBe` Just 2- -- it "depth 5" $ depth bs 5 `shouldBe` Just 3- -- it "depth 6" $ depth bs 6 `shouldBe` Just 3- -- it "depth 7" $ depth bs 7 `shouldBe` Just 3- -- it "depth 8" $ depth bs 8 `shouldBe` Just 3- -- it "depth 9" $ depth bs 9 `shouldBe` Just 2- -- it "depth 10" $ depth bs 10 `shouldBe` Just 1+ it "parent 2" $ parent bs 2 `shouldBe` Just 1+ it "parent 5" $ parent bs 5 `shouldBe` Just 4+ it "depth 1" $ depth bs 1 `shouldBe` Just 1+ it "depth 2" $ depth bs 2 `shouldBe` Just 2+ it "depth 3" $ depth bs 3 `shouldBe` Just 2+ it "depth 4" $ depth bs 4 `shouldBe` Just 2+ it "depth 5" $ depth bs 5 `shouldBe` Just 3+ it "depth 6" $ depth bs 6 `shouldBe` Just 3+ it "depth 7" $ depth bs 7 `shouldBe` Just 3+ it "depth 8" $ depth bs 8 `shouldBe` Just 3+ it "depth 9" $ depth bs 9 `shouldBe` Just 2+ it "depth 10" $ depth bs 10 `shouldBe` Just 1 it "subtreeSize 1" $ subtreeSize bs 1 `shouldBe` Just 5 it "subtreeSize 2" $ subtreeSize bs 2 `shouldBe` Just 1 it "subtreeSize 3" $ subtreeSize bs 3 `shouldBe` Just 0@@ -114,3 +129,7 @@ it "subtreeSize 8" $ subtreeSize bs 8 `shouldBe` Just 0 it "subtreeSize 9" $ subtreeSize bs 9 `shouldBe` Just 0 it "subtreeSize 10" $ subtreeSize bs 10 `shouldBe` Just 0+ describe "Does not suffer exceptions" $ do+ it "when calling nextSibling from valid locations" $ do+ forAll (vectorSizedBetween 1 64) $ \(ShowVector v) -> do+ [nextSibling v p | p <- [1..bitLength v]] `shouldBe` [nextSibling v p | p <- [1..bitLength v]]
test/HaskellWorks/Data/Succinct/Excess/MinMaxExcess0Spec.hs view
@@ -6,6 +6,7 @@ import qualified Data.Vector.Storable as DVS import Data.Word import HaskellWorks.Data.Bits.Word+import HaskellWorks.Data.Naive import HaskellWorks.Data.Succinct.Excess.MinMaxExcess0 import Test.Hspec import Test.QuickCheck@@ -17,133 +18,132 @@ spec = describe "HaskellWorks.Data.Succinct.Excess.MinMaxExcess0Spec" $ do describe "For Word8" $ do it "Excess should be between min excess and max excess" $- forAll (choose (0, 255 :: Word8)) $ \w ->+ property $ \(w :: Word8) -> let (minE, e, maxE) = minMaxExcess0 w in minE <= e && e <= maxE it "minE2 == minE0 `min` (minE1 + e0)" $- forAll (choose (0, 255 :: Word8)) $ \w0 ->- forAll (choose (0, 255 :: Word8)) $ \w1 ->- let w2 = leConcat w0 w1 in- let (minE0, e0, _) = minMaxExcess0 w0 in- let (minE1, _ , _) = minMaxExcess0 w1 in- let (minE2, _ , _) = minMaxExcess0 w2 in- minE2 == minE0 `min` (minE1 + e0)+ property $ \(w0 :: Word8, w1 :: Word8) ->+ let w2 = leConcat w0 w1 in+ let (minE0, e0, _) = minMaxExcess0 w0 in+ let (minE1, _ , _) = minMaxExcess0 w1 in+ let (minE2, _ , _) = minMaxExcess0 w2 in+ minE2 == minE0 `min` (minE1 + e0) it "maxE2 == maxE0 `max` (maxE1 + e0)" $- forAll (choose (0, 255 :: Word8)) $ \w0 ->- forAll (choose (0, 255 :: Word8)) $ \w1 ->- let w2 = leConcat w0 w1 in- let (_, e0, maxE0) = minMaxExcess0 w0 in- let (_, _ , maxE1) = minMaxExcess0 w1 in- let (_, _ , maxE2) = minMaxExcess0 w2 in- maxE2 == maxE0 `max` (maxE1 + e0)+ property $ \(w0 :: Word8, w1 :: Word8) ->+ let w2 = leConcat w0 w1 in+ let (_, e0, maxE0) = minMaxExcess0 w0 in+ let (_, _ , maxE1) = minMaxExcess0 w1 in+ let (_, _ , maxE2) = minMaxExcess0 w2 in+ maxE2 == maxE0 `max` (maxE1 + e0) it "minE2 == minE0 `min` (minE1 + e0) via vector" $- forAll (choose (0, 255 :: Word8)) $ \w0 ->- forAll (choose (0, 255 :: Word8)) $ \w1 ->- let w2 = DVS.fromList [w0, w1] in- let (minE0, e0, _) = minMaxExcess0 w0 in- let (minE1, _ , _) = minMaxExcess0 w1 in- let (minE2, _ , _) = minMaxExcess0 w2 in- minE2 == minE0 `min` (minE1 + e0)+ property $ \(w0 :: Word8, w1 :: Word8) ->+ let w2 = DVS.fromList [w0, w1] in+ let (minE0, e0, _) = minMaxExcess0 w0 in+ let (minE1, _ , _) = minMaxExcess0 w1 in+ let (minE2, _ , _) = minMaxExcess0 w2 in+ minE2 == minE0 `min` (minE1 + e0) it "maxE2 == maxE0 `max` (maxE1 + e0) via vector" $- forAll (choose (0, 255 :: Word8)) $ \w0 ->- forAll (choose (0, 255 :: Word8)) $ \w1 ->- let w2 = DVS.fromList [w0, w1] in- let (_, e0, maxE0) = minMaxExcess0 w0 in- let (_, _ , maxE1) = minMaxExcess0 w1 in- let (_, _ , maxE2) = minMaxExcess0 w2 in- maxE2 == maxE0 `max` (maxE1 + e0)+ property $ \(w0 :: Word8, w1 :: Word8) ->+ let w2 = DVS.fromList [w0, w1] in+ let (_, e0, maxE0) = minMaxExcess0 w0 in+ let (_, _ , maxE1) = minMaxExcess0 w1 in+ let (_, _ , maxE2) = minMaxExcess0 w2 in+ maxE2 == maxE0 `max` (maxE1 + e0) describe "For Word16" $ do it "Excess should be between min excess and max excess" $- forAll (choose (0, 255 :: Word16)) $ \w ->+ property $ \(w :: Word16) -> let (minE, e, maxE) = minMaxExcess0 w in minE <= e && e <= maxE it "minE2 == minE0 `min` (minE1 + e0)" $- forAll (choose (0, 255 :: Word16)) $ \w0 ->- forAll (choose (0, 255 :: Word16)) $ \w1 ->+ property $ \(w0 :: Word16, w1 :: Word16) ->+ let w2 = leConcat w0 w1 in+ let (minE0, e0, _) = minMaxExcess0 w0 in+ let (minE1, _ , _) = minMaxExcess0 w1 in+ let (minE2, _ , _) = minMaxExcess0 w2 in+ minE2 == minE0 `min` (minE1 + e0)+ it "maxE2 == maxE0 `max` (maxE1 + e0)" $+ property $ \(w0 :: Word16, w1 :: Word16) ->+ let w2 = leConcat w0 w1 in+ let (_, e0, maxE0) = minMaxExcess0 w0 in+ let (_, _ , maxE1) = minMaxExcess0 w1 in+ let (_, _ , maxE2) = minMaxExcess0 w2 in+ maxE2 == maxE0 `max` (maxE1 + e0)+ it "minE2 == minE0 `min` (minE1 + e0) via vector" $+ property $ \(w0 :: Word16, w1 :: Word16) ->+ let w2 = DVS.fromList [w0, w1] in+ let (minE0, e0, _) = minMaxExcess0 w0 in+ let (minE1, _ , _) = minMaxExcess0 w1 in+ let (minE2, _ , _) = minMaxExcess0 w2 in+ minE2 == minE0 `min` (minE1 + e0)+ it "maxE2 == maxE0 `max` (maxE1 + e0) via vector" $+ property $ \(w0 :: Word16, w1 :: Word16) ->+ let w2 = DVS.fromList [w0, w1] in+ let (_, e0, maxE0) = minMaxExcess0 w0 in+ let (_, _ , maxE1) = minMaxExcess0 w1 in+ let (_, _ , maxE2) = minMaxExcess0 w2 in+ maxE2 == maxE0 `max` (maxE1 + e0)+ describe "For Word32" $ do+ it "Excess should be between min excess and max excess" $+ property $ \(w :: Word32) ->+ let (minE, e, maxE) = minMaxExcess0 w in+ minE <= e && e <= maxE+ it "minE2 == minE0 `min` (minE1 + e0)" $+ property $ \(w0 :: Word32, w1 :: Word32) -> let w2 = leConcat w0 w1 in let (minE0, e0, _) = minMaxExcess0 w0 in let (minE1, _ , _) = minMaxExcess0 w1 in let (minE2, _ , _) = minMaxExcess0 w2 in minE2 == minE0 `min` (minE1 + e0)- it "maxE2 == maxE0 `max` (maxE1 + e0)" $- forAll (choose (0, 255 :: Word16)) $ \w0 ->- forAll (choose (0, 255 :: Word16)) $ \w1 ->+ it "maxE2 == maxE0 `max` (maxE1 + e0)" $+ property $ \(w0 :: Word32, w1 :: Word32) -> let w2 = leConcat w0 w1 in let (_, e0, maxE0) = minMaxExcess0 w0 in let (_, _ , maxE1) = minMaxExcess0 w1 in let (_, _ , maxE2) = minMaxExcess0 w2 in maxE2 == maxE0 `max` (maxE1 + e0)- it "minE2 == minE0 `min` (minE1 + e0) via vector" $- forAll (choose (0, 255 :: Word16)) $ \w0 ->- forAll (choose (0, 255 :: Word16)) $ \w1 ->+ it "minE2 == minE0 `min` (minE1 + e0) via vector" $+ property $ \(w0 :: Word32, w1 :: Word32) -> let w2 = DVS.fromList [w0, w1] in let (minE0, e0, _) = minMaxExcess0 w0 in let (minE1, _ , _) = minMaxExcess0 w1 in let (minE2, _ , _) = minMaxExcess0 w2 in minE2 == minE0 `min` (minE1 + e0)- it "maxE2 == maxE0 `max` (maxE1 + e0) via vector" $- forAll (choose (0, 255 :: Word16)) $ \w0 ->- forAll (choose (0, 255 :: Word16)) $ \w1 ->+ it "maxE2 == maxE0 `max` (maxE1 + e0) via vector" $+ property $ \(w0 :: Word32, w1 :: Word32) -> let w2 = DVS.fromList [w0, w1] in let (_, e0, maxE0) = minMaxExcess0 w0 in let (_, _ , maxE1) = minMaxExcess0 w1 in let (_, _ , maxE2) = minMaxExcess0 w2 in maxE2 == maxE0 `max` (maxE1 + e0)- describe "For Word32" $ do- it "Excess should be between min excess and max excess" $- forAll (choose (0, 255 :: Word32)) $ \w ->- let (minE, e, maxE) = minMaxExcess0 w in- minE <= e && e <= maxE- it "minE2 == minE0 `min` (minE1 + e0)" $- forAll (choose (0, 255 :: Word32)) $ \w0 ->- forAll (choose (0, 255 :: Word32)) $ \w1 ->- let w2 = leConcat w0 w1 in- let (minE0, e0, _) = minMaxExcess0 w0 in- let (minE1, _ , _) = minMaxExcess0 w1 in- let (minE2, _ , _) = minMaxExcess0 w2 in- minE2 == minE0 `min` (minE1 + e0)- it "maxE2 == maxE0 `max` (maxE1 + e0)" $- forAll (choose (0, 255 :: Word32)) $ \w0 ->- forAll (choose (0, 255 :: Word32)) $ \w1 ->- let w2 = leConcat w0 w1 in- let (_, e0, maxE0) = minMaxExcess0 w0 in- let (_, _ , maxE1) = minMaxExcess0 w1 in- let (_, _ , maxE2) = minMaxExcess0 w2 in- maxE2 == maxE0 `max` (maxE1 + e0)- it "minE2 == minE0 `min` (minE1 + e0) via vector" $- forAll (choose (0, 255 :: Word32)) $ \w0 ->- forAll (choose (0, 255 :: Word32)) $ \w1 ->- let w2 = DVS.fromList [w0, w1] in- let (minE0, e0, _) = minMaxExcess0 w0 in- let (minE1, _ , _) = minMaxExcess0 w1 in- let (minE2, _ , _) = minMaxExcess0 w2 in- minE2 == minE0 `min` (minE1 + e0)- it "maxE2 == maxE0 `max` (maxE1 + e0) via vector" $- forAll (choose (0, 255 :: Word32)) $ \w0 ->- forAll (choose (0, 255 :: Word32)) $ \w1 ->- let w2 = DVS.fromList [w0, w1] in- let (_, e0, maxE0) = minMaxExcess0 w0 in- let (_, _ , maxE1) = minMaxExcess0 w1 in- let (_, _ , maxE2) = minMaxExcess0 w2 in- maxE2 == maxE0 `max` (maxE1 + e0) describe "For Word64" $ do it "Excess should be between min excess and max excess" $- forAll (choose (0, 255 :: Word64)) $ \w ->+ property $ \(w :: Word64) -> let (minE, e, maxE) = minMaxExcess0 w in minE <= e && e <= maxE it "minE2 == minE0 `min` (minE1 + e0) via vector" $- forAll (choose (0, 255 :: Word64)) $ \w0 ->- forAll (choose (0, 255 :: Word64)) $ \w1 ->- let w2 = DVS.fromList [w0, w1] in- let (minE0, e0, _) = minMaxExcess0 w0 in- let (minE1, _ , _) = minMaxExcess0 w1 in- let (minE2, _ , _) = minMaxExcess0 w2 in- minE2 == minE0 `min` (minE1 + e0)+ property $ \(w0 :: Word64, w1 :: Word64) ->+ let w2 = DVS.fromList [w0, w1] in+ let (minE0, e0, _) = minMaxExcess0 w0 in+ let (minE1, _ , _) = minMaxExcess0 w1 in+ let (minE2, _ , _) = minMaxExcess0 w2 in+ minE2 == minE0 `min` (minE1 + e0) it "maxE2 == maxE0 `max` (maxE1 + e0) via vector" $- forAll (choose (0, 255 :: Word64)) $ \w0 ->- forAll (choose (0, 255 :: Word64)) $ \w1 ->- let w2 = DVS.fromList [w0, w1] in- let (_, e0, maxE0) = minMaxExcess0 w0 in- let (_, _ , maxE1) = minMaxExcess0 w1 in- let (_, _ , maxE2) = minMaxExcess0 w2 in- maxE2 == maxE0 `max` (maxE1 + e0)+ property $ \(w0 :: Word64, w1 :: Word64) ->+ let w2 = DVS.fromList [w0, w1] in+ let (_, e0, maxE0) = minMaxExcess0 w0 in+ let (_, _ , maxE1) = minMaxExcess0 w1 in+ let (_, _ , maxE2) = minMaxExcess0 w2 in+ maxE2 == maxE0 `max` (maxE1 + e0)+ describe "Equivalent to native implementation" $ do+ it "For Word8" $ do+ property $ \(w :: Word8) ->+ minMaxExcess0 w == minMaxExcess0 (Naive w)+ it "For Word16" $ do+ property $ \(w :: Word16) ->+ minMaxExcess0 w == minMaxExcess0 (Naive w)+ it "For Word32" $ do+ property $ \(w :: Word32) ->+ minMaxExcess0 w == minMaxExcess0 (Naive w)+ it "For Word64" $ do+ property $ \(w :: Word64) ->+ minMaxExcess0 w == minMaxExcess0 (Naive w)
test/HaskellWorks/Data/Succinct/Excess/MinMaxExcess1Spec.hs view
@@ -7,6 +7,7 @@ import Data.Word import HaskellWorks.Data.Bits.Word import HaskellWorks.Data.Succinct.Excess.MinMaxExcess1+import HaskellWorks.Data.Naive import Test.Hspec import Test.QuickCheck @@ -17,133 +18,132 @@ spec = describe "HaskellWorks.Data.Succinct.Excess.MinMaxExcess1Spec" $ do describe "For Word8" $ do it "Excess should be between min excess and max excess" $- forAll (choose (0, 255 :: Word8)) $ \w ->+ property $ \(w :: Word8) -> let (minE, e, maxE) = minMaxExcess1 w in minE <= e && e <= maxE it "minE2 == minE0 `min` (minE1 + e0)" $- forAll (choose (0, 255 :: Word8)) $ \w0 ->- forAll (choose (0, 255 :: Word8)) $ \w1 ->- let w2 = leConcat w0 w1 in- let (minE0, e0, _) = minMaxExcess1 w0 in- let (minE1, _ , _) = minMaxExcess1 w1 in- let (minE2, _ , _) = minMaxExcess1 w2 in- minE2 == minE0 `min` (minE1 + e0)+ property $ \(w0 :: Word8, w1 :: Word8) ->+ let w2 = leConcat w0 w1 in+ let (minE0, e0, _) = minMaxExcess1 w0 in+ let (minE1, _ , _) = minMaxExcess1 w1 in+ let (minE2, _ , _) = minMaxExcess1 w2 in+ minE2 == minE0 `min` (minE1 + e0) it "maxE2 == maxE0 `max` (maxE1 + e0)" $- forAll (choose (0, 255 :: Word8)) $ \w0 ->- forAll (choose (0, 255 :: Word8)) $ \w1 ->- let w2 = leConcat w0 w1 in- let (_, e0, maxE0) = minMaxExcess1 w0 in- let (_, _ , maxE1) = minMaxExcess1 w1 in- let (_, _ , maxE2) = minMaxExcess1 w2 in- maxE2 == maxE0 `max` (maxE1 + e0)+ property $ \(w0 :: Word8, w1 :: Word8) ->+ let w2 = leConcat w0 w1 in+ let (_, e0, maxE0) = minMaxExcess1 w0 in+ let (_, _ , maxE1) = minMaxExcess1 w1 in+ let (_, _ , maxE2) = minMaxExcess1 w2 in+ maxE2 == maxE0 `max` (maxE1 + e0) it "minE2 == minE0 `min` (minE1 + e0) via vector" $- forAll (choose (0, 255 :: Word8)) $ \w0 ->- forAll (choose (0, 255 :: Word8)) $ \w1 ->- let w2 = DVS.fromList [w0, w1] in- let (minE0, e0, _) = minMaxExcess1 w0 in- let (minE1, _ , _) = minMaxExcess1 w1 in- let (minE2, _ , _) = minMaxExcess1 w2 in- minE2 == minE0 `min` (minE1 + e0)+ property $ \(w0 :: Word8, w1 :: Word8) ->+ let w2 = DVS.fromList [w0, w1] in+ let (minE0, e0, _) = minMaxExcess1 w0 in+ let (minE1, _ , _) = minMaxExcess1 w1 in+ let (minE2, _ , _) = minMaxExcess1 w2 in+ minE2 == minE0 `min` (minE1 + e0) it "maxE2 == maxE0 `max` (maxE1 + e0) via vector" $- forAll (choose (0, 255 :: Word8)) $ \w0 ->- forAll (choose (0, 255 :: Word8)) $ \w1 ->- let w2 = DVS.fromList [w0, w1] in- let (_, e0, maxE0) = minMaxExcess1 w0 in- let (_, _ , maxE1) = minMaxExcess1 w1 in- let (_, _ , maxE2) = minMaxExcess1 w2 in- maxE2 == maxE0 `max` (maxE1 + e0)+ property $ \(w0 :: Word8, w1 :: Word8) ->+ let w2 = DVS.fromList [w0, w1] in+ let (_, e0, maxE0) = minMaxExcess1 w0 in+ let (_, _ , maxE1) = minMaxExcess1 w1 in+ let (_, _ , maxE2) = minMaxExcess1 w2 in+ maxE2 == maxE0 `max` (maxE1 + e0) describe "For Word16" $ do it "Excess should be between min excess and max excess" $- forAll (choose (0, 255 :: Word16)) $ \w ->+ property $ \(w :: Word16) -> let (minE, e, maxE) = minMaxExcess1 w in minE <= e && e <= maxE it "minE2 == minE0 `min` (minE1 + e0)" $- forAll (choose (0, 255 :: Word16)) $ \w0 ->- forAll (choose (0, 255 :: Word16)) $ \w1 ->+ property $ \(w0 :: Word16, w1 :: Word16) ->+ let w2 = leConcat w0 w1 in+ let (minE0, e0, _) = minMaxExcess1 w0 in+ let (minE1, _ , _) = minMaxExcess1 w1 in+ let (minE2, _ , _) = minMaxExcess1 w2 in+ minE2 == minE0 `min` (minE1 + e0)+ it "maxE2 == maxE0 `max` (maxE1 + e0)" $+ property $ \(w0 :: Word16, w1 :: Word16) ->+ let w2 = leConcat w0 w1 in+ let (_, e0, maxE0) = minMaxExcess1 w0 in+ let (_, _ , maxE1) = minMaxExcess1 w1 in+ let (_, _ , maxE2) = minMaxExcess1 w2 in+ maxE2 == maxE0 `max` (maxE1 + e0)+ it "minE2 == minE0 `min` (minE1 + e0) via vector" $+ property $ \(w0 :: Word16, w1 :: Word16) ->+ let w2 = DVS.fromList [w0, w1] in+ let (minE0, e0, _) = minMaxExcess1 w0 in+ let (minE1, _ , _) = minMaxExcess1 w1 in+ let (minE2, _ , _) = minMaxExcess1 w2 in+ minE2 == minE0 `min` (minE1 + e0)+ it "maxE2 == maxE0 `max` (maxE1 + e0) via vector" $+ property $ \(w0 :: Word16, w1 :: Word16) ->+ let w2 = DVS.fromList [w0, w1] in+ let (_, e0, maxE0) = minMaxExcess1 w0 in+ let (_, _ , maxE1) = minMaxExcess1 w1 in+ let (_, _ , maxE2) = minMaxExcess1 w2 in+ maxE2 == maxE0 `max` (maxE1 + e0)+ describe "For Word32" $ do+ it "Excess should be between min excess and max excess" $+ property $ \(w :: Word32) ->+ let (minE, e, maxE) = minMaxExcess1 w in+ minE <= e && e <= maxE+ it "minE2 == minE0 `min` (minE1 + e0)" $+ property $ \(w0 :: Word32, w1 :: Word32) -> let w2 = leConcat w0 w1 in let (minE0, e0, _) = minMaxExcess1 w0 in let (minE1, _ , _) = minMaxExcess1 w1 in let (minE2, _ , _) = minMaxExcess1 w2 in minE2 == minE0 `min` (minE1 + e0)- it "maxE2 == maxE0 `max` (maxE1 + e0)" $- forAll (choose (0, 255 :: Word16)) $ \w0 ->- forAll (choose (0, 255 :: Word16)) $ \w1 ->+ it "maxE2 == maxE0 `max` (maxE1 + e0)" $+ property $ \(w0 :: Word32, w1 :: Word32) -> let w2 = leConcat w0 w1 in let (_, e0, maxE0) = minMaxExcess1 w0 in let (_, _ , maxE1) = minMaxExcess1 w1 in let (_, _ , maxE2) = minMaxExcess1 w2 in maxE2 == maxE0 `max` (maxE1 + e0)- it "minE2 == minE0 `min` (minE1 + e0) via vector" $- forAll (choose (0, 255 :: Word16)) $ \w0 ->- forAll (choose (0, 255 :: Word16)) $ \w1 ->+ it "minE2 == minE0 `min` (minE1 + e0) via vector" $+ property $ \(w0 :: Word32, w1 :: Word32) -> let w2 = DVS.fromList [w0, w1] in let (minE0, e0, _) = minMaxExcess1 w0 in let (minE1, _ , _) = minMaxExcess1 w1 in let (minE2, _ , _) = minMaxExcess1 w2 in minE2 == minE0 `min` (minE1 + e0)- it "maxE2 == maxE0 `max` (maxE1 + e0) via vector" $- forAll (choose (0, 255 :: Word16)) $ \w0 ->- forAll (choose (0, 255 :: Word16)) $ \w1 ->+ it "maxE2 == maxE0 `max` (maxE1 + e0) via vector" $+ property $ \(w0 :: Word32, w1 :: Word32) -> let w2 = DVS.fromList [w0, w1] in let (_, e0, maxE0) = minMaxExcess1 w0 in let (_, _ , maxE1) = minMaxExcess1 w1 in let (_, _ , maxE2) = minMaxExcess1 w2 in maxE2 == maxE0 `max` (maxE1 + e0)- describe "For Word32" $ do- it "Excess should be between min excess and max excess" $- forAll (choose (0, 255 :: Word32)) $ \w ->- let (minE, e, maxE) = minMaxExcess1 w in- minE <= e && e <= maxE- it "minE2 == minE0 `min` (minE1 + e0)" $- forAll (choose (0, 255 :: Word32)) $ \w0 ->- forAll (choose (0, 255 :: Word32)) $ \w1 ->- let w2 = leConcat w0 w1 in- let (minE0, e0, _) = minMaxExcess1 w0 in- let (minE1, _ , _) = minMaxExcess1 w1 in- let (minE2, _ , _) = minMaxExcess1 w2 in- minE2 == minE0 `min` (minE1 + e0)- it "maxE2 == maxE0 `max` (maxE1 + e0)" $- forAll (choose (0, 255 :: Word32)) $ \w0 ->- forAll (choose (0, 255 :: Word32)) $ \w1 ->- let w2 = leConcat w0 w1 in- let (_, e0, maxE0) = minMaxExcess1 w0 in- let (_, _ , maxE1) = minMaxExcess1 w1 in- let (_, _ , maxE2) = minMaxExcess1 w2 in- maxE2 == maxE0 `max` (maxE1 + e0)- it "minE2 == minE0 `min` (minE1 + e0) via vector" $- forAll (choose (0, 255 :: Word32)) $ \w0 ->- forAll (choose (0, 255 :: Word32)) $ \w1 ->- let w2 = DVS.fromList [w0, w1] in- let (minE0, e0, _) = minMaxExcess1 w0 in- let (minE1, _ , _) = minMaxExcess1 w1 in- let (minE2, _ , _) = minMaxExcess1 w2 in- minE2 == minE0 `min` (minE1 + e0)- it "maxE2 == maxE0 `max` (maxE1 + e0) via vector" $- forAll (choose (0, 255 :: Word32)) $ \w0 ->- forAll (choose (0, 255 :: Word32)) $ \w1 ->- let w2 = DVS.fromList [w0, w1] in- let (_, e0, maxE0) = minMaxExcess1 w0 in- let (_, _ , maxE1) = minMaxExcess1 w1 in- let (_, _ , maxE2) = minMaxExcess1 w2 in- maxE2 == maxE0 `max` (maxE1 + e0) describe "For Word64" $ do it "Excess should be between min excess and max excess" $- forAll (choose (0, 255 :: Word64)) $ \w ->+ property $ \(w :: Word64) -> let (minE, e, maxE) = minMaxExcess1 w in minE <= e && e <= maxE it "minE2 == minE0 `min` (minE1 + e0) via vector" $- forAll (choose (0, 255 :: Word64)) $ \w0 ->- forAll (choose (0, 255 :: Word64)) $ \w1 ->- let w2 = DVS.fromList [w0, w1] in- let (minE0, e0, _) = minMaxExcess1 w0 in- let (minE1, _ , _) = minMaxExcess1 w1 in- let (minE2, _ , _) = minMaxExcess1 w2 in- minE2 == minE0 `min` (minE1 + e0)+ property $ \(w0 :: Word64, w1 :: Word64) ->+ let w2 = DVS.fromList [w0, w1] in+ let (minE0, e0, _) = minMaxExcess1 w0 in+ let (minE1, _ , _) = minMaxExcess1 w1 in+ let (minE2, _ , _) = minMaxExcess1 w2 in+ minE2 == minE0 `min` (minE1 + e0) it "maxE2 == maxE0 `max` (maxE1 + e0) via vector" $- forAll (choose (0, 255 :: Word64)) $ \w0 ->- forAll (choose (0, 255 :: Word64)) $ \w1 ->- let w2 = DVS.fromList [w0, w1] in- let (_, e0, maxE0) = minMaxExcess1 w0 in- let (_, _ , maxE1) = minMaxExcess1 w1 in- let (_, _ , maxE2) = minMaxExcess1 w2 in- maxE2 == maxE0 `max` (maxE1 + e0)+ property $ \(w0 :: Word64, w1 :: Word64) ->+ let w2 = DVS.fromList [w0, w1] in+ let (_, e0, maxE0) = minMaxExcess1 w0 in+ let (_, _ , maxE1) = minMaxExcess1 w1 in+ let (_, _ , maxE2) = minMaxExcess1 w2 in+ maxE2 == maxE0 `max` (maxE1 + e0)+ describe "Equivalent to native implementation" $ do+ it "For Word8" $ do+ property $ \(w :: Word8) ->+ minMaxExcess1 w == minMaxExcess1 (Naive w)+ it "For Word16" $ do+ property $ \(w :: Word16) ->+ minMaxExcess1 w == minMaxExcess1 (Naive w)+ it "For Word32" $ do+ property $ \(w :: Word32) ->+ minMaxExcess1 w == minMaxExcess1 (Naive w)+ it "For Word64" $ do+ property $ \(w :: Word64) ->+ minMaxExcess1 w == minMaxExcess1 (Naive w)