packages feed

trie-simple 0.4.3 → 0.4.4

raw patch · 6 files changed

+110/−17 lines, 6 filesdep ~basedep ~containers

Dependency ranges changed: base, containers

Files

CHANGELOG.md view
@@ -1,3 +1,8 @@+# 0.4.4++- ([#7](https://github.com/viercc/trie-simple/issues/17))+  Adds `Data.Trie.Map.lookupPrefixes` function+ # 0.4.3  - No changes to the library itself
bench/trie-benchmark.hs view
@@ -43,7 +43,8 @@         , bench "stringCount" (nf TSet.count mapA)         , bench "enumerate10" (nf (take 10 . TSet.enumerate) mapA)         , bench "enumerateAll" (nf TSet.enumerate mapA)-        , bench "match" (nf (\dict' -> map (`TSet.member` dict') gibberish) mapA) ]+        , bench "member" (nf (\dict' -> map (`TSet.member` dict') gibberish) mapA)+        , bench "beginWith" (whnf (`TSet.beginWith` shortKey) mapA) ]   , env (pure (TSet.fromList dictA)) $ \mapA ->       bgroup "single-item"         [ bench "insert1" (whnf (TSet.insert "######fake_key######") mapA)@@ -62,7 +63,9 @@         , bench "prefixes" (whnf TSet.prefixes mapA)         , bench "suffixes" (whnf TSet.suffixes mapB) ]   ]-  where realKey = head dictA+  where+    realKey = head dictA+    shortKey = take 3 realKey  benchSet :: Dataset -> Benchmark benchSet ~Dataset{..} = bgroup "Set"@@ -79,7 +82,8 @@         , bench "stringCount" (nf Set.size mapA)         , bench "enumerate10" (nf (take 10 . Set.toList) mapA)         , bench "enumerateAll" (nf Set.toList mapA)-        , bench "match" (nf (\dict' -> map (`Set.member` dict') gibberish) mapA) ]+        , bench "member" (nf (\dict' -> map (`Set.member` dict') gibberish) mapA)+        , bench "beginWith" (whnf (`setBeginWith` shortKey) mapA) ]   , env (pure (Set.fromList dictA)) $ \mapA ->       bgroup "single-item"         [ bench "insert1" (whnf (Set.insert "######fake_key######") mapA)@@ -98,7 +102,9 @@         , bench "prefixes" (whnf setPrefixes mapA)         , bench "suffixes" (whnf setSuffixes mapB) ]   ]-  where realKey = head dictA+  where+    realKey = head dictA+    shortKey = take 3 realKey  setAppend :: (Ord c) => Set [c] -> Set [c] -> Set [c] setAppend ass bss = Set.unions@@ -113,7 +119,23 @@ setSuffixes ass = Set.fromList   [ bs | as <- Set.toAscList ass, bs <- tails as ] +setBeginWith :: (Ord c) => Set [c] -> [c] -> Set [c]+setBeginWith ass prefix =+  let n = length prefix+      -- ass' = { as | as ∈ ass, as >= prefix }+      ass' = Set.dropWhileAntitone (< prefix) ass+      -- ass'' = { as | as ∈ ass', prefix `isPrefixOf` as }+      -- Note: `isPrefix prefix :: [c] -> Bool` is antitone predicate for ass'!+      --       In fact, take any `xs, ys` such that `prefix <= xs <= ys`.+      --       Then `isPrefix prefix ys ==> isPrefix prefix xs` holds.+      ass'' = Set.takeWhileAntitone (isPrefixOf prefix) ass'+  in Set.mapMonotonic (drop n) ass'' +isPrefixOf :: Eq c => [c] -> [c] -> Bool+isPrefixOf [] _ = True+isPrefixOf (_:_) [] = False+isPrefixOf (p:ps) (a:as) = p == a && isPrefixOf ps as+ benchTMap :: Dataset -> Benchmark benchTMap ~Dataset{..} = bgroup "TMap"    [ bgroup "construction"@@ -125,7 +147,9 @@         [ bench "isEmpty" (nf TMap.null mapA)         , bench "stringCount" (nf TMap.count mapA)         , bench "enumerate10" (nf (take 10 . TMap.toList) mapA)-        , bench "match" (nf (\dict' -> map (`TMap.member` dict') gibberish) mapA) ]+        , bench "lookupPrefixes" $ nf (TMap.lookupPrefixes longKey) mapA+        , bench "member" (nf (\dict' -> map (`TMap.member` dict') gibberish) mapA)+        , bench "match" (whnf (consumeMatch . TMap.match shortKey) mapA) ]   , env (pure (lenTMap dictA)) $ \mapA ->       bgroup "single-item"         [ bench "insert1" (whnf (TMap.insert "######fake_key######" 1) mapA)@@ -148,10 +172,13 @@         , env (pure $ lenTMap gibberish) $ \mapSmall ->             bench "append" (whnf (uncurry tmapProd) (mapSmall, mapSmall)) ]   ]-  where realKey = head dictA+  where+    realKey = head dictA+    longKey = concat (replicate 100 realKey)+    shortKey = take 3 realKey  alterFn :: Maybe Int -> Maybe Int-alterFn Nothing = Just 1000+alterFn Nothing = Nothing alterFn (Just a) = if even a then Just a else Nothing  lenTMap :: (Ord c) => [[c]] -> TMap c Int@@ -160,6 +187,10 @@ tmapProd :: (Ord c) => TMap c Int -> TMap c Int -> TMap c (Sum Int) tmapProd = TMap.appendWith (\x y -> Sum (x * y)) +consumeMatch :: (Maybe a, r) -> r+consumeMatch (ma, r) = (maybe () (`seq` ()) ma) `seq` r+{-# INLINE consumeMatch #-}+ benchMap :: Dataset -> Benchmark benchMap ~Dataset{..} = bgroup "Map"    [ bgroup "construction"@@ -171,7 +202,10 @@         [ bench "isEmpty" (nf Map.null mapA)         , bench "stringCount" (nf Map.size mapA)         , bench "enumerate10" (nf (take 10 . Map.toList) mapA)-        , bench "match" (nf (\dict' -> map (`Map.member` dict') gibberish) mapA) ]+        , bench "lookupPrefixes" $ nf (mapLookupPrefixes longKey) mapA+        , bench "member" (nf (\dict' -> map (`Map.member` dict') gibberish) mapA)+        , bench "match" (whnf (consumeMatch . mapMatch shortKey) mapA)+        ]   , env (pure (lenMap dictA)) $ \mapA ->       bgroup "single-item"         [ bench "insert1" (whnf (Map.insert "######fake_key######" 1) mapA)@@ -194,7 +228,10 @@         , env (pure $ lenMap gibberish) $ \mapSmall ->             bench "append" (whnf (uncurry mapProd) (mapSmall, mapSmall)) ]   ]-  where realKey = head dictA+  where+    realKey = head dictA+    longKey = concat (replicate 100 realKey)+    shortKey = take 3 realKey  lenMap :: (Ord c) => [[c]] -> Map [c] Int lenMap dict = Map.fromList [(w, length w) | w <- dict]@@ -205,3 +242,25 @@     [ prod1 s x m2 | (s,x) <- Map.toList m1 ]   where     prod1 s x m = Map.mapKeysMonotonic (s++) $ Map.map (x*) m++mapLookupPrefixes :: Ord c => [c] -> Map [c] Int -> [([c], Int)]+mapLookupPrefixes xs m = +  let m' = Map.takeWhileAntitone (\k -> k <= xs) m+  in mapLookupIncreasingKeys (inits xs) m'++mapLookupIncreasingKeys :: Ord k => [k] -> Map k a -> [(k,a)]+mapLookupIncreasingKeys = go+  where+    go []       _ = []+    go (k:keys) m+      | Map.null m = []+      | otherwise = case Map.splitLookup k m of+          (_, Nothing, m') -> go keys m'+          (_, Just a,  m') -> (k,a) : go keys m'++mapMatch :: (Ord c) => [c] -> Map [c] a -> (Maybe a, Map [c] a)+mapMatch prefix m =+  let n = length prefix+      m' = Map.dropWhileAntitone (< prefix) m+      m'' = Map.takeWhileAntitone (isPrefixOf prefix) m'+  in (Map.lookup prefix m'', Map.mapKeysMonotonic (drop n) m'')
src/Data/Trie/Map.hs view
@@ -4,6 +4,7 @@   -- * Queries   match,   lookup,+  lookupPrefixes,   member, notMember,   null, count,   keys, elems,
src/Data/Trie/Map/Hidden.hs view
@@ -7,6 +7,7 @@   -- * Queries   match,   lookup,+  lookupPrefixes,   member, notMember,   null, count,   keys, elems,@@ -222,11 +223,11 @@ --   'lookup'. The second is another @TMap@ for all keys which contain @xs@ as their prefix. --   The keys of the returned map do not contain the common prefix @xs@. -----   ===== Example------   >>> let x = 'fromList' [("ham", 1), ("bacon", 2), ("hamburger", 3)]---   >>> match "ham" x---   (Just 1,fromList [("",1),("burger",3)])+-- ===== Example+-- +-- >>> let x = fromList [("ham", 1), ("bacon", 2), ("hamburger", 3)]+-- >>> match "ham" x+-- (Just 1,fromList [("",1),("burger",3)]) match :: (Ord c) => [c] -> TMap c a -> (Maybe a, TMap c a) match []     t@(TMap (Node ma _)) = (ma, t) match (c:cs)   (TMap (Node _  e)) =@@ -238,6 +239,27 @@ --   from @xs@ to @a@, and returns @Nothing@ if not. lookup :: (Ord c) => [c] -> TMap c a -> Maybe a lookup cs = fst . match cs++-- | @lookupPrefixes xs tmap@ performs 'lookup' for every prefixes of the input string @xs@+--   and returns list of every pair of prefix and value exising in @tmap@.+--+-- ===== Example+-- +-- >>> let x = fromList [("ham", 1), ("bacon", 2), ("hamburger", 3)]+-- >>> lookupPrefixes "hamburger and bacon" x+-- [("ham",1),("hamburger",3)]+lookupPrefixes :: (Ord c) => [c] -> TMap c a -> [([c], a)]+lookupPrefixes = go []+  where+    entry revPrefix ma = case ma of+      Nothing -> id+      Just a -> ((reverse revPrefix, a) :)+    +    go revPrefix [] (TMap (Node ma _)) = entry revPrefix ma []+    go revPrefix (x:xs) (TMap (Node ma e)) = entry revPrefix ma $+      case Map.lookup x e of+        Nothing -> []+        Just rest -> go (x : revPrefix) xs rest  member, notMember :: (Ord c) => [c] -> TMap c a -> Bool member cs = isJust . lookup cs
test/Data/Trie/MapSpec.hs view
@@ -7,7 +7,8 @@ import           Test.Hspec import           Test.QuickCheck -import           Data.List (sortBy, foldl')+import qualified Data.Foldable as F+import           Data.List (sortBy, foldl', inits) import           Data.Ord import           Data.Map            (Map) import qualified Data.Map            as Map@@ -68,6 +69,11 @@     property $ \(TMap'' t) ->       let strMap = toMap t       in property $ \str -> T.lookup str t == Map.lookup str strMap+  specify "lookupPrefixes k t = [ (prek, v) | prek <- inits k, v <- toList $ Map.lookup prek (toMap t) ]" $+    property $ \(TMap'' t) ->+      let strMap = toMap t+          slow str = [ (prek, v) | prek <- inits str, v <- F.toList $ Map.lookup prek strMap ]+      in property $ \str -> T.lookupPrefixes str t == slow str   specify "lookup (k ++ l) t == lookup l (snd (match k t))" $     property $ \k l (TMap'' t) ->       T.lookup (k ++ l) t == T.lookup l (snd (T.match k t))
trie-simple.cabal view
@@ -1,5 +1,5 @@ name:                trie-simple-version:             0.4.3+version:             0.4.4 synopsis:            Simple Map-based Trie description:   A trie data structure @TMap c v@, to hold a mapping from list of characters (@[c]@) to@@ -39,7 +39,7 @@                        mtl          >= 2.2.1   && < 2.4,                        indexed-traversable >= 0.1.1 && <0.2,                        witherable   >= 0.4 && < 0.6,-                       matchable    ^>= 0.1.2,+                       matchable    >= 0.1.2 && <0.3,                        hashable     >= 1.3 && < 1.6,                        semialign    >= 1.3 && < 1.4,                        these        >= 1 && < 2