packages feed

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 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]]