hw-balancedparens 0.2.0.4 → 0.2.1.0
raw patch · 16 files changed
+880/−287 lines, 16 filesdep +hedgehogdep +hw-fingertreedep +hw-hspec-hedgehogdep −QuickCheckdep ~hw-excessdep ~hw-primPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: hedgehog, hw-fingertree, hw-hspec-hedgehog, transformers
Dependencies removed: QuickCheck
Dependency ranges changed: hw-excess, hw-prim
API changes (from Hackage documentation)
- HaskellWorks.Data.BalancedParens.RangeMinMax: [rangeMinMaxBP] :: RangeMinMax a -> !a
- HaskellWorks.Data.BalancedParens.RangeMinMax: [rangeMinMaxL0Excess] :: RangeMinMax a -> !Vector Int8
- HaskellWorks.Data.BalancedParens.RangeMinMax: [rangeMinMaxL0Max] :: RangeMinMax a -> !Vector Int8
- HaskellWorks.Data.BalancedParens.RangeMinMax: [rangeMinMaxL0Min] :: RangeMinMax a -> !Vector Int8
- HaskellWorks.Data.BalancedParens.RangeMinMax: [rangeMinMaxL1Excess] :: RangeMinMax a -> !Vector Int16
- HaskellWorks.Data.BalancedParens.RangeMinMax: [rangeMinMaxL1Max] :: RangeMinMax a -> !Vector Int16
- HaskellWorks.Data.BalancedParens.RangeMinMax: [rangeMinMaxL1Min] :: RangeMinMax a -> !Vector Int16
- HaskellWorks.Data.BalancedParens.RangeMinMax: [rangeMinMaxL2Excess] :: RangeMinMax a -> !Vector Int16
- HaskellWorks.Data.BalancedParens.RangeMinMax: [rangeMinMaxL2Max] :: RangeMinMax a -> !Vector Int16
- HaskellWorks.Data.BalancedParens.RangeMinMax: [rangeMinMaxL2Min] :: RangeMinMax a -> !Vector Int16
- HaskellWorks.Data.BalancedParens.RangeMinMax2: [rangeMinMax2L0Max] :: RangeMinMax2 a -> !Vector Int8
- HaskellWorks.Data.BalancedParens.RangeMinMax2: [rangeMinMax2L1Max] :: RangeMinMax2 a -> !Vector Int16
- HaskellWorks.Data.BalancedParens.RangeMinMax2: [rangeMinMax2L2Max] :: RangeMinMax2 a -> !Vector Int16
- HaskellWorks.Data.BalancedParens.RangeMinMax2: [rangeMinMax2L3Max] :: RangeMinMax2 a -> !Vector Int16
- HaskellWorks.Data.BalancedParens.RangeMinMax2: [rangeMinMax2L4Max] :: RangeMinMax2 a -> !Vector Int16
- HaskellWorks.Data.BalancedParens.RangeMinMax2: genMax :: (Integral a, Storable a) => a -> Vector a -> Vector a -> a
- HaskellWorks.Data.BalancedParens.RangeMinMax2: genMin :: (Integral a, Storable a) => a -> Vector a -> Vector a -> a
+ HaskellWorks.Data.BalancedParens.Internal.List: chunkBy :: Int -> [a] -> [[a]]
+ HaskellWorks.Data.BalancedParens.Internal.List: toBalancedParensString :: [Bool] -> String
+ HaskellWorks.Data.BalancedParens.Internal.List: toBools :: [Word64] -> [Bool]
+ HaskellWorks.Data.BalancedParens.Internal.ParensSeq: (<|) :: Cons v => Elem v -> v -> v
+ HaskellWorks.Data.BalancedParens.Internal.ParensSeq: (><) :: (Semigroup v, Container v) => v -> v -> v
+ HaskellWorks.Data.BalancedParens.Internal.ParensSeq: (|>) :: Snoc v => v -> Elem v -> v
+ HaskellWorks.Data.BalancedParens.Internal.ParensSeq: ParensSeq :: ParensSeqFt -> ParensSeq
+ HaskellWorks.Data.BalancedParens.Internal.ParensSeq: [$sel:parens:ParensSeq] :: ParensSeq -> ParensSeqFt
+ HaskellWorks.Data.BalancedParens.Internal.ParensSeq: drop :: Count -> ParensSeq -> ParensSeq
+ HaskellWorks.Data.BalancedParens.Internal.ParensSeq: firstChild :: ParensSeq -> Count -> Maybe Count
+ HaskellWorks.Data.BalancedParens.Internal.ParensSeq: fromBools :: [Bool] -> ParensSeq
+ HaskellWorks.Data.BalancedParens.Internal.ParensSeq: fromPartialWord64s :: Traversable f => f (Word64, Count) -> ParensSeq
+ HaskellWorks.Data.BalancedParens.Internal.ParensSeq: fromWord64s :: Traversable f => f Word64 -> ParensSeq
+ HaskellWorks.Data.BalancedParens.Internal.ParensSeq: infixl 5 |>
+ HaskellWorks.Data.BalancedParens.Internal.ParensSeq: infixr 5 ><
+ HaskellWorks.Data.BalancedParens.Internal.ParensSeq: mempty :: Monoid a => a
+ HaskellWorks.Data.BalancedParens.Internal.ParensSeq: newtype ParensSeq
+ HaskellWorks.Data.BalancedParens.Internal.ParensSeq: nextSibling :: ParensSeq -> Count -> Maybe Count
+ HaskellWorks.Data.BalancedParens.Internal.ParensSeq: size :: ParensSeq -> Count
+ HaskellWorks.Data.BalancedParens.Internal.ParensSeq: splitAt :: Count -> ParensSeq -> (ParensSeq, ParensSeq)
+ HaskellWorks.Data.BalancedParens.Internal.ParensSeq: take :: Count -> ParensSeq -> ParensSeq
+ HaskellWorks.Data.BalancedParens.Internal.ParensSeq: toBools :: ParensSeq -> [Bool]
+ HaskellWorks.Data.BalancedParens.Internal.ParensSeq: toPartialWord64s :: ParensSeq -> [(Word64, Count)]
+ HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Internal: (#<|) :: Elem -> ParensSeqFt -> ParensSeqFt
+ HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Internal: (|>#) :: ParensSeqFt -> Elem -> ParensSeqFt
+ HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Internal: Elem :: {-# UNPACK #-} !Word64 -> {-# UNPACK #-} !Count -> Elem
+ HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Internal: Measure :: {-# UNPACK #-} !Count -> {-# UNPACK #-} !Int -> {-# UNPACK #-} !Int -> Measure
+ HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Internal: ParensSeq :: ParensSeqFt -> ParensSeq
+ HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Internal: [$sel:bps:Elem] :: Elem -> {-# UNPACK #-} !Word64
+ HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Internal: [$sel:excess:Measure] :: Measure -> {-# UNPACK #-} !Int
+ HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Internal: [$sel:min:Measure] :: Measure -> {-# UNPACK #-} !Int
+ HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Internal: [$sel:parens:ParensSeq] :: ParensSeq -> ParensSeqFt
+ HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Internal: [$sel:size:Elem] :: Elem -> {-# UNPACK #-} !Count
+ HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Internal: [$sel:size:Measure] :: Measure -> {-# UNPACK #-} !Count
+ HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Internal: atMinZero :: Measure -> Bool
+ HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Internal: atSizeBelowZero :: Count -> Measure -> Bool
+ HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Internal: data Elem
+ HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Internal: data Measure
+ HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Internal: ftSplit :: (Measure -> Bool) -> ParensSeqFt -> (ParensSeqFt, ParensSeqFt)
+ HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Internal: instance Control.DeepSeq.NFData HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Internal.Elem
+ HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Internal: instance Control.DeepSeq.NFData HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Internal.Measure
+ HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Internal: instance Control.DeepSeq.NFData HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Internal.ParensSeq
+ HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Internal: instance GHC.Base.Monoid HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Internal.Measure
+ HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Internal: instance GHC.Base.Semigroup HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Internal.Measure
+ HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Internal: instance GHC.Base.Semigroup HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Internal.ParensSeq
+ HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Internal: instance GHC.Classes.Eq HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Internal.Elem
+ HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Internal: instance GHC.Classes.Eq HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Internal.Measure
+ HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Internal: instance GHC.Classes.Ord HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Internal.Measure
+ HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Internal: instance GHC.Generics.Generic HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Internal.Elem
+ HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Internal: instance GHC.Generics.Generic HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Internal.Measure
+ HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Internal: instance GHC.Generics.Generic HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Internal.ParensSeq
+ HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Internal: instance GHC.Show.Show HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Internal.Elem
+ HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Internal: instance GHC.Show.Show HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Internal.Measure
+ HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Internal: instance GHC.Show.Show HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Internal.ParensSeq
+ HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Internal: instance HaskellWorks.Data.Cons.Cons HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Internal.ParensSeq
+ HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Internal: instance HaskellWorks.Data.Container.Container HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Internal.ParensSeq
+ HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Internal: instance HaskellWorks.Data.FingerTree.Measured HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Internal.Measure HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Internal.Elem
+ HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Internal: instance HaskellWorks.Data.Snoc.Snoc HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Internal.ParensSeq
+ HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Internal: newtype ParensSeq
+ HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Internal: type ParensSeqFt = FingerTree Measure Elem
+ HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Types: data ParensSeq
+ HaskellWorks.Data.BalancedParens.Internal.RoseTree: RoseTree :: [RoseTree] -> RoseTree
+ HaskellWorks.Data.BalancedParens.Internal.RoseTree: [children] :: RoseTree -> [RoseTree]
+ HaskellWorks.Data.BalancedParens.Internal.RoseTree: depth :: RoseTree -> Int
+ HaskellWorks.Data.BalancedParens.Internal.RoseTree: instance GHC.Classes.Eq HaskellWorks.Data.BalancedParens.Internal.RoseTree.RoseTree
+ HaskellWorks.Data.BalancedParens.Internal.RoseTree: instance GHC.Show.Show HaskellWorks.Data.BalancedParens.Internal.RoseTree.RoseTree
+ HaskellWorks.Data.BalancedParens.Internal.RoseTree: newtype RoseTree
+ HaskellWorks.Data.BalancedParens.Internal.RoseTree: size :: RoseTree -> Int
+ HaskellWorks.Data.BalancedParens.Internal.RoseTree: toBools :: RoseTree -> [Bool]
+ HaskellWorks.Data.BalancedParens.Internal.RoseTree: toBools' :: RoseTree -> [Bool] -> [Bool]
+ HaskellWorks.Data.BalancedParens.Internal.Word: partialToBoolsDiff :: Count -> Word64 -> [Bool] -> [Bool]
+ HaskellWorks.Data.BalancedParens.Internal.Word: toBools :: Word64 -> [Bool]
+ HaskellWorks.Data.BalancedParens.Internal.Word: toBoolsDiff :: Word64 -> [Bool] -> [Bool]
+ HaskellWorks.Data.BalancedParens.RangeMinMax: [$sel:rangeMinMaxBP:RangeMinMax] :: RangeMinMax a -> !a
+ HaskellWorks.Data.BalancedParens.RangeMinMax: [$sel:rangeMinMaxL0Excess:RangeMinMax] :: RangeMinMax a -> !Vector Int8
+ HaskellWorks.Data.BalancedParens.RangeMinMax: [$sel:rangeMinMaxL0Min:RangeMinMax] :: RangeMinMax a -> !Vector Int8
+ HaskellWorks.Data.BalancedParens.RangeMinMax: [$sel:rangeMinMaxL1Excess:RangeMinMax] :: RangeMinMax a -> !Vector Int16
+ HaskellWorks.Data.BalancedParens.RangeMinMax: [$sel:rangeMinMaxL1Min:RangeMinMax] :: RangeMinMax a -> !Vector Int16
+ HaskellWorks.Data.BalancedParens.RangeMinMax: [$sel:rangeMinMaxL2Excess:RangeMinMax] :: RangeMinMax a -> !Vector Int16
+ HaskellWorks.Data.BalancedParens.RangeMinMax: [$sel:rangeMinMaxL2Min:RangeMinMax] :: RangeMinMax a -> !Vector Int16
- HaskellWorks.Data.BalancedParens.RangeMinMax: RangeMinMax :: !a -> !Vector Int8 -> !Vector Int8 -> !Vector Int8 -> !Vector Int16 -> !Vector Int16 -> !Vector Int16 -> !Vector Int16 -> !Vector Int16 -> !Vector Int16 -> RangeMinMax a
+ HaskellWorks.Data.BalancedParens.RangeMinMax: RangeMinMax :: !a -> !Vector Int8 -> !Vector Int8 -> !Vector Int16 -> !Vector Int16 -> !Vector Int16 -> !Vector Int16 -> RangeMinMax a
- HaskellWorks.Data.BalancedParens.RangeMinMax2: RangeMinMax2 :: !a -> !Vector Int8 -> !Vector Int8 -> !Vector Int8 -> !Vector Int16 -> !Vector Int16 -> !Vector Int16 -> !Vector Int16 -> !Vector Int16 -> !Vector Int16 -> !Vector Int16 -> !Vector Int16 -> !Vector Int16 -> !Vector Int16 -> !Vector Int16 -> !Vector Int16 -> RangeMinMax2 a
+ HaskellWorks.Data.BalancedParens.RangeMinMax2: RangeMinMax2 :: !a -> !Vector Int8 -> !Vector Int8 -> !Vector Int16 -> !Vector Int16 -> !Vector Int16 -> !Vector Int16 -> !Vector Int16 -> !Vector Int16 -> !Vector Int16 -> !Vector Int16 -> RangeMinMax2 a
Files
- bench/Main.hs +84/−35
- gen/HaskellWorks/Data/BalancedParens/Gen.hs +88/−0
- hw-balancedparens.cabal +41/−11
- src/HaskellWorks/Data/BalancedParens/Internal/List.hs +24/−0
- src/HaskellWorks/Data/BalancedParens/Internal/ParensSeq.hs +139/−0
- src/HaskellWorks/Data/BalancedParens/Internal/ParensSeq/Internal.hs +127/−0
- src/HaskellWorks/Data/BalancedParens/Internal/ParensSeq/Types.hs +5/−0
- src/HaskellWorks/Data/BalancedParens/Internal/RoseTree.hs +23/−0
- src/HaskellWorks/Data/BalancedParens/Internal/Word.hs +30/−0
- src/HaskellWorks/Data/BalancedParens/RangeMinMax.hs +16/−24
- src/HaskellWorks/Data/BalancedParens/RangeMinMax2.hs +4/−26
- test/HaskellWorks/Data/BalancedParens/Internal/BroadwordSpec.hs +17/−16
- test/HaskellWorks/Data/BalancedParens/Internal/ParensSeqSpec.hs +128/−0
- test/HaskellWorks/Data/BalancedParens/RangeMinMax2Spec.hs +8/−16
- test/HaskellWorks/Data/BalancedParens/RangeMinMaxSpec.hs +35/−41
- test/HaskellWorks/Data/BalancedParens/SimpleSpec.hs +111/−118
bench/Main.hs view
@@ -3,15 +3,21 @@ module Main where import Criterion.Main+import Data.Semigroup ((<>)) import Data.Word import HaskellWorks.Data.BalancedParens.FindClose import HaskellWorks.Data.Bits.Broadword import HaskellWorks.Data.Bits.FromBitTextByteString import HaskellWorks.Data.Naive+import HaskellWorks.Data.Ops -import qualified Data.Vector.Storable as DVS-import qualified HaskellWorks.Data.BalancedParens.RangeMinMax as RMM-import qualified HaskellWorks.Data.BalancedParens.RangeMinMax2 as RMM2+import qualified Data.Vector.Storable as DVS+import qualified HaskellWorks.Data.BalancedParens.Gen as G+import qualified HaskellWorks.Data.BalancedParens.Internal.ParensSeq as PS+import qualified HaskellWorks.Data.BalancedParens.RangeMinMax as RMM+import qualified HaskellWorks.Data.BalancedParens.RangeMinMax2 as RMM2+import qualified Hedgehog.Gen as G+import qualified Hedgehog.Range as R setupEnvVector :: Int -> IO (DVS.Vector Word64) setupEnvVector n = return $ DVS.fromList (take n (cycle [maxBound, 0]))@@ -40,42 +46,85 @@ setupEnvBP64 :: IO Word64 setupEnvBP64 = return $ DVS.head (fromBitTextByteString "11111000 11101000 11101000 11101000 11101000 11101000 11101000 11100000") -benchRankSelect :: [Benchmark]-benchRankSelect =- [ env setupEnvBP2 $ \w -> bgroup "FindClose 2-bit"- [ bench "Broadword" (whnf (findClose (Broadword w)) 1)- , bench "Naive" (whnf (findClose (Naive w)) 1)- ]- , env setupEnvBP4 $ \w -> bgroup "FindClose 4-bit"- [ bench "Broadword" (whnf (findClose (Broadword w)) 1)- , bench "Naive" (whnf (findClose (Naive w)) 1)- ]- , env setupEnvBP8 $ \w -> bgroup "FindClose 8-bit"- [ bench "Broadword" (whnf (findClose (Broadword w)) 1)- , bench "Naive" (whnf (findClose (Naive w)) 1)- ]- , env setupEnvBP16 $ \w -> bgroup "FindClose 16-bit"- [ bench "Broadword" (whnf (findClose (Broadword w)) 1)- , bench "Naive" (whnf (findClose (Naive w)) 1)- ]- , env setupEnvBP32 $ \w -> bgroup "FindClose 32-bit"- [ bench "Broadword" (whnf (findClose (Broadword w)) 1)- , bench "Naive" (whnf (findClose (Naive w)) 1)- ]- , env setupEnvBP64 $ \w -> bgroup "FindClose 64-bit"- [ bench "Broadword" (whnf (findClose (Broadword w)) 1)- , bench "Naive" (whnf (findClose (Naive w)) 1)+benchVector :: [Benchmark]+benchVector =+ [ bgroup "Vector"+ [ env setupEnvBP2 $ \w -> bgroup "FindClose 2-bit"+ [ bench "Broadword" (whnf (findClose (Broadword w)) 1)+ , bench "Naive" (whnf (findClose (Naive w)) 1)+ ]+ , env setupEnvBP4 $ \w -> bgroup "FindClose 4-bit"+ [ bench "Broadword" (whnf (findClose (Broadword w)) 1)+ , bench "Naive" (whnf (findClose (Naive w)) 1)+ ]+ , env setupEnvBP8 $ \w -> bgroup "FindClose 8-bit"+ [ bench "Broadword" (whnf (findClose (Broadword w)) 1)+ , bench "Naive" (whnf (findClose (Naive w)) 1)+ ]+ , env setupEnvBP16 $ \w -> bgroup "FindClose 16-bit"+ [ bench "Broadword" (whnf (findClose (Broadword w)) 1)+ , bench "Naive" (whnf (findClose (Naive w)) 1)+ ]+ , env setupEnvBP32 $ \w -> bgroup "FindClose 32-bit"+ [ bench "Broadword" (whnf (findClose (Broadword w)) 1)+ , bench "Naive" (whnf (findClose (Naive w)) 1)+ ]+ , env setupEnvBP64 $ \w -> bgroup "FindClose 64-bit"+ [ bench "Broadword" (whnf (findClose (Broadword w)) 1)+ , bench "Naive" (whnf (findClose (Naive w)) 1)+ ]+ , env (setupEnvVector 1000000) $ \bv -> bgroup "Vanilla"+ [ bench "findClose" (nf (map (findClose bv)) [0, 1000..10000000])+ ] ]- , env (setupEnvVector 1000000) $ \bv -> bgroup "Vanilla"- [ bench "findClose" (nf (map (findClose bv)) [0, 1000..10000000])+ ]++benchRmm :: [Benchmark]+benchRmm =+ [ bgroup "Rmm"+ [ env (G.sample (G.storableVector (R.singleton 1000) (G.word64 R.constantBounded))) $ \v -> bgroup "Vector64"+ [ bench "mkRangeMinMax" (nf RMM.mkRangeMinMax v)+ ]+ , env (setupEnvRmmVector 1000000) $ \bv -> bgroup "RangeMinMax"+ [ bench "findClose" (nf (map (findClose bv)) [0, 1000..10000000])+ ] ]- , env (setupEnvRmmVector 1000000) $ \bv -> bgroup "RangeMinMax"- [ bench "findClose" (nf (map (findClose bv)) [0, 1000..10000000])+ ]++benchRmm2 :: [Benchmark]+benchRmm2 =+ [ bgroup "Rmm2"+ [ env (G.sample (G.storableVector (R.singleton 1000) (G.word64 R.constantBounded))) $ \v -> bgroup "Vector64"+ [ bench "mkRangeMinMax2" (nf RMM2.mkRangeMinMax2 v)+ ]+ , env (setupEnvRmm2Vector 1000000) $ \bv -> bgroup "RangeMinMax2"+ [ bench "findClose" (nf (map (findClose bv)) [0, 1000..10000000])+ ] ]- , env (setupEnvRmm2Vector 1000000) $ \bv -> bgroup "RangeMinMax2"- [ bench "findClose" (nf (map (findClose bv)) [0, 1000..10000000])+ ]++benchParensSeq :: [Benchmark]+benchParensSeq =+ [ bgroup "ParensSeq"+ [ env (G.sample (G.bpParensSeq (R.singleton 100000))) $ \ps -> bgroup "ParensSeq"+ [ bench "firstChild" (nf (map (PS.firstChild ps)) [1,101..100000])+ , bench "nextSibling" (nf (map (PS.nextSibling ps)) [1,101..100000])+ , bench "(<|)" (nf (<| ps) True)+ , bench "(|>)" (nf (ps |>) True)+ , bench "drop" (nf (fmap (flip PS.drop ps)) [1,101..100000])+ ]+ , env (G.sample (G.vec2 (G.bpParensSeq (R.singleton 100000)))) $ \ ~(ps1, ps2) -> bgroup "ParensSeq"+ [ bench "(<>)" (nf (ps1 <>) ps2)+ ]+ , env (G.sample (G.list (R.singleton 100) (G.word64 (R.constantBounded)))) $ \ws -> bgroup "ParensSeq"+ [ bench "fromWord64s" (nf PS.fromWord64s ws)+ ] ] ] main :: IO ()-main = defaultMain benchRankSelect+main = defaultMain $ mempty+ <> benchVector+ <> benchRmm+ <> benchRmm2+ <> benchParensSeq
+ gen/HaskellWorks/Data/BalancedParens/Gen.hs view
@@ -0,0 +1,88 @@+{-# LANGUAGE TupleSections #-}++module HaskellWorks.Data.BalancedParens.Gen+ ( BP(..)+ , count+ , bpBools+ , showBps+ , storableVector+ , bpParensSeq+ , vector+ , vec2+ , randomRmm+ , randomRmm2+ ) where++import Data.Coerce+import Data.Semigroup ((<>))+import Data.Word+import HaskellWorks.Data.BalancedParens.Internal.ParensSeq (ParensSeq)+import HaskellWorks.Data.Positioning+import Hedgehog++import qualified Data.Vector as DV+import qualified Data.Vector.Storable as DVS+import qualified HaskellWorks.Data.BalancedParens.Internal.ParensSeq as PS+import qualified HaskellWorks.Data.BalancedParens.RangeMinMax as RMM+import qualified HaskellWorks.Data.BalancedParens.RangeMinMax2 as RMM2+import qualified Hedgehog.Gen as G+import qualified Hedgehog.Range as R++count :: MonadGen m => Range Count -> m Count+count r = coerce <$> G.word64 (coerce <$> r)++data LR a = L a Int | R a Int deriving (Eq, Show)++newtype BP = BP [Bool] deriving Eq++showBps :: [Bool] -> String+showBps = fmap fromBool+ where fromBool True = '('+ fromBool False = ')'++bpBools' :: MonadGen m => Int -> (Int, [Bool], [Bool], Int) -> m [Bool]+bpBools' n (ln, lt, rt, rn) = if n <= 0+ then return (reverse lt <> rt)+ else if ln - rn >= n+ then return (reverse lt <> replicate n False <> rt)+ else if rn - ln >= n+ then return (reverse lt <> replicate n True <> rt)+ else do+ decision <- case (ln, rn) of+ (0, 0) -> G.element [L '(' 1, R ')' 1]+ (0, _) -> G.element [L '(' 1, R '(' (-1), R ')' 1]+ (_, 0) -> G.element [L '(' 1, L ')' (-1), R ')' 1]+ _ -> G.element [L '(' 1, R ')' 1]++ case decision of+ L p d -> bpBools' (n - 1) (ln + d, toBool p:lt, rt, rn )+ R p d -> bpBools' (n - 1) (ln , lt, toBool p:rt, rn + d)+ where toBool '(' = True+ toBool _ = False++bpBools :: MonadGen m => Range Int -> m [Bool]+bpBools r = do+ n <- G.int r+ bpBools' (n * 2) (0, [], [], 0)++bpParensSeq :: MonadGen m => Range Int -> m ParensSeq+bpParensSeq = fmap PS.fromBools . bpBools++storableVector :: (MonadGen m, DVS.Storable a) => Range Int -> m a -> m (DVS.Vector a)+storableVector r g = DVS.fromList <$> G.list r g++vector :: MonadGen m => Range Int -> m a -> m (DV.Vector a)+vector r g = DV.fromList <$> G.list r g++vec2 :: MonadGen m => m a -> m (a, a)+vec2 g = (,) <$> g <*> g++randomRmm :: MonadGen m => Range Int -> m (RMM.RangeMinMax (DVS.Vector Word64))+randomRmm r = do+ v <- storableVector (fmap (64 *) r) (G.word64 R.constantBounded)+ return (RMM.mkRangeMinMax v)++randomRmm2 :: MonadGen m => Range Int -> m (RMM2.RangeMinMax2 (DVS.Vector Word64))+randomRmm2 r = do+ v <- storableVector (fmap (64 *) r) (G.word64 R.constantBounded)+ return (RMM2.mkRangeMinMax2 v)
hw-balancedparens.cabal view
@@ -1,7 +1,7 @@ cabal-version: 2.2 name: hw-balancedparens-version: 0.2.0.4+version: 0.2.1.0 synopsis: Balanced parentheses description: Balanced parentheses. category: Data, Bit, Succinct Data Structures, Data Structures@@ -23,14 +23,17 @@ common base { build-depends: base >= 4 && < 5 } -common QuickCheck { build-depends: QuickCheck >= 2.10 && < 2.12 } common criterion { build-depends: criterion >= 1.2 && < 1.6 } common deepseq { build-depends: deepseq >= 1.4.2.0 && < 1.5 }+common hedgehog { build-depends: hedgehog >= 1.0 && < 1.1 } common hspec { build-depends: hspec >= 2.2 && < 2.6 }+common hw-hspec-hedgehog { build-depends: hw-hspec-hedgehog >= 0.1 && < 0.2 } common hw-bits { build-depends: hw-bits >= 0.4.0.0 && < 0.8 }-common hw-excess { build-depends: hw-excess >= 0.2.1.0 && < 0.3 }-common hw-prim { build-depends: hw-prim >= 0.4.0.0 && < 0.7 }+common hw-excess { build-depends: hw-excess >= 0.2.2.0 && < 0.3 }+common hw-fingertree { build-depends: hw-fingertree >= 0.1.1.0 && < 0.2 }+common hw-prim { build-depends: hw-prim >= 0.6.2.25 && < 0.7 } common hw-rankselect-base { build-depends: hw-rankselect-base >= 0.2.0.0 && < 0.4 }+common transformers { build-depends: transformers >= 0.5.6.2 && < 0.6 } common vector { build-depends: vector >= 0.12 && < 0.13 } common config@@ -42,6 +45,7 @@ , deepseq , hw-bits , hw-excess+ , hw-fingertree , hw-prim , hw-rankselect-base , vector@@ -55,6 +59,12 @@ HaskellWorks.Data.BalancedParens.FindCloseN HaskellWorks.Data.BalancedParens.FindOpen HaskellWorks.Data.BalancedParens.FindOpenN+ HaskellWorks.Data.BalancedParens.Internal.List+ HaskellWorks.Data.BalancedParens.Internal.ParensSeq+ HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Internal+ HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Types+ HaskellWorks.Data.BalancedParens.Internal.RoseTree+ HaskellWorks.Data.BalancedParens.Internal.Word HaskellWorks.Data.BalancedParens.NewCloseAt HaskellWorks.Data.BalancedParens.NewOpenAt HaskellWorks.Data.BalancedParens.OpenAt@@ -65,31 +75,50 @@ autogen-modules: Paths_hw_balancedparens hs-source-dirs: src +library hw-balancedparens-gen+ import: base, config+ , deepseq+ , hedgehog+ , hspec+ , hw-prim+ , vector+ exposed-modules:+ HaskellWorks.Data.BalancedParens.Gen+ Paths_hw_balancedparens+ build-depends: hw-balancedparens+ hs-source-dirs: gen+ autogen-modules: Paths_hw_balancedparens+ test-suite hw-balancedparens-test import: base, config- , QuickCheck+ , hedgehog , hspec , hw-bits+ , hw-hspec-hedgehog , hw-prim , hw-rankselect-base+ , transformers , vector type: exitcode-stdio-1.0 main-is: Spec.hs other-modules:- HaskellWorks.Data.BalancedParens.Internal.BroadwordSpec- HaskellWorks.Data.BalancedParens.RangeMinMax2Spec- HaskellWorks.Data.BalancedParens.RangeMinMaxSpec- HaskellWorks.Data.BalancedParens.SimpleSpec- Paths_hw_balancedparens+ HaskellWorks.Data.BalancedParens.Internal.BroadwordSpec+ HaskellWorks.Data.BalancedParens.Internal.ParensSeqSpec+ HaskellWorks.Data.BalancedParens.RangeMinMax2Spec+ HaskellWorks.Data.BalancedParens.RangeMinMaxSpec+ HaskellWorks.Data.BalancedParens.SimpleSpec+ Paths_hw_balancedparens+ build-depends: hw-balancedparens+ , hw-balancedparens-gen hs-source-dirs: test ghc-options: -threaded -rtsopts -with-rtsopts=-N- build-depends: hw-balancedparens autogen-modules: Paths_hw_balancedparens build-tool-depends: hspec-discover:hspec-discover benchmark bench import: base, config , criterion+ , hedgehog , hw-bits , hw-prim , vector@@ -99,3 +128,4 @@ autogen-modules: Paths_hw_balancedparens hs-source-dirs: bench build-depends: hw-balancedparens+ , hw-balancedparens-gen
+ src/HaskellWorks/Data/BalancedParens/Internal/List.hs view
@@ -0,0 +1,24 @@+module HaskellWorks.Data.BalancedParens.Internal.List+ ( chunkBy+ , toBools+ , toBalancedParensString+ ) where++import Data.Word++import qualified HaskellWorks.Data.BalancedParens.Internal.Word as W++chunkBy :: Int -> [a] -> [[a]]+chunkBy n bs = case (take n bs, drop n bs) of+ (as, zs) -> if null zs then [as] else as:chunkBy n zs++toBoolsDiff :: [Word64] -> [Bool] -> [Bool]+toBoolsDiff = foldr ((.) . W.toBoolsDiff) id++toBools :: [Word64] -> [Bool]+toBools ws = toBoolsDiff ws []++toBalancedParensString :: [Bool] -> String+toBalancedParensString (True:bs) = '(':toBalancedParensString bs+toBalancedParensString (False:bs) = ')':toBalancedParensString bs+toBalancedParensString [] = ""
+ src/HaskellWorks/Data/BalancedParens/Internal/ParensSeq.hs view
@@ -0,0 +1,139 @@+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module HaskellWorks.Data.BalancedParens.Internal.ParensSeq+ ( ParensSeq(..)+ , mempty+ , size+ , fromWord64s+ , fromPartialWord64s+ , toPartialWord64s+ , fromBools+ , toBools+ , splitAt+ , take+ , drop+ , firstChild+ , nextSibling+ , (<|), (><), (|>)+ ) where++import Data.Coerce+import Data.Foldable+import Data.Monoid+import Data.Word+import HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Internal (Elem (Elem), ParensSeq (ParensSeq), ParensSeqFt)+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.FingerTree (ViewL (..), ViewR (..), (<|), (><), (|>))+import HaskellWorks.Data.Positioning+import Prelude hiding (drop, max, min, splitAt, take)++import qualified Data.List as L+import qualified HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Internal as T+import qualified HaskellWorks.Data.BalancedParens.Internal.Word as W+import qualified HaskellWorks.Data.FingerTree as FT++empty :: ParensSeq+empty = ParensSeq FT.empty++size :: ParensSeq -> Count+size (ParensSeq parens) = T.size (FT.measure parens :: T.Measure)++-- TODO Needs optimisation+fromWord64s :: Traversable f => f Word64 -> ParensSeq+fromWord64s = foldl go empty+ where go :: ParensSeq -> Word64 -> ParensSeq+ go ps w = ParensSeq (T.parens ps |> Elem w 64)++-- TODO Needs optimisation+fromPartialWord64s :: Traversable f => f (Word64, Count) -> ParensSeq+fromPartialWord64s = foldl go empty+ where go :: ParensSeq -> (Word64, Count) -> ParensSeq+ go ps (w, n) = ParensSeq (T.parens ps |> Elem w n)++toPartialWord64s :: ParensSeq -> [(Word64, Count)]+toPartialWord64s = L.unfoldr go . coerce+ where go :: ParensSeqFt -> Maybe ((Word64, Count), ParensSeqFt)+ go ft = case FT.viewl ft of+ T.Elem w n :< rt -> Just ((w, coerce n), rt)+ FT.EmptyL -> Nothing++fromBools :: [Bool] -> ParensSeq+fromBools = go empty+ where go :: ParensSeq -> [Bool] -> ParensSeq+ go (ParensSeq ps) (b:bs) = case FT.viewr ps of+ FT.EmptyR -> go (ParensSeq (FT.singleton (Elem b' 1))) bs+ lt :> Elem w n ->+ let newPs = if n >= 64+ then ps |> Elem b' 1+ else lt |> Elem (w .|. (b' .<. fromIntegral n)) (n + 1)+ in go (ParensSeq newPs) bs+ where b' = if b then 1 else 0 :: Word64+ go ps [] = ps++toBools :: ParensSeq -> [Bool]+toBools ps = toBoolsDiff ps []++toBoolsDiff :: ParensSeq -> [Bool] -> [Bool]+toBoolsDiff ps = mconcat (fmap go (toPartialWord64s ps))+ where go :: (Word64, Count) -> [Bool] -> [Bool]+ go (w, n) = W.partialToBoolsDiff (fromIntegral n) w++drop :: Count -> ParensSeq -> ParensSeq+drop n ps = snd (splitAt n ps)++take :: Count -> ParensSeq -> ParensSeq+take n ps = fst (splitAt n ps)++splitAt :: Count -> ParensSeq -> (ParensSeq, ParensSeq)+splitAt n (ParensSeq parens) = case FT.split (T.atSizeBelowZero n) parens of+ (lt, rt) -> let+ n' = n - T.size (FT.measure lt :: T.Measure)+ u = 64 - n'+ in case FT.viewl rt of+ T.Elem w nw :< rrt -> if n' >= nw+ then (ParensSeq lt , ParensSeq rrt )+ else (ParensSeq (lt |> T.Elem ((w .<. u) .>. u) n'), ParensSeq (T.Elem (w .>. n') (nw - n') <| rrt))+ FT.EmptyL -> (ParensSeq lt, ParensSeq FT.empty)++firstChild :: ParensSeq -> Count -> Maybe Count+firstChild ps n = case FT.viewl ft of+ T.Elem w nw :< rt -> if nw >= 2+ then case w .&. 3 of+ 3 -> Just (n + 1)+ _ -> Nothing+ else if nw >= 1+ then case w .&. 1 of+ 1 -> case FT.viewl rt of+ T.Elem w' nw' :< _ -> if nw' >= 1+ then case w' .&. 1 of+ 1 -> Just (n + 1)+ _ -> Nothing+ else Nothing+ FT.EmptyL -> Nothing+ _ -> Nothing+ else Nothing+ FT.EmptyL -> Nothing+ where ParensSeq ft = drop (n - 1) ps++nextSibling :: ParensSeq -> Count -> Maybe Count+nextSibling (ParensSeq ps) n = do+ let (lt0, rt0) = T.ftSplit (T.atSizeBelowZero (n - 1)) ps+ _ <- case FT.viewl rt0 of+ T.Elem w nw :< _ -> if nw >= 1 && w .&. 1 == 1 then Just () else Nothing+ FT.EmptyL -> Nothing+ let (lt1, rt1) = T.ftSplit (T.atSizeBelowZero 1) rt0+ let (lt2, rt2) = T.ftSplit T.atMinZero rt1+ case FT.viewl rt2 of+ T.Elem w nw :< _ -> if nw >= 1 && w .&. 1 == 0 then Just () else Nothing+ FT.EmptyL -> Nothing+ let (lt3, rt3) = T.ftSplit (T.atSizeBelowZero 1) rt2+ case FT.viewl rt3 of+ T.Elem w nw :< _ -> if nw >= 1 && w .&. 1 == 1 then Just () else Nothing+ FT.EmptyL -> Nothing+ return $ 1+ + T.size (FT.measure lt0 :: T.Measure)+ + T.size (FT.measure lt1 :: T.Measure)+ + T.size (FT.measure lt2 :: T.Measure)+ + T.size (FT.measure lt3 :: T.Measure)
+ src/HaskellWorks/Data/BalancedParens/Internal/ParensSeq/Internal.hs view
@@ -0,0 +1,127 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeFamilies #-}++module HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Internal+ ( Elem(..)+ , Measure(..)+ , ParensSeq(..)+ , ParensSeqFt+ , (|>#)+ , (#<|)+ , ftSplit+ , atSizeBelowZero+ , atMinZero+ ) where++import Control.DeepSeq+import Data.Int+import Data.Monoid (Monoid)+import Data.Semigroup (Semigroup (..))+import Data.Word+import GHC.Generics+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Excess.MinExcess+import HaskellWorks.Data.Excess.PartialMinExcess1+import HaskellWorks.Data.FingerTree (ViewL (..), ViewR (..), (<|), (><), (|>))+import HaskellWorks.Data.Positioning+import Prelude hiding (max, min)++import qualified HaskellWorks.Data.Cons as HW+import qualified HaskellWorks.Data.Container as HW+import qualified HaskellWorks.Data.FingerTree as FT+import qualified HaskellWorks.Data.Snoc as HW+import qualified Prelude as P++data Elem = Elem+ { bps :: {-# UNPACK #-} !Word64+ , size :: {-# UNPACK #-} !Count+ } deriving (Eq, Show, Generic)++instance NFData Elem++data Measure = Measure+ { size :: {-# UNPACK #-} !Count+ , min :: {-# UNPACK #-} !Int+ , excess :: {-# UNPACK #-} !Int+ } deriving (Eq, Ord, Show, Generic)++instance NFData Measure++type ParensSeqFt = FT.FingerTree Measure Elem++newtype ParensSeq = ParensSeq+ { parens :: ParensSeqFt+ } deriving (Show, NFData, Generic)++instance Semigroup Measure where+ Measure aSize aMin aExcess <> Measure bSize bMin bExcess = Measure+ { size = aSize + bSize+ , min = P.min aMin (bMin + aExcess)+ , excess = aExcess + bExcess+ }++instance Monoid Measure where+ mempty = Measure 0 0 0++instance FT.Measured Measure Elem where+ measure (Elem w size) = Measure { min, excess, size }+ where MinExcess min excess = partialMinExcess1 (fromIntegral size) w++instance HW.Container ParensSeq where+ type Elem ParensSeq = Bool++instance HW.Cons ParensSeq where+ cons b (ParensSeq ft) = ParensSeq $ case FT.viewl ft of+ Elem w nw :< rt -> if nw >= 0 && nw < 64+ then Elem ((w .<. 1) .|. bw) (nw + 1) <| rt+ else Elem bw 1 <| ft+ FT.EmptyL -> FT.singleton (Elem bw 1)+ where bw = if b then 1 else 0++instance HW.Snoc ParensSeq where+ snoc (ParensSeq ft) b = ParensSeq $ case FT.viewr ft of+ lt :> Elem w nw -> if nw >= 0 && nw < 64+ then Elem (w .|. (bw .<. nw)) (nw + 1) <| lt+ else Elem bw 1 <| lt+ FT.EmptyR -> FT.singleton (Elem bw 1)+ where bw = if b then 1 else 0++instance Semigroup ParensSeq where+ ParensSeq tl <> ParensSeq tr = ParensSeq $ case FT.viewr tl of+ tll :> Elem wl nwl -> case FT.viewl tr of+ Elem wr nwr :< trr -> let nw = nwl + nwr in if nw <= 64+ then (tll |> Elem (wl .|. (wr .<. nwl)) nw) >< trr+ else tl >< tr+ FT.EmptyL -> tr+ FT.EmptyR -> FT.empty++(|>#) :: ParensSeqFt -> Elem -> ParensSeqFt+(|>#) ft e@(Elem _ wn) = if wn > 0 then ft |> e else ft++(#<|) :: Elem ->ParensSeqFt -> ParensSeqFt+(#<|) e@(Elem _ wn) ft = if wn > 0 then e <| ft else ft++ftSplit :: (Measure -> Bool) -> ParensSeqFt -> (ParensSeqFt, ParensSeqFt)+ftSplit p ft = case FT.viewl rt of+ Elem w nw :< rrt -> let c = go w nw nw in (lt |># Elem w c, Elem (w .>. c) (nw - c) #<| rrt)+ FT.EmptyL -> (ft, FT.empty)+ where (lt, rt) = FT.split p ft+ ltm = FT.measure lt+ go :: Word64 -> Count -> Count -> Count+ go w c nw = if c > 0+ then if p (ltm <> FT.measure (Elem (w .<. (64 - c) .>. (64 - c)) c))+ then go w (c - 1) nw+ else c+ else 0++atSizeBelowZero :: Count -> Measure -> Bool+atSizeBelowZero n m = n < size (m :: Measure)++atMinZero :: Measure -> Bool+atMinZero m = min (m :: Measure) <= 0
+ src/HaskellWorks/Data/BalancedParens/Internal/ParensSeq/Types.hs view
@@ -0,0 +1,5 @@+module HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Types+ ( ParensSeq+ ) where++import HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Internal (ParensSeq)
+ src/HaskellWorks/Data/BalancedParens/Internal/RoseTree.hs view
@@ -0,0 +1,23 @@+module HaskellWorks.Data.BalancedParens.Internal.RoseTree+ ( RoseTree(..)+ , toBools+ , toBools'+ , size+ , depth+ ) where++newtype RoseTree = RoseTree+ { children :: [RoseTree]+ } deriving (Eq, Show)++toBools :: RoseTree -> [Bool]+toBools rt = toBools' rt []++toBools' :: RoseTree -> [Bool] -> [Bool]+toBools' (RoseTree cs) = (True:) . foldr (.) id (fmap toBools' cs) . (False:)++size :: RoseTree -> Int+size (RoseTree cs) = 1 + sum (fmap size cs)++depth :: RoseTree -> Int+depth (RoseTree cs) = 1 + maximum (fmap depth cs)
+ src/HaskellWorks/Data/BalancedParens/Internal/Word.hs view
@@ -0,0 +1,30 @@+module HaskellWorks.Data.BalancedParens.Internal.Word+ ( toBools+ , toBoolsDiff+ , partialToBoolsDiff+ ) where++import Data.Word+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Positioning++toBools :: Word64 -> [Bool]+toBools w = toBoolsDiff w []++partialToBoolsDiff :: Count -> Word64 -> [Bool] -> [Bool]+partialToBoolsDiff n w | n > 0 = partialToBoolsDiff (n - 1) w . ((w .?. fromIntegral (n - 1)):)+partialToBoolsDiff 0 _ = id+partialToBoolsDiff _ _ = error "Invalid size"++toBoolsDiff :: Word64 -> [Bool] -> [Bool]+toBoolsDiff w =+ go 0x00 . go 0x01 . go 0x02 . go 0x03 . go 0x04 . go 0x05 . go 0x06 . go 0x07 .+ go 0x08 . go 0x09 . go 0x0a . go 0x0b . go 0x0c . go 0x0d . go 0x0e . go 0x0f .+ go 0x10 . go 0x11 . go 0x12 . go 0x13 . go 0x14 . go 0x15 . go 0x16 . go 0x17 .+ go 0x18 . go 0x19 . go 0x1a . go 0x1b . go 0x1c . go 0x1d . go 0x1e . go 0x1f .+ go 0x20 . go 0x21 . go 0x22 . go 0x23 . go 0x24 . go 0x25 . go 0x26 . go 0x27 .+ go 0x28 . go 0x29 . go 0x2a . go 0x2b . go 0x2c . go 0x2d . go 0x2e . go 0x2f .+ go 0x30 . go 0x31 . go 0x32 . go 0x33 . go 0x34 . go 0x35 . go 0x36 . go 0x37 .+ go 0x38 . go 0x39 . go 0x3a . go 0x3b . go 0x3c . go 0x3d . go 0x3e . go 0x3f+ where go :: Position -> [Bool] -> [Bool]+ go p = ((w .?. p):)
src/HaskellWorks/Data/BalancedParens/RangeMinMax.hs view
@@ -1,10 +1,11 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE InstanceSigs #-}-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE TypeFamilies #-} module HaskellWorks.Data.BalancedParens.RangeMinMax ( RangeMinMax(..)@@ -27,8 +28,8 @@ import HaskellWorks.Data.Bits.AllExcess.AllExcess1 import HaskellWorks.Data.Bits.BitLength import HaskellWorks.Data.Bits.BitWise-import HaskellWorks.Data.Excess.MinMaxExcess1-import HaskellWorks.Data.Excess.Triplet+import HaskellWorks.Data.Excess.MinExcess+import HaskellWorks.Data.Excess.MinExcess1 import HaskellWorks.Data.Positioning import HaskellWorks.Data.RankSelect.Base.Rank0 import HaskellWorks.Data.RankSelect.Base.Rank1@@ -40,13 +41,10 @@ data RangeMinMax a = RangeMinMax { rangeMinMaxBP :: !a , rangeMinMaxL0Min :: !(DVS.Vector Int8)- , rangeMinMaxL0Max :: !(DVS.Vector Int8) , rangeMinMaxL0Excess :: !(DVS.Vector Int8) , rangeMinMaxL1Min :: !(DVS.Vector Int16)- , rangeMinMaxL1Max :: !(DVS.Vector Int16) , rangeMinMaxL1Excess :: !(DVS.Vector Int16) , rangeMinMaxL2Min :: !(DVS.Vector Int16)- , rangeMinMaxL2Max :: !(DVS.Vector Int16) , rangeMinMaxL2Excess :: !(DVS.Vector Int16) } deriving (NFData, Generic) @@ -78,13 +76,10 @@ mkRangeMinMax bp = RangeMinMax { rangeMinMaxBP = bp , rangeMinMaxL0Min = rmmL0Min- , rangeMinMaxL0Max = rmmL0Max , rangeMinMaxL0Excess = dvsReword rmmL0Excess , rangeMinMaxL1Min = rmmL1Min- , rangeMinMaxL1Max = rmmL1Max , rangeMinMaxL1Excess = dvsReword rmmL1Excess , rangeMinMaxL2Min = rmmL2Min- , rangeMinMaxL2Max = rmmL2Max , rangeMinMaxL2Excess = rmmL2Excess } where bpv = asVector64 bp@@ -92,19 +87,16 @@ lenL0 = lenBP lenL1 = (DVS.length rmmL0Min `div` pageSizeL1) + 1 :: Int lenL2 = (DVS.length rmmL0Min `div` pageSizeL2) + 1 :: Int- allMinMaxL0 = dvsConstructNI lenL0 (\i -> if i == lenBP then Triplet (-64) (-64) 0 else minMaxExcess1 (bpv !!! fromIntegral i))- allMinMaxL1 = dvsConstructNI lenL1 (\i -> minMaxExcess1 (dropTake (i * pageSizeL1) pageSizeL1 bpv))- allMinMaxL2 = dvsConstructNI lenL2 (\i -> minMaxExcess1 (dropTake (i * pageSizeL2) pageSizeL2 bpv))+ allMinMaxL0 = dvsConstructNI lenL0 (\i -> if i == lenBP then MinExcess (-64) (-64) else minExcess1 (bpv !!! fromIntegral i))+ allMinMaxL1 = dvsConstructNI lenL1 (\i -> minExcess1 (dropTake (i * pageSizeL1) pageSizeL1 bpv))+ allMinMaxL2 = dvsConstructNI lenL2 (\i -> minExcess1 (dropTake (i * pageSizeL2) pageSizeL2 bpv)) -- Note: (0xffffffffffffffc0 :: Int64) = -64 rmmL0Excess = dvsConstructNI lenL0 (\i -> fromIntegral (allExcess1 (pageFill i pageSizeL0 0xffffffffffffffc0 bpv))) :: DVS.Vector Int16 rmmL1Excess = dvsConstructNI lenL1 (\i -> fromIntegral (allExcess1 (pageFill i pageSizeL1 0xffffffffffffffc0 bpv))) :: DVS.Vector Int16 rmmL2Excess = dvsConstructNI lenL2 (\i -> fromIntegral (allExcess1 (pageFill i pageSizeL2 0xffffffffffffffc0 bpv))) :: DVS.Vector Int16- rmmL0Min = dvsConstructNI lenL0 (\i -> let Triplet minE _ _ = allMinMaxL0 DVS.! i in fromIntegral minE)- rmmL1Min = dvsConstructNI lenL1 (\i -> let Triplet minE _ _ = allMinMaxL1 DVS.! i in fromIntegral minE)- rmmL2Min = dvsConstructNI lenL2 (\i -> let Triplet minE _ _ = allMinMaxL2 DVS.! i in fromIntegral minE)- rmmL0Max = dvsConstructNI lenL0 (\i -> let Triplet _ _ maxE = allMinMaxL0 DVS.! i in fromIntegral maxE)- rmmL1Max = dvsConstructNI lenL1 (\i -> let Triplet _ _ maxE = allMinMaxL1 DVS.! i in fromIntegral maxE)- rmmL2Max = dvsConstructNI lenL2 (\i -> let Triplet _ _ maxE = allMinMaxL2 DVS.! i in fromIntegral maxE)+ rmmL0Min = dvsConstructNI lenL0 (\i -> let MinExcess minE _ = allMinMaxL0 DVS.! i in fromIntegral minE)+ rmmL1Min = dvsConstructNI lenL1 (\i -> let MinExcess minE _ = allMinMaxL1 DVS.! i in fromIntegral minE)+ rmmL2Min = dvsConstructNI lenL2 (\i -> let MinExcess minE _ = allMinMaxL2 DVS.! i in fromIntegral minE) dropTake :: DVS.Storable a => Int -> Int -> DVS.Vector a -> DVS.Vector a dropTake n o = DVS.take o . DVS.drop n
src/HaskellWorks/Data/BalancedParens/RangeMinMax2.hs view
@@ -9,8 +9,6 @@ module HaskellWorks.Data.BalancedParens.RangeMinMax2 ( RangeMinMax2(..) , mkRangeMinMax2- , genMin- , genMax ) where import Control.DeepSeq@@ -29,8 +27,8 @@ import HaskellWorks.Data.Bits.AllExcess.AllExcess1 import HaskellWorks.Data.Bits.BitLength import HaskellWorks.Data.Bits.BitWise-import HaskellWorks.Data.Excess.MinMaxExcess1-import HaskellWorks.Data.Excess.Triplet+import HaskellWorks.Data.Excess.MinExcess+import HaskellWorks.Data.Excess.MinExcess1 import HaskellWorks.Data.Positioning import HaskellWorks.Data.RankSelect.Base.Rank0 import HaskellWorks.Data.RankSelect.Base.Rank1@@ -43,19 +41,14 @@ data RangeMinMax2 a = RangeMinMax2 { rangeMinMax2BP :: !a , rangeMinMax2L0Min :: !(DVS.Vector Int8)- , rangeMinMax2L0Max :: !(DVS.Vector Int8) , rangeMinMax2L0Excess :: !(DVS.Vector Int8) , rangeMinMax2L1Min :: !(DVS.Vector Int16)- , rangeMinMax2L1Max :: !(DVS.Vector Int16) , rangeMinMax2L1Excess :: !(DVS.Vector Int16) , rangeMinMax2L2Min :: !(DVS.Vector Int16)- , rangeMinMax2L2Max :: !(DVS.Vector Int16) , rangeMinMax2L2Excess :: !(DVS.Vector Int16) , rangeMinMax2L3Min :: !(DVS.Vector Int16)- , rangeMinMax2L3Max :: !(DVS.Vector Int16) , rangeMinMax2L3Excess :: !(DVS.Vector Int16) , rangeMinMax2L4Min :: !(DVS.Vector Int16)- , rangeMinMax2L4Max :: !(DVS.Vector Int16) , rangeMinMax2L4Excess :: !(DVS.Vector Int16) } deriving (NFData, Generic) @@ -103,19 +96,14 @@ mkRangeMinMax2 bp = RangeMinMax2 { rangeMinMax2BP = bp , rangeMinMax2L0Min = dvsReword rmmL0Min- , rangeMinMax2L0Max = dvsReword rmmL0Max , rangeMinMax2L0Excess = dvsReword rmmL0Excess , rangeMinMax2L1Min = rmmL1Min- , rangeMinMax2L1Max = rmmL1Max , rangeMinMax2L1Excess = rmmL1Excess , rangeMinMax2L2Min = rmmL2Min- , rangeMinMax2L2Max = rmmL2Max , rangeMinMax2L2Excess = rmmL2Excess , rangeMinMax2L3Min = rmmL3Min- , rangeMinMax2L3Max = rmmL3Max , rangeMinMax2L3Excess = rmmL3Excess , rangeMinMax2L4Min = rmmL4Min- , rangeMinMax2L4Max = rmmL4Max , rangeMinMax2L4Excess = rmmL4Excess } where bpv = asVector64 bp@@ -125,32 +113,22 @@ lenL2 = (DVS.length rmmL0Min `div` pageSizeL2) + 1 :: Int lenL3 = (DVS.length rmmL0Min `div` pageSizeL3) + 1 :: Int lenL4 = (DVS.length rmmL0Min `div` pageSizeL4) + 1 :: Int- allMinMaxL0 = dvConstructNI lenL0 (\i -> if i == lenBP then Triplet (-64) (-64) 0 else minMaxExcess1 (bpv !!! fromIntegral i))+ allMinMaxL0 = dvConstructNI lenL0 (\i -> if i == lenBP then MinExcess (-64) (-64) else minExcess1 (bpv !!! fromIntegral i)) -- Note: (0xffffffffffffffc0 :: Int64) = -64 rmmL0Excess = dvsConstructNI lenL0 (\i -> fromIntegral (allExcess1 (pageFill i pageSizeL0 0xffffffffffffffc0 bpv))) :: DVS.Vector Int16 rmmL1Excess = dvsConstructNI lenL1 (\i -> fromIntegral (allExcess1 (pageFill i pageSizeL1 0xffffffffffffffc0 bpv))) :: DVS.Vector Int16 rmmL2Excess = dvsConstructNI lenL2 (\i -> fromIntegral (allExcess1 (pageFill i pageSizeL2 0xffffffffffffffc0 bpv))) :: DVS.Vector Int16 rmmL3Excess = dvsConstructNI lenL3 (\i -> fromIntegral (allExcess1 (pageFill i pageSizeL3 0xffffffffffffffc0 bpv))) :: DVS.Vector Int16 rmmL4Excess = dvsConstructNI lenL4 (\i -> fromIntegral (allExcess1 (pageFill i pageSizeL4 0xffffffffffffffc0 bpv))) :: DVS.Vector Int16- rmmL0Min = dvsConstructNI lenL0 (\i -> let Triplet minE _ _ = allMinMaxL0 DV.! i in fromIntegral minE) :: DVS.Vector Int16+ rmmL0Min = dvsConstructNI lenL0 (\i -> let MinExcess minE _ = allMinMaxL0 DV.! i in fromIntegral minE) :: DVS.Vector Int16 rmmL1Min = dvsConstructNI lenL1 (\i -> genMin 0 (pageFill i factorL1 0 rmmL0Min) (pageFill i factorL1 0 rmmL0Excess)) rmmL2Min = dvsConstructNI lenL2 (\i -> genMin 0 (pageFill i factorL2 0 rmmL1Min) (pageFill i factorL2 0 rmmL1Excess)) rmmL3Min = dvsConstructNI lenL3 (\i -> genMin 0 (pageFill i factorL3 0 rmmL2Min) (pageFill i factorL3 0 rmmL2Excess)) rmmL4Min = dvsConstructNI lenL4 (\i -> genMin 0 (pageFill i factorL4 0 rmmL3Min) (pageFill i factorL4 0 rmmL3Excess))- rmmL0Max = dvsConstructNI lenL0 (\i -> let Triplet _ _ maxE = allMinMaxL0 DV.! i in fromIntegral maxE) :: DVS.Vector Int16- rmmL1Max = dvsConstructNI lenL1 (\i -> genMax 0 (pageFill i factorL1 0 rmmL0Max) (pageFill i factorL1 0 rmmL0Excess))- rmmL2Max = dvsConstructNI lenL2 (\i -> genMax 0 (pageFill i factorL2 0 rmmL1Max) (pageFill i factorL2 0 rmmL1Excess))- rmmL3Max = dvsConstructNI lenL3 (\i -> genMax 0 (pageFill i factorL3 0 rmmL2Max) (pageFill i factorL3 0 rmmL2Excess))- rmmL4Max = dvsConstructNI lenL4 (\i -> genMax 0 (pageFill i factorL4 0 rmmL3Max) (pageFill i factorL4 0 rmmL3Excess)) genMin :: (Integral a, DVS.Storable a) => a -> DVS.Vector a -> DVS.Vector a -> a genMin mL mins excesses = if not (DVS.null mins) || not (DVS.null excesses) then genMin (dvsLastOrZero mins `min` (mL + dvsLastOrZero excesses)) (DVS.init mins) (DVS.init excesses)- else mL--genMax :: (Integral a, DVS.Storable a) => a -> DVS.Vector a -> DVS.Vector a -> a-genMax mL maxs excesses = if not (DVS.null maxs) || not (DVS.null excesses)- then genMax (dvsLastOrZero maxs `max` (mL + dvsLastOrZero excesses)) (DVS.init maxs) (DVS.init excesses) else mL pageFill :: DVS.Storable a => Int -> Int -> a -> DVS.Vector a -> DVS.Vector a
test/HaskellWorks/Data/BalancedParens/Internal/BroadwordSpec.hs view
@@ -4,19 +4,20 @@ module HaskellWorks.Data.BalancedParens.Internal.BroadwordSpec where --- import Data.Maybe-import qualified Data.Vector.Storable as DVS-import Data.Word-import HaskellWorks.Data.BalancedParens.FindClose--- import HaskellWorks.Data.Bits.BitLength--- import HaskellWorks.Data.Bits.BitRead-import HaskellWorks.Data.Bits.BitShow-import HaskellWorks.Data.Bits.Broadword-import HaskellWorks.Data.Bits.FromBitTextByteString-import HaskellWorks.Data.Positioning-import Test.Hspec-import Test.QuickCheck+import Data.Word+import HaskellWorks.Data.BalancedParens.FindClose+import HaskellWorks.Data.Bits.BitShow+import HaskellWorks.Data.Bits.Broadword+import HaskellWorks.Data.Bits.FromBitTextByteString+import HaskellWorks.Hspec.Hedgehog+import Hedgehog+import Test.Hspec +import qualified Data.Vector.Storable as DVS+import qualified HaskellWorks.Data.BalancedParens.Gen as G+import qualified Hedgehog.Gen as G+import qualified Hedgehog.Range as R+ {-# ANN module ("HLint: Ignore Redundant do" :: String) #-} {-# ANN module ("HLint: Ignore Reduce duplication" :: String) #-} @@ -131,7 +132,7 @@ -- it "when calling nextSibling from valid locations" $ do -- forAll (vectorSizedBetween 1 64) $ \(ShowVector v) -> do -- [nextSibling v p | p <- [1..bitLength v]] `shouldBe` [nextSibling v p | p <- [1..bitLength v]]- it "Broadword findClose should behave the same as Naive findClose" $ do- property $ \(w :: Word64) ->- forAll (choose (1, 64 :: Count)) $ \p ->- findClose w p == findClose (Broadword w) p+ it "Broadword findClose should behave the same as Naive findClose" $ requireProperty $ do+ w <- forAll $ G.word64 R.constantBounded+ p <- forAll $ G.count (R.linear 1 64)+ findClose w p === findClose (Broadword w) p
+ test/HaskellWorks/Data/BalancedParens/Internal/ParensSeqSpec.hs view
@@ -0,0 +1,128 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.BalancedParens.Internal.ParensSeqSpec where++import Data.Semigroup ((<>))+import HaskellWorks.Data.BalancedParens.Internal.ParensSeq ((<|), (><), (|>))+import HaskellWorks.Data.RankSelect.Base.Select1+import HaskellWorks.Hspec.Hedgehog+import Hedgehog+import Test.Hspec++import qualified HaskellWorks.Data.BalancedParens.BalancedParens as BP+import qualified HaskellWorks.Data.BalancedParens.Gen as G+import qualified HaskellWorks.Data.BalancedParens.Internal.List as L+import qualified HaskellWorks.Data.BalancedParens.Internal.ParensSeq as PS+import qualified Hedgehog.Gen as G+import qualified Hedgehog.Range as R++{-# ANN module ("HLint: Ignore Redundant do" :: String) #-}+{-# ANN module ("HLint: Ignore Reduce duplication" :: String) #-}++spec :: Spec+spec = describe "HaskellWorks.Data.BalancedParens.Internal.ParensSeqSpec" $ do+ it "fromWord64s should produce Rmm of the right size" $ requireProperty $ do+ ws <- forAll $ G.list (R.linear 0 10) (G.word64 R.constantBounded)++ PS.size (PS.fromWord64s ws) === fromIntegral (length ws * 64)+ it "fromWord64s should produce Rmm with the right data" $ requireProperty $ do+ wns <- forAll $ G.list (R.linear 0 10) $ (,)+ <$> G.word64 R.constantBounded+ <*> G.count (R.linear 1 64)++ PS.size (PS.fromPartialWord64s wns) === sum (snd <$> wns)+ it "fromWord64s should produce Rmm with the right data" $ requireProperty $ do+ ws <- forAll $ G.list (R.linear 0 10) (G.word64 R.constantBounded)++ PS.toPartialWord64s (PS.fromWord64s ws) === zip ws (repeat 64)+ it "fromPartialWord64s should produce Rmm with the right data" $ requireProperty $ do+ wns <- forAll $ G.list (R.linear 0 10) $ (,)+ <$> G.word64 R.constantBounded+ <*> G.count (R.linear 1 64)++ PS.toPartialWord64s (PS.fromPartialWord64s wns) === wns+ it "fromBools should produce Rmm with the right data" $ requireProperty $ do+ ws <- forAll $ G.list (R.linear 0 10) (G.word64 R.constantBounded)++ PS.toPartialWord64s (PS.fromBools (L.toBools ws)) === zip ws (repeat 64)+ it "drop should drop the right amount of data" $ requireProperty $ do+ ws <- forAll $ G.list (R.linear 0 10) (G.word64 R.constantBounded)+ let ps = PS.fromWord64s ws+ n <- forAll $ G.count (R.linear 0 (PS.size ps))++ PS.size (PS.drop n ps) === PS.size ps - n+ it "take should take the right amount of data" $ requireProperty $ do+ ws <- forAll $ G.list (R.linear 0 10) (G.word64 R.constantBounded)+ let ps = PS.fromWord64s ws+ n <- forAll $ G.count (R.linear 0 (PS.size ps))++ PS.size (PS.take n ps) === n+ it "splitAt should split at the correct point" $ requireProperty $ do+ ws <- forAll $ G.list (R.linear 0 10) (G.word64 R.constantBounded)+ let ps = PS.fromWord64s ws+ n <- forAll $ G.count (R.linear 0 (PS.size ps))++ let (lt, rt) = PS.splitAt n ps+ PS.size lt === n+ PS.size rt === PS.size ps - n+ PS.toBools lt >< PS.toBools rt === PS.toBools ps+ it "firstChild should choose the first child" $ requireProperty $ do+ ws <- forAll $ G.list (R.linear 0 10) (G.word64 R.constantBounded)+ let ps = PS.fromWord64s ws+ n <- forAll $ G.count (R.linear 0 (PS.size ps))++ PS.size (PS.drop n ps) === PS.size ps - n+ it "rose tree should be generatable" $ requireProperty $ do+ bs <- forAll $ G.bpBools (R.linear 1 1000)++ PS.toBools (PS.fromBools bs) === bs+ it "firstChild should select first child" $ requireProperty $ do+ bs <- forAll $ G.bpBools (R.linear 1 1000)+ _ <- forAll $ pure (G.showBps bs)+ nodeCount <- forAll $ pure (fromIntegral (length bs `div` 2))+ ranked <- forAll $ G.count (R.linear 1 nodeCount)+ pos <- forAll $ pure $ select1 bs ranked+ ps <- forAll $ pure $ PS.fromBools bs++ PS.firstChild ps pos === BP.firstChild bs pos+ it "firstChild should select first child" $ requireTest $ do+ let bps = "((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((()))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))"+ let bs = fmap (\c -> if c == '(' then True else False) bps+ let ps = PS.fromBools bs++ PS.firstChild ps 64 === Just 65+ it "nextSibling should select next sibling" $ requireTest $ do+ bs <- forAll $ G.bpBools (R.linear 1 1000)+ nodeCount <- forAll $ pure (fromIntegral (length bs `div` 2))+ ranked <- forAll $ G.count (R.linear 1 nodeCount)+ pos <- forAll $ pure $ select1 bs ranked+ rmm <- forAll $ pure $ PS.fromBools bs++ PS.nextSibling rmm pos === BP.nextSibling bs pos+ it "nextSibling on ()()" $ requireTest $ do+ bs <- forAll $ pure [True , False , True , False]+ pos <- forAll $ pure 1+ rmm <- forAll $ pure $ PS.fromBools bs++ PS.nextSibling rmm pos === BP.nextSibling bs pos+ it "(><) should append" $ requireTest $ do+ bs1 <- forAll $ G.bpBools (R.linear 1 1000)+ bs2 <- forAll $ G.bpBools (R.linear 1 1000)+ ps1 <- forAll $ pure $ PS.fromBools bs1+ ps2 <- forAll $ pure $ PS.fromBools bs2++ PS.toBools (ps1 >< ps2) === PS.toBools ps1 >< PS.toBools ps2+ it "(<|) should cons" $ requireTest $ do+ b <- forAll $ G.bool+ bs <- forAll $ G.bpBools (R.linear 1 1000)+ ps <- forAll $ pure $ PS.fromBools bs++ PS.toBools (b <| ps) === b:PS.toBools ps+ it "(|>) should snoc" $ requireTest $ do+ b <- forAll $ G.bool+ bs <- forAll $ G.bpBools (R.linear 1 1000)+ ps <- forAll $ pure $ PS.fromBools bs++ PS.toBools (ps |> b) === PS.toBools ps <> [b]
test/HaskellWorks/Data/BalancedParens/RangeMinMax2Spec.hs view
@@ -5,17 +5,15 @@ module HaskellWorks.Data.BalancedParens.RangeMinMax2Spec where -import qualified Data.Vector.Storable as DVS-import Data.Word-import HaskellWorks.Data.BalancedParens-import HaskellWorks.Data.BalancedParens.RangeMinMax--- import HaskellWorks.Data.BalancedParens.RangeMinMax2--- import HaskellWorks.Data.Bits.BitLength-import HaskellWorks.Data.Bits.BitShow-import HaskellWorks.Data.Bits.FromBitTextByteString-import Test.Hspec-import Test.QuickCheck+import Data.Word+import HaskellWorks.Data.BalancedParens+import HaskellWorks.Data.BalancedParens.RangeMinMax+import HaskellWorks.Data.Bits.BitShow+import HaskellWorks.Data.Bits.FromBitTextByteString+import Test.Hspec +import qualified Data.Vector.Storable as DVS+ {-# ANN module ("HLint: Ignore Redundant do" :: String) #-} {-# ANN module ("HLint: Ignore Reduce duplication" :: String) #-} @@ -23,12 +21,6 @@ instance BitShow a => Show (ShowVector a) where show = bitShow--vectorSizedBetween :: Int -> Int -> Gen (ShowVector (DVS.Vector Word64))-vectorSizedBetween a b = do- n <- choose (a, b)- xs <- sequence [ arbitrary | _ <- [1 .. n] ]- return $ ShowVector (DVS.fromList xs) maxVectorSize :: Int maxVectorSize = 16384
test/HaskellWorks/Data/BalancedParens/RangeMinMaxSpec.hs view
@@ -5,16 +5,21 @@ module HaskellWorks.Data.BalancedParens.RangeMinMaxSpec where -import qualified Data.Vector.Storable as DVS-import Data.Word-import HaskellWorks.Data.BalancedParens-import HaskellWorks.Data.BalancedParens.RangeMinMax-import HaskellWorks.Data.Bits.BitLength-import HaskellWorks.Data.Bits.BitShow-import HaskellWorks.Data.Bits.FromBitTextByteString-import Test.Hspec-import Test.QuickCheck+import Data.Word+import HaskellWorks.Data.BalancedParens+import HaskellWorks.Data.BalancedParens.RangeMinMax+import HaskellWorks.Data.Bits.BitLength+import HaskellWorks.Data.Bits.BitShow+import HaskellWorks.Data.Bits.FromBitTextByteString+import HaskellWorks.Hspec.Hedgehog+import Hedgehog+import Test.Hspec +import qualified Data.Vector.Storable as DVS+import qualified HaskellWorks.Data.BalancedParens.Gen as G+import qualified Hedgehog.Gen as G+import qualified Hedgehog.Range as R+ {-# ANN module ("HLint: Ignore Redundant do" :: String) #-} {-# ANN module ("HLint: Ignore Reduce duplication" :: String) #-} @@ -23,43 +28,32 @@ instance BitShow a => Show (ShowVector a) where show = bitShow -vectorSizedBetween :: Int -> Int -> Gen (ShowVector (DVS.Vector Word64))-vectorSizedBetween a b = do- n <- choose (a, b)- xs <- sequence [ arbitrary | _ <- [1 .. n] ]- return $ ShowVector (DVS.fromList xs)- factor :: Int factor = 16384 {-# INLINE factor #-} spec :: Spec spec = describe "HaskellWorks.Data.BalancedParens.RangeMinMaxSpec" $ do- let defaultMaxSuccess = 5- it "For a simple bit string can find close" $ do+ it "For a simple bit string can find close" $ requireTest $ do let v = fromBitTextByteString "11101111 10100101 01111110 10110010 10111011 10111011 00011111 11011100" :: DVS.Vector Word64 let !rmm = mkRangeMinMax v- findClose rmm 61 `shouldBe` findClose v 61- it "findClose should return the same result" $ do- quickCheckWith stdArgs { maxSuccess = defaultMaxSuccess } $ do- forAll (vectorSizedBetween 1 4) $ \(ShowVector v) -> do- let !rmm = mkRangeMinMax v- let len = bitLength v- [findClose rmm i | i <- [1..len]] `shouldBe `[findClose v i | i <- [1..len]]- it "findClose should return the same result over all counts" $ do- quickCheckWith stdArgs { maxSuccess = defaultMaxSuccess } $ do- forAll (vectorSizedBetween 1 factor) $ \(ShowVector v) -> do- forAll (choose (1, bitLength v)) $ \p -> do- let !rmm = mkRangeMinMax v- findClose rmm p `shouldBe` findClose v p- it "nextSibling should return the same result" $ do- quickCheckWith stdArgs { maxSuccess = defaultMaxSuccess } $ do- forAll (vectorSizedBetween 1 factor) $ \(ShowVector v) -> do- let !rmm = mkRangeMinMax v- nextSibling rmm 0 `shouldBe` nextSibling v 0- it "nextSibling should return the same result over all counts" $ do- quickCheckWith stdArgs { maxSuccess = defaultMaxSuccess } $ do- forAll (vectorSizedBetween 1 factor) $ \(ShowVector v) -> do- forAll (choose (1, bitLength v)) $ \p -> do- let !rmm = mkRangeMinMax v- nextSibling rmm p `shouldBe` nextSibling v p+ findClose rmm 61 === findClose v 61+ it "findClose should return the same result" $ requireProperty $ do+ v <- forAll $ G.storableVector (R.linear 1 4) (G.word64 R.constantBounded)+ let !rmm = mkRangeMinMax v+ let len = bitLength v+ [findClose rmm i | i <- [1..len]] === [findClose v i | i <- [1..len]]+ it "findClose should return the same result over all counts" $ requireProperty $ do+ v <- forAll $ G.storableVector (R.linear 1 factor) (G.word64 R.constantBounded)+ p <- forAll $ G.count (R.linear 1 (bitLength v))+ let !rmm = mkRangeMinMax v+ findClose rmm p === findClose v p+ it "nextSibling should return the same result" $ requireProperty $ do+ v <- forAll $ G.storableVector (R.linear 1 factor) (G.word64 R.constantBounded)+ let !rmm = mkRangeMinMax v+ nextSibling rmm 0 === nextSibling v 0+ it "nextSibling should return the same result over all counts" $ requireProperty $ do+ v <- forAll $ G.storableVector (R.linear 1 factor) (G.word64 R.constantBounded)+ p <- forAll $ G.count (R.linear 1 (bitLength v))+ let !rmm = mkRangeMinMax v+ nextSibling rmm p === nextSibling v p
test/HaskellWorks/Data/BalancedParens/SimpleSpec.hs view
@@ -1,135 +1,128 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ScopedTypeVariables #-} module HaskellWorks.Data.BalancedParens.SimpleSpec where -import Data.Maybe-import qualified Data.Vector.Storable as DVS-import Data.Word-import HaskellWorks.Data.BalancedParens-import HaskellWorks.Data.Bits.BitLength-import HaskellWorks.Data.Bits.BitRead-import HaskellWorks.Data.Bits.BitShow-import Test.Hspec-import Test.QuickCheck+import Data.Maybe+import Data.Word+import HaskellWorks.Data.BalancedParens+import HaskellWorks.Data.Bits.BitLength+import HaskellWorks.Data.Bits.BitRead+import HaskellWorks.Hspec.Hedgehog+import Hedgehog+import Test.Hspec +import qualified Data.Vector.Storable as DVS+import qualified HaskellWorks.Data.BalancedParens.Gen as G+import qualified Hedgehog.Gen as G+import qualified Hedgehog.Range as R+ {-# ANN module ("HLint: Ignore Redundant do" :: String) #-} {-# ANN module ("HLint: Ignore Reduce duplication" :: String) #-} -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.BalancedParens.SimpleSpec" $ do describe "For (()(()())) 1101101000" $ do let bs = SimpleBalancedParens (91 :: Word64)- it "Test 1a" $ findClose bs 1 `shouldBe` Just 10- it "Test 1b" $ findClose bs 2 `shouldBe` Just 3- it "Test 1b" $ findClose bs 3 `shouldBe` Just 3- it "Test 1b" $ findClose bs 4 `shouldBe` Just 9- it "Test 1b" $ findClose bs 5 `shouldBe` Just 6- it "Test 1b" $ findClose bs 6 `shouldBe` Just 6- it "Test 1b" $ findClose bs 7 `shouldBe` Just 8- it "Test 1b" $ findClose bs 8 `shouldBe` Just 8- it "Test 1b" $ findClose bs 9 `shouldBe` Just 9- it "Test 1b" $ findClose bs 10 `shouldBe` Just 10- it "Test 2a" $ findOpen bs 10 `shouldBe` Just 1- it "Test 2b" $ findOpen bs 3 `shouldBe` Just 2- it "Test 3a" $ enclose bs 2 `shouldBe` Just 1- it "Test 3b" $ enclose bs 7 `shouldBe` Just 4+ it "Test 1a" $ requireTest $ findClose bs 1 === Just 10+ it "Test 1b" $ requireTest $ findClose bs 2 === Just 3+ it "Test 1b" $ requireTest $ findClose bs 3 === Just 3+ it "Test 1b" $ requireTest $ findClose bs 4 === Just 9+ it "Test 1b" $ requireTest $ findClose bs 5 === Just 6+ it "Test 1b" $ requireTest $ findClose bs 6 === Just 6+ it "Test 1b" $ requireTest $ findClose bs 7 === Just 8+ it "Test 1b" $ requireTest $ findClose bs 8 === Just 8+ it "Test 1b" $ requireTest $ findClose bs 9 === Just 9+ it "Test 1b" $ requireTest $ findClose bs 10 === Just 10+ it "Test 2a" $ requireTest $ findOpen bs 10 === Just 1+ it "Test 2b" $ requireTest $ findOpen bs 3 === Just 2+ it "Test 3a" $ requireTest $ enclose bs 2 === Just 1+ it "Test 3b" $ requireTest $ enclose bs 7 === Just 4 describe "For (()(()())) 1101101000" $ do let bs = SimpleBalancedParens (fromJust (bitRead "1101101000") :: [Bool])- it "Test 1a" $ findClose bs 1 `shouldBe` Just 10- it "Test 1b" $ findClose bs 2 `shouldBe` Just 3- it "Test 1b" $ findClose bs 3 `shouldBe` Just 3- it "Test 1b" $ findClose bs 4 `shouldBe` Just 9- it "Test 1b" $ findClose bs 5 `shouldBe` Just 6- it "Test 1b" $ findClose bs 6 `shouldBe` Just 6- it "Test 1b" $ findClose bs 7 `shouldBe` Just 8- it "Test 1b" $ findClose bs 8 `shouldBe` Just 8- it "Test 1b" $ findClose bs 9 `shouldBe` Just 9- it "Test 1b" $ findClose bs 10 `shouldBe` Just 10- it "Test 2a" $ findOpen bs 10 `shouldBe` Just 1- it "Test 2b" $ findOpen bs 3 `shouldBe` Just 2- it "Test 3a" $ enclose bs 2 `shouldBe` Just 1- it "Test 3b" $ enclose bs 7 `shouldBe` Just 4- it "firstChild 1" $ firstChild bs 1 `shouldBe` Just 2- it "firstChild 4" $ firstChild bs 4 `shouldBe` Just 5- it "nextSibling 2" $ nextSibling bs 2 `shouldBe` Just 4- it "nextSibling 5" $ nextSibling bs 5 `shouldBe` Just 7- it "parent 2" $ parent bs 2 `shouldBe` Just 1- it "parent 5" $ parent bs 5 `shouldBe` Just 4- it "depth 1" $ depth bs 1 `shouldBe` Just 1- it "depth 2" $ depth bs 2 `shouldBe` Just 2- it "depth 3" $ depth bs 3 `shouldBe` Just 2- it "depth 4" $ depth bs 4 `shouldBe` Just 2- it "depth 5" $ depth bs 5 `shouldBe` Just 3- it "depth 6" $ depth bs 6 `shouldBe` Just 3- it "depth 7" $ depth bs 7 `shouldBe` Just 3- it "depth 8" $ depth bs 8 `shouldBe` Just 3- it "depth 9" $ depth bs 9 `shouldBe` Just 2- it "depth 10" $ depth bs 10 `shouldBe` Just 1- it "subtreeSize 1" $ subtreeSize bs 1 `shouldBe` Just 5- it "subtreeSize 2" $ subtreeSize bs 2 `shouldBe` Just 1- it "subtreeSize 3" $ subtreeSize bs 3 `shouldBe` Just 0- it "subtreeSize 4" $ subtreeSize bs 4 `shouldBe` Just 3- it "subtreeSize 5" $ subtreeSize bs 5 `shouldBe` Just 1- it "subtreeSize 6" $ subtreeSize bs 6 `shouldBe` Just 0- it "subtreeSize 7" $ subtreeSize bs 7 `shouldBe` Just 1- it "subtreeSize 8" $ subtreeSize bs 8 `shouldBe` Just 0- it "subtreeSize 9" $ subtreeSize bs 9 `shouldBe` Just 0- it "subtreeSize 10" $ subtreeSize bs 10 `shouldBe` Just 0+ it "Test 1a" $ requireTest $ findClose bs 1 === Just 10+ it "Test 1b" $ requireTest $ findClose bs 2 === Just 3+ it "Test 1b" $ requireTest $ findClose bs 3 === Just 3+ it "Test 1b" $ requireTest $ findClose bs 4 === Just 9+ it "Test 1b" $ requireTest $ findClose bs 5 === Just 6+ it "Test 1b" $ requireTest $ findClose bs 6 === Just 6+ it "Test 1b" $ requireTest $ findClose bs 7 === Just 8+ it "Test 1b" $ requireTest $ findClose bs 8 === Just 8+ it "Test 1b" $ requireTest $ findClose bs 9 === Just 9+ it "Test 1b" $ requireTest $ findClose bs 10 === Just 10+ it "Test 2a" $ requireTest $ findOpen bs 10 === Just 1+ it "Test 2b" $ requireTest $ findOpen bs 3 === Just 2+ it "Test 3a" $ requireTest $ enclose bs 2 === Just 1+ it "Test 3b" $ requireTest $ enclose bs 7 === Just 4+ it "firstChild 1" $ requireTest $ firstChild bs 1 === Just 2+ it "firstChild 4" $ requireTest $ firstChild bs 4 === Just 5+ it "nextSibling 2" $ requireTest $ nextSibling bs 2 === Just 4+ it "nextSibling 5" $ requireTest $ nextSibling bs 5 === Just 7+ it "parent 2" $ requireTest $ parent bs 2 === Just 1+ it "parent 5" $ requireTest $ parent bs 5 === Just 4+ it "depth 1" $ requireTest $ depth bs 1 === Just 1+ it "depth 2" $ requireTest $ depth bs 2 === Just 2+ it "depth 3" $ requireTest $ depth bs 3 === Just 2+ it "depth 4" $ requireTest $ depth bs 4 === Just 2+ it "depth 5" $ requireTest $ depth bs 5 === Just 3+ it "depth 6" $ requireTest $ depth bs 6 === Just 3+ it "depth 7" $ requireTest $ depth bs 7 === Just 3+ it "depth 8" $ requireTest $ depth bs 8 === Just 3+ it "depth 9" $ requireTest $ depth bs 9 === Just 2+ it "depth 10" $ requireTest $ depth bs 10 === Just 1+ it "subtreeSize 1" $ requireTest $ subtreeSize bs 1 === Just 5+ it "subtreeSize 2" $ requireTest $ subtreeSize bs 2 === Just 1+ it "subtreeSize 3" $ requireTest $ subtreeSize bs 3 === Just 0+ it "subtreeSize 4" $ requireTest $ subtreeSize bs 4 === Just 3+ it "subtreeSize 5" $ requireTest $ subtreeSize bs 5 === Just 1+ it "subtreeSize 6" $ requireTest $ subtreeSize bs 6 === Just 0+ it "subtreeSize 7" $ requireTest $ subtreeSize bs 7 === Just 1+ it "subtreeSize 8" $ requireTest $ subtreeSize bs 8 === Just 0+ it "subtreeSize 9" $ requireTest $ subtreeSize bs 9 === Just 0+ it "subtreeSize 10" $ requireTest $ subtreeSize bs 10 === Just 0 describe "For (()(()())) 11011010 00000000 :: DVS.Vector Word8" $ do let bs = SimpleBalancedParens (fromJust (bitRead "11011010 00000000") :: DVS.Vector Word8)- it "Test 1a" $ findClose bs 1 `shouldBe` Just 10- it "Test 1b" $ findClose bs 2 `shouldBe` Just 3- it "Test 1b" $ findClose bs 3 `shouldBe` Just 3- it "Test 1b" $ findClose bs 4 `shouldBe` Just 9- it "Test 1b" $ findClose bs 5 `shouldBe` Just 6- it "Test 1b" $ findClose bs 6 `shouldBe` Just 6- it "Test 1b" $ findClose bs 7 `shouldBe` Just 8- it "Test 1b" $ findClose bs 8 `shouldBe` Just 8- it "Test 1b" $ findClose bs 9 `shouldBe` Just 9- it "Test 1b" $ findClose bs 10 `shouldBe` Just 10- it "Test 2a" $ findOpen bs 10 `shouldBe` Just 1- it "Test 2b" $ findOpen bs 3 `shouldBe` Just 2- it "Test 3a" $ enclose bs 2 `shouldBe` Just 1- it "Test 3b" $ enclose bs 7 `shouldBe` Just 4- it "firstChild 1" $ firstChild bs 1 `shouldBe` Just 2- it "firstChild 4" $ firstChild bs 4 `shouldBe` Just 5- it "nextSibling 2" $ nextSibling bs 2 `shouldBe` Just 4- it "nextSibling 5" $ nextSibling bs 5 `shouldBe` Just 7- it "parent 2" $ parent bs 2 `shouldBe` Just 1- it "parent 5" $ parent bs 5 `shouldBe` Just 4- it "depth 1" $ depth bs 1 `shouldBe` Just 1- it "depth 2" $ depth bs 2 `shouldBe` Just 2- it "depth 3" $ depth bs 3 `shouldBe` Just 2- it "depth 4" $ depth bs 4 `shouldBe` Just 2- it "depth 5" $ depth bs 5 `shouldBe` Just 3- it "depth 6" $ depth bs 6 `shouldBe` Just 3- it "depth 7" $ depth bs 7 `shouldBe` Just 3- it "depth 8" $ depth bs 8 `shouldBe` Just 3- it "depth 9" $ depth bs 9 `shouldBe` Just 2- it "depth 10" $ depth bs 10 `shouldBe` Just 1- it "subtreeSize 1" $ subtreeSize bs 1 `shouldBe` Just 5- it "subtreeSize 2" $ subtreeSize bs 2 `shouldBe` Just 1- it "subtreeSize 3" $ subtreeSize bs 3 `shouldBe` Just 0- it "subtreeSize 4" $ subtreeSize bs 4 `shouldBe` Just 3- it "subtreeSize 5" $ subtreeSize bs 5 `shouldBe` Just 1- it "subtreeSize 6" $ subtreeSize bs 6 `shouldBe` Just 0- it "subtreeSize 7" $ subtreeSize bs 7 `shouldBe` Just 1- it "subtreeSize 8" $ subtreeSize bs 8 `shouldBe` Just 0- it "subtreeSize 9" $ subtreeSize bs 9 `shouldBe` Just 0- it "subtreeSize 10" $ subtreeSize bs 10 `shouldBe` Just 0+ it "Test 1a" $ requireTest $ findClose bs 1 === Just 10+ it "Test 1b" $ requireTest $ findClose bs 2 === Just 3+ it "Test 1b" $ requireTest $ findClose bs 3 === Just 3+ it "Test 1b" $ requireTest $ findClose bs 4 === Just 9+ it "Test 1b" $ requireTest $ findClose bs 5 === Just 6+ it "Test 1b" $ requireTest $ findClose bs 6 === Just 6+ it "Test 1b" $ requireTest $ findClose bs 7 === Just 8+ it "Test 1b" $ requireTest $ findClose bs 8 === Just 8+ it "Test 1b" $ requireTest $ findClose bs 9 === Just 9+ it "Test 1b" $ requireTest $ findClose bs 10 === Just 10+ it "Test 2a" $ requireTest $ findOpen bs 10 === Just 1+ it "Test 2b" $ requireTest $ findOpen bs 3 === Just 2+ it "Test 3a" $ requireTest $ enclose bs 2 === Just 1+ it "Test 3b" $ requireTest $ enclose bs 7 === Just 4+ it "firstChild 1" $ requireTest $ firstChild bs 1 === Just 2+ it "firstChild 4" $ requireTest $ firstChild bs 4 === Just 5+ it "nextSibling 2" $ requireTest $ nextSibling bs 2 === Just 4+ it "nextSibling 5" $ requireTest $ nextSibling bs 5 === Just 7+ it "parent 2" $ requireTest $ parent bs 2 === Just 1+ it "parent 5" $ requireTest $ parent bs 5 === Just 4+ it "depth 1" $ requireTest $ depth bs 1 === Just 1+ it "depth 2" $ requireTest $ depth bs 2 === Just 2+ it "depth 3" $ requireTest $ depth bs 3 === Just 2+ it "depth 4" $ requireTest $ depth bs 4 === Just 2+ it "depth 5" $ requireTest $ depth bs 5 === Just 3+ it "depth 6" $ requireTest $ depth bs 6 === Just 3+ it "depth 7" $ requireTest $ depth bs 7 === Just 3+ it "depth 8" $ requireTest $ depth bs 8 === Just 3+ it "depth 9" $ requireTest $ depth bs 9 === Just 2+ it "depth 10" $ requireTest $ depth bs 10 === Just 1+ it "subtreeSize 1" $ requireTest $ subtreeSize bs 1 === Just 5+ it "subtreeSize 2" $ requireTest $ subtreeSize bs 2 === Just 1+ it "subtreeSize 3" $ requireTest $ subtreeSize bs 3 === Just 0+ it "subtreeSize 4" $ requireTest $ subtreeSize bs 4 === Just 3+ it "subtreeSize 5" $ requireTest $ subtreeSize bs 5 === Just 1+ it "subtreeSize 6" $ requireTest $ subtreeSize bs 6 === Just 0+ it "subtreeSize 7" $ requireTest $ subtreeSize bs 7 === Just 1+ it "subtreeSize 8" $ requireTest $ subtreeSize bs 8 === Just 0+ it "subtreeSize 9" $ requireTest $ subtreeSize bs 9 === Just 0+ it "subtreeSize 10" $ requireTest $ subtreeSize bs 10 === Just 0 describe "Does not suffer exceptions" $ do- it "when calling nextSibling from valid locations" $ do- forAll (vectorSizedBetween 1 64) $ \(ShowVector v) -> do- [nextSibling v p | p <- [1..bitLength v]] `shouldBe` [nextSibling v p | p <- [1..bitLength v]]+ it "when calling nextSibling from valid locations" $ requireProperty $ do+ v <- forAll $ G.storableVector (R.linear 1 64) (G.word64 R.constantBounded)+ [nextSibling v p | p <- [1..bitLength v]] === [nextSibling v p | p <- [1..bitLength v]]