From 128b283eaf07ee5dcad30faeb77a2caf2a55af49 Mon Sep 17 00:00:00 2001 From: YongJoon Joe Date: Tue, 12 May 2020 16:30:08 +0900 Subject: [PATCH 1/5] Add deleteSubmap --- src/Data/Trie/Text/Internal.hs | 38 ++++++++++++++++++++++++++++++++++ 1 file changed, 38 insertions(+) diff --git a/src/Data/Trie/Text/Internal.hs b/src/Data/Trie/Text/Internal.hs index 6af1845..c7d940b 100644 --- a/src/Data/Trie/Text/Internal.hs +++ b/src/Data/Trie/Text/Internal.hs @@ -56,6 +56,10 @@ module Data.Trie.Text.Internal , contextualFilterMap , contextualMapBy + -- * Something else + , deleteSubmap + , deleteSubmap' + -- * Priority-queue functions , minAssoc, maxAssoc , updateMinViewBy, updateMaxViewBy @@ -1012,6 +1016,40 @@ mergeMaybe _ mv0@(Just _) Nothing = mv0 mergeMaybe f (Just v0) (Just v1) = f v0 v1 +-- | Delete the submap under the given key. +deleteSubmap :: Text -> Trie a -> Trie a +{-# INLINE deleteSubmap #-} +deleteSubmap q_ + | T.null q_ = const Empty + | otherwise = go q_ + where + go _ Empty = Empty + + go q t@(Branch p m l r) + | nomatch qh p m = t + | zero qh m = branch p m (go q l) r + | otherwise = branch p m l (go q r) + where + qh = errorLogHead "deleteSubmap" q + + go q (Arc k mv t) = + let (_,_,q') = breakMaximalPrefix k q in + case T.null q' of + True -> -- Partially, or completely match the Prefix + Empty + False -> -- Have different Prefix yet, do nothing + arc k mv (go q' t) + +-- Inefficient implementation which is equivalent of `deleteSubmap` +deleteSubmap' :: Text -> Trie a -> Trie a +{-# INLINE deleteSubmap' #-} +deleteSubmap' key trie = + foldr + (\k t -> alterBy (\_ _ _ -> Nothing) k (error "delete") t) + trie + (map L.toStrict . toListBy const $ submap key trie) + + {----------------------------------------------------------- -- Priority-queue functions -----------------------------------------------------------} From 33609fb5fe99b89a2d10af411908f67e8c8c4b6d Mon Sep 17 00:00:00 2001 From: YongJoon Joe Date: Tue, 12 May 2020 17:07:36 +0900 Subject: [PATCH 2/5] Remove unnecessary inner recursive code --- src/Data/Trie/Text/Internal.hs | 32 +++++++++++++------------------- 1 file changed, 13 insertions(+), 19 deletions(-) diff --git a/src/Data/Trie/Text/Internal.hs b/src/Data/Trie/Text/Internal.hs index c7d940b..283fb92 100644 --- a/src/Data/Trie/Text/Internal.hs +++ b/src/Data/Trie/Text/Internal.hs @@ -1019,26 +1019,20 @@ mergeMaybe f (Just v0) (Just v1) = f v0 v1 -- | Delete the submap under the given key. deleteSubmap :: Text -> Trie a -> Trie a {-# INLINE deleteSubmap #-} -deleteSubmap q_ - | T.null q_ = const Empty - | otherwise = go q_ +deleteSubmap _ Empty = Empty +deleteSubmap q t@(Branch p m l r) + | nomatch qh p m = t + | zero qh m = branch p m (deleteSubmap q l) r + | otherwise = branch p m l (deleteSubmap q r) where - go _ Empty = Empty - - go q t@(Branch p m l r) - | nomatch qh p m = t - | zero qh m = branch p m (go q l) r - | otherwise = branch p m l (go q r) - where - qh = errorLogHead "deleteSubmap" q - - go q (Arc k mv t) = - let (_,_,q') = breakMaximalPrefix k q in - case T.null q' of - True -> -- Partially, or completely match the Prefix - Empty - False -> -- Have different Prefix yet, do nothing - arc k mv (go q' t) + qh = errorLogHead "deleteSubmap" q +deleteSubmap q (Arc k mv t) = + let (_,_,q') = breakMaximalPrefix k q in + case T.null q' of + True -> -- Partially, or completely match the Prefix + Empty + False -> -- Have different Prefix yet, do nothing + arc k mv (deleteSubmap q' t) -- Inefficient implementation which is equivalent of `deleteSubmap` deleteSubmap' :: Text -> Trie a -> Trie a From 4a82dc98b973c225b1e6eb64eeebd822f2d48d8a Mon Sep 17 00:00:00 2001 From: YongJoon Joe Date: Tue, 12 May 2020 17:15:09 +0900 Subject: [PATCH 3/5] Nothing --- src/Data/Trie/Text.hs | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/src/Data/Trie/Text.hs b/src/Data/Trie/Text.hs index 3183f18..d97c974 100644 --- a/src/Data/Trie/Text.hs +++ b/src/Data/Trie/Text.hs @@ -51,6 +51,7 @@ module Data.Trie.Text -- * Single-value modification , alterBy, insert, adjust, delete + , deleteSubmap'' -- * Combining tries , mergeBy, unionL, unionR @@ -169,6 +170,12 @@ delete :: Text -> Trie a -> Trie a {-# INLINE delete #-} delete q = alterBy (\_ _ _ -> Nothing) q (impossible "delete") +deleteSubmap'' key trie = + foldr + (\k t -> delete k t) + trie + (map L.toStrict . keys $ submap key trie) + {--------------------------------------------------------------- -- Trie-combining functions ---------------------------------------------------------------} From 4bc4a818f6bea86635aee2a20a418c72d0fdcc4b Mon Sep 17 00:00:00 2001 From: YongJoon Joe Date: Sat, 16 May 2020 17:53:30 +0900 Subject: [PATCH 4/5] Add missing function export --- src/Data/Trie/Text.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/Data/Trie/Text.hs b/src/Data/Trie/Text.hs index d97c974..08c0221 100644 --- a/src/Data/Trie/Text.hs +++ b/src/Data/Trie/Text.hs @@ -51,6 +51,8 @@ module Data.Trie.Text -- * Single-value modification , alterBy, insert, adjust, delete + , deleteSubmap + , deleteSubmap' , deleteSubmap'' -- * Combining tries From c6a4be208c112344b6fab2872f2efc222234c557 Mon Sep 17 00:00:00 2001 From: YongJoon Joe Date: Fri, 2 Oct 2020 01:46:49 +0900 Subject: [PATCH 5/5] Relax upper bound for GHC 8.8.* --- stack.yaml | 5 +++-- text-trie.cabal | 18 +++++++++--------- 2 files changed, 12 insertions(+), 11 deletions(-) diff --git a/stack.yaml b/stack.yaml index d447438..f3a980d 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,6 +1,7 @@ flags: {} +resolver: lts-16.16 packages: - . extra-deps: -- bytestring-trie-0.2.5.0 -resolver: lts-13.15 +- bytestring-trie-0.2.5.0@sha256:9efa9c6f556314d28486be2470ff789419c5238ed2e354870623a3cbbd28fbe2,3349 +- microbench-0.1@sha256:f5c60aa2f40f9114aa0fb1fb2fe2f6cd8506d7ce3d1f0f46295d34651e523a2c,983 \ No newline at end of file diff --git a/text-trie.cabal b/text-trie.cabal index 65c1f92..23c5100 100644 --- a/text-trie.cabal +++ b/text-trie.cabal @@ -73,9 +73,9 @@ Library -- The lower bounds are more restrictive than necessary. -- But then, we don't maintain any CI tests for older -- versions, so these are the lowest bounds we've verified. - Build-Depends: base >= 4.5 && < 4.13 - , text >= 1.2.3 && < 1.2.4 - , binary >= 0.5.1 && < 0.8.7 + Build-Depends: base >= 4.5 + , text >= 1.2.3 + , binary >= 0.5.1 ------------------------------------------------------------ Test-Suite test-text-trie @@ -90,16 +90,16 @@ Test-Suite test-text-trie , FromListBench.Text.Encode , TrieFile.Text build-depends: text-trie - , base >= 4.5 && < 4.13 - , bytestring >= 0.9.2 && < 0.11 - , text >= 1.2.3 && < 1.2.4 - , binary >= 0.5.1 && < 0.8.7 + , base >= 4.5 + , bytestring >= 0.9.2 + , text >= 1.2.3 + , binary >= 0.5.1 , QuickCheck , HUnit , smallcheck , microbench - , bytestring-trie >= 0.2.5 && < 0.2.6 - , silently >= 1.2.5 && < 1.2.6 + , bytestring-trie >= 0.2.5 + , silently >= 1.2.5 ------------------------------------------------------------ ------------------------------------------------------- fin.