pred-trie 0.0.8.1 → 0.0.9

raw patch · 5 files changed

+81/−32 lines, 5 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• pred-trie.cabal +1/−1
• src/Data/Trie/Pred/Disjoint.hs +25/−11
• src/Data/Trie/Pred/Disjoint/Tail.hs +46/−10
• src/Data/Trie/Pred/Unified.hs +4/−4
• src/Data/Trie/Pred/Unified/Tail.hs +5/−6

@@ -1,5 +1,5 @@ Name:                   pred-trie-Version:                0.0.8.1+Version:                0.0.9 Author:                 Athan Clark <athan.clark@gmail.com> Maintainer:             Athan Clark <athan.clark@gmail.com> License:                BSD3

@@ -1,6 +1,15 @@-module Data.Trie.Pred.Disjoint where+module Data.Trie.Pred.Disjoint+  ( RDPTrie (..)+  , merge+  , lookup+  , lookupNearestParent+  , litSingleton+  , litExtrude+  , module Data.Trie.Pred.Disjoint.Tail+  ) where -import Data.Trie.Pred.Disjoint.Tail+import Prelude hiding (lookup)+import Data.Trie.Pred.Disjoint.Tail hiding (lookup, lookupNearestParent, merge) import qualified Data.Trie.Pred.Disjoint.Tail as ND import Data.Monoid import qualified Data.List.NonEmpty as NE@@ -19,19 +28,24 @@   where     go :: (Eq p, Eq t) => DPTrie p t x -> [DPTrie p t x] -> [DPTrie p t x]     go a [] = [a]-    go a (b:bs) | ND.areDisjoint a b =          a : b : bs-                | otherwise          = (ND.merge a b) : bs+    go a (b:bs) | ND.areDisjoint a b =        a : b : bs+                | otherwise          = ND.merge a b : bs  lookup :: (Eq t) => [t] -> RDPTrie p t x -> Maybe x lookup [] (Rooted mx _) = mx-lookup ts (Rooted _ xs) = getFirst $ map (ND.lookup $ NE.fromList ts) xs-  where-    getFirst :: [Maybe a] -> Maybe a-    getFirst [] = Nothing-    getFirst (Nothing:xs) = getFirst xs-    getFirst (Just x :xs) = Just x+lookup ts (Rooted _ xs) = firstJust $ map (ND.lookup $ NE.fromList ts) xs +lookupNearestParent :: (Eq t) => [t] -> RDPTrie p t x -> Maybe x+lookupNearestParent [] (Rooted mx _) = mx+lookupNearestParent ts (Rooted mx xs) =+  getFirst $ (First $ firstJust $ map (ND.lookupNearestParent $ NE.fromList ts) xs) <> First mx +firstJust :: [Maybe a] -> Maybe a+firstJust [] = Nothing+firstJust (Nothing:xs) = firstJust xs+firstJust (Just x :xs) = Just x++ litSingleton :: [t] -> x -> RDPTrie p t x litSingleton [] x = Rooted (Just x) [] litSingleton ts x = Rooted Nothing [ND.litSingletonTail (NE.fromList ts) x]@@ -39,7 +53,7 @@  litExtrude :: [t] -> RDPTrie p t x -> RDPTrie p t x litExtrude [] r = r-litExtrude (t:[]) (Rooted mx xs) = Rooted Nothing [DMore t mx xs]+litExtrude [t] (Rooted mx xs) = Rooted Nothing [DMore t mx xs] litExtrude ts (Rooted mx xs) = Rooted Nothing [ND.litExtrudeTail (init ts) $                                                  DMore (last ts) mx xs                                               ]

@@ -5,6 +5,7 @@ module Data.Trie.Pred.Disjoint.Tail   ( DPTrie (..)   , lookup+  , lookupNearestParent   , merge   , areDisjoint   , litSingletonTail@@ -13,8 +14,7 @@   ) where  import Prelude hiding (lookup)-import Data.List.NonEmpty hiding (map)-import Data.List.NonEmpty as NE hiding (map)+import Data.List.NonEmpty as NE hiding (map, sort)   @@ -38,8 +38,8 @@   where     go :: (Eq p, Eq t) => DPTrie p t x -> [DPTrie p t x] -> [DPTrie p t x]     go a [] = [a]-    go a (b:bs) | areDisjoint a b =       a : b : bs-                | otherwise       = (merge a b) : bs+    go a (b:bs) | areDisjoint a b =     a : b : bs+                | otherwise       = merge a b : bs merge xx@(DPred t q mrx xrs) yy@(DPred p w mry yrs)   | t == p = yy   | otherwise = xx@@ -57,21 +57,41 @@ lookup (t:|ts) (DMore t' mx xs)   | t == t' = case ts of     [] -> mx-    _  -> getFirst $ map (lookup $ NE.fromList ts) xs+    _  -> firstJust $ map (lookup $ NE.fromList ts) xs   | otherwise = Nothing lookup (t:|ts) (DPred _ p mrx xrs) =   p t >>=     \r -> case ts of       [] -> ($ r) <$> mrx-      _  -> ($ r) <$> (getFirst $ map (lookup $ NE.fromList ts) xrs)+      _  -> ($ r) <$> firstJust (map (lookup $ NE.fromList ts) xrs)  -getFirst :: [Maybe a] -> Maybe a-getFirst [] = Nothing-getFirst (Nothing:xs) = getFirst xs-getFirst (Just x :xs) = Just x+lookupNearestParent :: Eq t => NonEmpty t -> DPTrie p t x -> Maybe x+lookupNearestParent tss@(t:|ts) trie@(DMore t' mx xs) = case lookup tss trie of+  Nothing -> if t == t'+               then case ts of+                      [] -> mx -- redundant; should have successful lookup+                      _  -> case firstJust $ map (lookupNearestParent $ NE.fromList ts) xs of+                              Nothing -> mx+                              justr   -> justr+               else Nothing+  justr -> justr+lookupNearestParent tss@(t:|ts) trie@(DPred t' p mrx xrs) = case lookup tss trie of+  Nothing -> p t >>=+               \r -> case ts of+                        [] -> ($ r) <$> mrx -- redundant; should have successful lookup+                        _  -> case firstJust $ map (lookupNearestParent $ NE.fromList ts) xrs of+                                Nothing -> ($ r) <$> mrx+                                justr   -> ($ r) <$> justr+  justr -> justr  +firstJust :: [Maybe a] -> Maybe a+firstJust [] = Nothing+firstJust (Nothing:xs) = firstJust xs+firstJust (Just x :xs) = Just x++ litSingletonTail :: NonEmpty t -> x -> DPTrie p t x litSingletonTail (t:|[]) x = DMore t (Just x) [] litSingletonTail (t:|ts) x = DMore t Nothing  [litSingletonTail (NE.fromList ts) x]@@ -81,3 +101,19 @@ litExtrudeTail [] r = r litExtrudeTail (t:ts) r = DMore t Nothing [litExtrudeTail ts r] ++sort :: (Eq p, Eq t) => [DPTrie p t x] -> [DPTrie p t x]+sort = foldr insert []+  where+    insert :: (Eq p, Eq t) => DPTrie p t x -> [DPTrie p t x] -> [DPTrie p t x]+    insert r [] = [r]+    insert x@(DMore t _ _) (y@(DMore p _ _):rs)+      | t == p = x : rs+      | otherwise = x : y : rs+    insert x@(DMore t _ _) (y@(DPred p _ _ _):rs) =+        x : y : rs+    insert x@(DPred t _ _ _) (y@(DPred p _ _ _):rs)+      | t == p = x : rs -- basis+      | otherwise = x : y : rs+    insert x@(DPred t _ _ _) (y@(DMore p _ _):rs) =+        y : insert x rs

@@ -28,8 +28,8 @@   where     go :: (Eq t) => UPTrie t x -> [UPTrie t x] -> [UPTrie t x]     go a [] = [a]-    go a (b:bs) | NU.areDisjoint a b =          a : b : bs-                | otherwise          = (NU.merge a b) : bs+    go a (b:bs) | NU.areDisjoint a b =        a : b : bs+                | otherwise          = NU.merge a b : bs  lookup :: (Eq t) => [t] -> RUPTrie t x -> Maybe x lookup [] (Rooted mx _) = mx@@ -38,7 +38,7 @@ lookupNearestParent :: (Eq t) => [t] -> RUPTrie t x -> Maybe x lookupNearestParent [] (Rooted mx _) = mx lookupNearestParent ts (Rooted mx xs) =-  getFirst $ (First $ firstJust $ map (NU.lookupNearestParent $ NE.fromList ts) xs) <> (First mx)+  getFirst $ (First $ firstJust $ map (NU.lookupNearestParent $ NE.fromList ts) xs) <> First mx  firstJust :: [Maybe a] -> Maybe a firstJust [] = Nothing@@ -52,7 +52,7 @@  litExtrude :: [t] -> RUPTrie t x -> RUPTrie t x litExtrude [] r = r-litExtrude (t:[]) (Rooted mx xs) = Rooted Nothing [UMore t mx xs]+litExtrude [t] (Rooted mx xs) = Rooted Nothing [UMore t mx xs] litExtrude ts (Rooted mx xs) = Rooted Nothing [NU.litExtrudeTail (init ts) $                                                  UMore (last ts) mx xs                                               ]

@@ -14,7 +14,6 @@   ) where  import Prelude hiding (lookup)-import Data.List.NonEmpty hiding (map, sort) import Data.List.NonEmpty as NE hiding (map, sort)  @@ -48,10 +47,10 @@   areDisjoint :: (Eq t) => UPTrie t x -> UPTrie t x -> Bool-areDisjoint (UMore t _ _)    (UMore p _ _)    = not $ t == p-areDisjoint (UPred t _ _ _)  (UPred p _ _ _)  = not $ t == p-areDisjoint (UPred t _ _ _)  (UMore p _ _)    = not $ t == p-areDisjoint (UMore t _ _)    (UPred p _ _ _)  = not $ t == p+areDisjoint (UMore t _ _)    (UMore p _ _)    = t /= p+areDisjoint (UPred t _ _ _)  (UPred p _ _ _)  = t /= p+areDisjoint (UPred t _ _ _)  (UMore p _ _)    = t /= p+areDisjoint (UMore t _ _)    (UPred p _ _ _)  = t /= p   lookup :: Eq t => NonEmpty t -> UPTrie t x -> Maybe x@@ -64,7 +63,7 @@   p t >>=     \r -> case ts of       [] -> ($ r) <$> mrx-      _  -> ($ r) <$> (firstJust $ map (lookup $ NE.fromList ts) xrs)+      _  -> ($ r) <$> firstJust (map (lookup $ NE.fromList ts) xrs)   lookupNearestParent :: Eq t => NonEmpty t -> UPTrie t x -> Maybe x