Commit f3efcbe7 authored by Mike Ledger's avatar Mike Ledger

lookup for compressed radix tree

parent 5d4d800a
Pipeline #18794662 failed with stage
in 47 seconds
......@@ -261,26 +261,25 @@ instance RadixParsing RadixTree where
| otherwise = try (text prefix *> go tree)
lookup :: RadixTree -> Text -> Maybe Text
lookup rt t
| T.null t = case rt of
lookup rt0 t0
| T.null t0 = case rt0 of
RadixAccept v _ -> Just v
RadixSkip _ -> Nothing
| otherwise = case rt of
RadixAccept _ ns -> lookupRadixNodes t ns
RadixSkip ns -> lookupRadixNodes t ns
lookupRadixNodes :: Text -> Vector RadixNode -> Maybe Text
lookupRadixNodes t v = go 0
where
vlen = V.length v
go i
| i < vlen = case V.unsafeIndex v i of
RadixNode pfix rt -> case T.commonPrefixes pfix t of
Just (_, remPfx, remSfx)
| T.null remPfx -> Data.RadixTree.lookup rt remSfx
| otherwise -> Nothing
Nothing -> go (i + 1)
| otherwise = Nothing
| otherwise = case rt0 of
RadixAccept _ ns -> lookupRadixNodes t0 ns
RadixSkip ns -> lookupRadixNodes t0 ns
where
lookupRadixNodes t v = go 0
where
!vlen = V.length v
go !i
| i < vlen = case V.unsafeIndex v i of
RadixNode pfix rt -> case T.commonPrefixes pfix t of
Just (_, remPfx, remSfx)
| T.null remPfx -> Data.RadixTree.lookup rt remSfx
| otherwise -> Nothing
Nothing -> go (i + 1)
| otherwise = Nothing
instance RadixParsing CompressedRadixTree where
{-# INLINE parse #-}
......@@ -289,15 +288,39 @@ instance RadixParsing CompressedRadixTree where
parse (CompressedRadixTree arr crt) = go crt
where
fromSlice (TextSlice offs len) = TI.text arr offs len
go r = case r of
CompressedRadixAccept ts nodes -> case fromSlice ts of
l | T.null l -> empty
| otherwise -> asum (V.map parseRadixNode nodes) <|> pure l
CompressedRadixSkip nodes -> asum (V.map parseRadixNode nodes)
{-# INLINE parseRadixNode #-}
parseRadixNode (CompressedRadixNode ts tree) = case fromSlice ts of
prefix | T.null prefix -> go tree
| otherwise -> try (text prefix *> go tree)
lookup :: CompressedRadixTree -> Text -> Maybe Text
lookup (CompressedRadixTree arr0 rt0) = lookup1 rt0
where
fromSlice (TextSlice offs16 len16) = TI.text arr0 offs16 len16
lookup1 rt !t
| T.null t = case rt of
CompressedRadixAccept v _ -> Just (fromSlice v)
CompressedRadixSkip _ -> Nothing
| otherwise = case rt of
CompressedRadixAccept _ ns -> lookupCompressedRadixNodes t ns
CompressedRadixSkip ns -> lookupCompressedRadixNodes t ns
lookupCompressedRadixNodes !t v = go 0
where
!vlen = V.length v
go !i
| i < vlen = case V.unsafeIndex v i of
CompressedRadixNode pfix rt -> case T.commonPrefixes (fromSlice pfix) t of
Just (_, remPfx, remSfx)
| T.null remPfx -> lookup1 rt remSfx
| otherwise -> Nothing
Nothing -> go (i + 1)
| otherwise = Nothing
......@@ -7,7 +7,6 @@
import Data.Attoparsec.Text
import Data.Coerce
import Data.List (sortOn)
import Data.Maybe
import qualified Data.RadixTree as R
import qualified Data.Text as T
import Test.SmallCheck
......@@ -21,15 +20,6 @@ sortOnLengthDesc = sortOn (negate . T.length)
mkAlternatives :: NonEmpty (NonEmpty Char) -> [T.Text]
mkAlternatives = sortOnLengthDesc . map T.pack . coerce
instance Monad m => Serial m R.RadixTree where
series = fmap (R.fromFoldable . mkAlternatives) series
instance Monad m => Serial m R.CompressedRadixTree where
series =
fmap
(fromJust . (R.compressBy <$> T.concat <*> R.fromFoldable) . mkAlternatives)
series
naiiveSameAsRadix :: Monad m => Bool -> Property m
naiiveSameAsRadix doCompress =
forAll $ \(mkAlternatives -> alternatives) ->
......@@ -49,12 +39,13 @@ lookupSameishAsParse =
forAll $ \alternatives ->
let
!rt = R.fromFoldable (mkAlternatives alternatives)
!p = R.parse rt
!p = R.parse rt <* endOfInput
in forAll $ \(textS :: NonEmpty Char) ->
let text = T.pack (coerce textS)
in case (parseOnly p text, R.lookup rt text) of
(Right x1, Just x2) -> x1 == x2
(Left _ , Nothing) -> True
_ -> False
main :: IO ()
main = defaultMain $ testGroup "radixtree"
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment