diff --git a/bench/Main.hs b/bench/Main.hs --- a/bench/Main.hs +++ b/bench/Main.hs @@ -11,13 +11,13 @@ import HaskellWorks.Data.Naive import HaskellWorks.Data.Ops -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 +import qualified Data.Vector.Storable as DVS +import qualified HaskellWorks.Data.BalancedParens.Gen as G +import qualified HaskellWorks.Data.BalancedParens.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])) diff --git a/gen/HaskellWorks/Data/BalancedParens/Gen.hs b/gen/HaskellWorks/Data/BalancedParens/Gen.hs --- a/gen/HaskellWorks/Data/BalancedParens/Gen.hs +++ b/gen/HaskellWorks/Data/BalancedParens/Gen.hs @@ -14,19 +14,19 @@ ) where import Data.Coerce -import Data.Semigroup ((<>)) +import Data.Semigroup ((<>)) import Data.Word -import HaskellWorks.Data.BalancedParens.Internal.ParensSeq (ParensSeq) +import HaskellWorks.Data.BalancedParens.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 +import qualified Data.Vector as DV +import qualified Data.Vector.Storable as DVS +import qualified HaskellWorks.Data.BalancedParens.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) diff --git a/hw-balancedparens.cabal b/hw-balancedparens.cabal --- a/hw-balancedparens.cabal +++ b/hw-balancedparens.cabal @@ -1,7 +1,7 @@ cabal-version: 2.2 name: hw-balancedparens -version: 0.2.1.0 +version: 0.2.2.0 synopsis: Balanced parentheses description: Balanced parentheses. category: Data, Bit, Succinct Data Structures, Data Structures @@ -61,13 +61,13 @@ 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 + HaskellWorks.Data.BalancedParens.ParensSeq + HaskellWorks.Data.BalancedParens.ParensSeq.Types HaskellWorks.Data.BalancedParens.RangeMinMax HaskellWorks.Data.BalancedParens.RangeMinMax2 HaskellWorks.Data.BalancedParens.Simple diff --git a/src/HaskellWorks/Data/BalancedParens/Internal/ParensSeq.hs b/src/HaskellWorks/Data/BalancedParens/Internal/ParensSeq.hs --- a/src/HaskellWorks/Data/BalancedParens/Internal/ParensSeq.hs +++ b/src/HaskellWorks/Data/BalancedParens/Internal/ParensSeq.hs @@ -1,139 +1,127 @@ -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeFamilies #-} module HaskellWorks.Data.BalancedParens.Internal.ParensSeq - ( ParensSeq(..) - , mempty - , size - , fromWord64s - , fromPartialWord64s - , toPartialWord64s - , fromBools - , toBools - , splitAt - , take - , drop - , firstChild - , nextSibling - , (<|), (><), (|>) + ( Elem(..) + , Measure(..) + , ParensSeq(..) + , ParensSeqFt + , (|>#) + , (#<|) + , ftSplit + , atSizeBelowZero + , atMinZero ) where -import Data.Coerce -import Data.Foldable -import Data.Monoid +import Control.DeepSeq +import Data.Int +import Data.Monoid (Monoid) +import Data.Semigroup (Semigroup (..)) import Data.Word -import HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Internal (Elem (Elem), ParensSeq (ParensSeq), ParensSeqFt) +import GHC.Generics import HaskellWorks.Data.Bits.BitWise -import HaskellWorks.Data.FingerTree (ViewL (..), ViewR (..), (<|), (><), (|>)) +import HaskellWorks.Data.Excess.MinExcess +import HaskellWorks.Data.Excess.PartialMinExcess1 +import HaskellWorks.Data.FingerTree (ViewL (..), ViewR (..), (<|), (><), (|>)) import HaskellWorks.Data.Positioning -import Prelude hiding (drop, max, min, splitAt, take) +import Prelude hiding (max, min) -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 +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 -empty :: ParensSeq -empty = ParensSeq FT.empty +data Elem = Elem + { bps :: {-# UNPACK #-} !Word64 + , size :: {-# UNPACK #-} !Count + } deriving (Eq, Show, Generic) -size :: ParensSeq -> Count -size (ParensSeq parens) = T.size (FT.measure parens :: T.Measure) +instance NFData Elem --- 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) +data Measure = Measure + { size :: {-# UNPACK #-} !Count + , min :: {-# UNPACK #-} !Int + , excess :: {-# UNPACK #-} !Int + } deriving (Eq, Ord, Show, Generic) --- 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) +instance NFData Measure -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 +type ParensSeqFt = FT.FingerTree Measure Elem -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 +newtype ParensSeq = ParensSeq + { parens :: ParensSeqFt + } deriving (Show, NFData, Generic) -toBools :: ParensSeq -> [Bool] -toBools ps = toBoolsDiff ps [] +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 + } -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 +instance Monoid Measure where + mempty = Measure 0 0 0 -drop :: Count -> ParensSeq -> ParensSeq -drop n ps = snd (splitAt n ps) +instance FT.Measured Measure Elem where + measure (Elem w size) = Measure { min, excess, size } + where MinExcess min excess = partialMinExcess1 (fromIntegral size) w -take :: Count -> ParensSeq -> ParensSeq -take n ps = fst (splitAt n ps) +instance HW.Container ParensSeq where + type Elem ParensSeq = Bool -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) +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 -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 +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 -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) +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 diff --git a/src/HaskellWorks/Data/BalancedParens/Internal/ParensSeq/Internal.hs b/src/HaskellWorks/Data/BalancedParens/Internal/ParensSeq/Internal.hs deleted file mode 100644 --- a/src/HaskellWorks/Data/BalancedParens/Internal/ParensSeq/Internal.hs +++ /dev/null @@ -1,127 +0,0 @@ -{-# 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 diff --git a/src/HaskellWorks/Data/BalancedParens/Internal/ParensSeq/Types.hs b/src/HaskellWorks/Data/BalancedParens/Internal/ParensSeq/Types.hs deleted file mode 100644 --- a/src/HaskellWorks/Data/BalancedParens/Internal/ParensSeq/Types.hs +++ /dev/null @@ -1,5 +0,0 @@ -module HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Types - ( ParensSeq - ) where - -import HaskellWorks.Data.BalancedParens.Internal.ParensSeq.Internal (ParensSeq) diff --git a/src/HaskellWorks/Data/BalancedParens/ParensSeq.hs b/src/HaskellWorks/Data/BalancedParens/ParensSeq.hs new file mode 100644 --- /dev/null +++ b/src/HaskellWorks/Data/BalancedParens/ParensSeq.hs @@ -0,0 +1,139 @@ +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} + +module HaskellWorks.Data.BalancedParens.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 (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 as PS +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) = PS.size (FT.measure parens :: PS.Measure) + +-- TODO Needs optimisation +fromWord64s :: Traversable f => f Word64 -> ParensSeq +fromWord64s = foldl go empty + where go :: ParensSeq -> Word64 -> ParensSeq + go ps w = ParensSeq (PS.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 (PS.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 + PS.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 (PS.atSizeBelowZero n) parens of + (lt, rt) -> let + n' = n - PS.size (FT.measure lt :: PS.Measure) + u = 64 - n' + in case FT.viewl rt of + PS.Elem w nw :< rrt -> if n' >= nw + then (ParensSeq lt , ParensSeq rrt ) + else (ParensSeq (lt |> PS.Elem ((w .<. u) .>. u) n'), ParensSeq (PS.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 + PS.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 + PS.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) = PS.ftSplit (PS.atSizeBelowZero (n - 1)) ps + _ <- case FT.viewl rt0 of + PS.Elem w nw :< _ -> if nw >= 1 && w .&. 1 == 1 then Just () else Nothing + FT.EmptyL -> Nothing + let (lt1, rt1) = PS.ftSplit (PS.atSizeBelowZero 1) rt0 + let (lt2, rt2) = PS.ftSplit PS.atMinZero rt1 + case FT.viewl rt2 of + PS.Elem w nw :< _ -> if nw >= 1 && w .&. 1 == 0 then Just () else Nothing + FT.EmptyL -> Nothing + let (lt3, rt3) = PS.ftSplit (PS.atSizeBelowZero 1) rt2 + case FT.viewl rt3 of + PS.Elem w nw :< _ -> if nw >= 1 && w .&. 1 == 1 then Just () else Nothing + FT.EmptyL -> Nothing + return $ 1 + + PS.size (FT.measure lt0 :: PS.Measure) + + PS.size (FT.measure lt1 :: PS.Measure) + + PS.size (FT.measure lt2 :: PS.Measure) + + PS.size (FT.measure lt3 :: PS.Measure) diff --git a/src/HaskellWorks/Data/BalancedParens/ParensSeq/Types.hs b/src/HaskellWorks/Data/BalancedParens/ParensSeq/Types.hs new file mode 100644 --- /dev/null +++ b/src/HaskellWorks/Data/BalancedParens/ParensSeq/Types.hs @@ -0,0 +1,5 @@ +module HaskellWorks.Data.BalancedParens.ParensSeq.Types + ( ParensSeq + ) where + +import HaskellWorks.Data.BalancedParens.Internal.ParensSeq (ParensSeq) diff --git a/test/HaskellWorks/Data/BalancedParens/Internal/ParensSeqSpec.hs b/test/HaskellWorks/Data/BalancedParens/Internal/ParensSeqSpec.hs --- a/test/HaskellWorks/Data/BalancedParens/Internal/ParensSeqSpec.hs +++ b/test/HaskellWorks/Data/BalancedParens/Internal/ParensSeqSpec.hs @@ -4,19 +4,19 @@ module HaskellWorks.Data.BalancedParens.Internal.ParensSeqSpec where -import Data.Semigroup ((<>)) -import HaskellWorks.Data.BalancedParens.Internal.ParensSeq ((<|), (><), (|>)) +import Data.Semigroup ((<>)) +import HaskellWorks.Data.BalancedParens.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 +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.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) #-}