pred-trie 0.0.5 → 0.0.6

raw patch · 5 files changed

+76/−18 lines, 5 files

Files

pred-trie.cabal +1/−1
src/Data/Trie/Pred/Disjoint.hs +14/−0
src/Data/Trie/Pred/Disjoint/Tail.hs +11/−3
src/Data/Trie/Pred/Unified.hs +13/−0
src/Data/Trie/Pred/Unified/Tail.hs +37/−14

pred-trie.cabal view

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

src/Data/Trie/Pred/Disjoint.hs view

@@ -30,3 +30,17 @@     getFirst [] = Nothing     getFirst (Nothing:xs) = getFirst xs     getFirst (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]+++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 ts (Rooted mx xs) = Rooted Nothing [ND.litExtrudeTail (init ts) $+                                                 DMore (last ts) mx xs+                                              ]+

src/Data/Trie/Pred/Disjoint/Tail.hs view

@@ -7,6 +7,9 @@   , lookup   , merge   , areDisjoint+  , litSingletonTail+  , litExtrudeTail+  , sort   ) where  import Prelude hiding (lookup)@@ -69,7 +72,12 @@ getFirst (Just x :xs) = Just x  -buildLitSingletonTail :: NonEmpty t -> x -> DPTrie p t x-buildLitSingletonTail (t:|[]) x = DMore t (Just x) []-buildLitSingletonTail (t:|ts) x = DMore t Nothing  [buildLitSingletonTail (NE.fromList ts) 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]+++litExtrudeTail :: [t] -> DPTrie p t x -> DPTrie p t x+litExtrudeTail [] r = r+litExtrudeTail (t:ts) r = DMore t Nothing [litExtrudeTail ts r]

src/Data/Trie/Pred/Unified.hs view

@@ -29,3 +29,16 @@     getFirst [] = Nothing     getFirst (Nothing:xs) = getFirst xs     getFirst (Just x :xs) = Just x+++litSingleton :: [t] -> x -> RUPTrie t x+litSingleton [] x = Rooted (Just x) []+litSingleton ts x = Rooted Nothing [NU.litSingletonTail (NE.fromList ts) x]+++litExtrude :: [t] -> RUPTrie t x -> RUPTrie t x+litExtrude [] r = r+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+                                              ]

src/Data/Trie/Pred/Unified/Tail.hs view

@@ -7,11 +7,14 @@   , lookup   , merge   , areDisjoint+  , litSingletonTail+  , litExtrudeTail+  , sort   ) where  import Prelude hiding (lookup)-import Data.List.NonEmpty hiding (map)-import Data.List.NonEmpty as NE hiding (map)+import Data.List.NonEmpty hiding (map, sort)+import Data.List.NonEmpty as NE hiding (map, sort)   @@ -30,21 +33,16 @@ -- | Overwrites when similar, leaves untouched when not merge :: (Eq t) => UPTrie t x -> UPTrie t x -> UPTrie t x merge xx@(UMore t mx xs) yy@(UMore p my ys)-  | t == p = UMore p my $ foldr go [] $ xs ++ ys+  | t == p = UMore p my $ sort $ xs ++ ys   | otherwise = xx-  where-    go :: (Eq t) => UPTrie t x -> [UPTrie t x] -> [UPTrie t x]-    go a [] = [a]-    go a (b:bs) | areDisjoint a b =       a : b : bs-                | otherwise       = (merge a b) : bs merge xx@(UPred t q mrx xrs) yy@(UPred p w mry yrs)-  | t == p = yy+  | t == p = yy -- predicate children are incompatible   | otherwise = xx merge xx@(UMore t mx xs) yy@(UPred p w mrx xrs)-  | t == p = yy -- predicate children are incompatible+  | t == p = yy -- rightward bias   | otherwise = xx merge xx@(UPred t q mrx xrs) yy@(UMore p my ys)-  | t == p = yy+  | t == p = yy -- rightward bias   | otherwise = xx  @@ -74,7 +72,32 @@ getFirst (Just x :xs) = Just x  -buildLitSingletonTail :: NonEmpty t -> x -> UPTrie t x-buildLitSingletonTail (t:|[]) x = UMore t (Just x) []-buildLitSingletonTail (t:|ts) x = UMore t Nothing  [buildLitSingletonTail (NE.fromList ts) x]+litSingletonTail :: NonEmpty t -> x -> UPTrie t x+litSingletonTail (t:|[]) x = UMore t (Just x) []+litSingletonTail (t:|ts) x = UMore t Nothing  [litSingletonTail (NE.fromList ts) x]+++litExtrudeTail :: [t] -> UPTrie t x -> UPTrie t x+litExtrudeTail [] r = r+litExtrudeTail (t:ts) r = UMore t Nothing [litExtrudeTail ts r]+++-- also does a non-deterministic merge - make sure your nodes are disjoint & clean+sort :: (Eq t) => [UPTrie t x] -> [UPTrie t x]+sort = foldr insert []+  where+    insert :: (Eq t) => UPTrie t x -> [UPTrie t x] -> [UPTrie t x]+    insert r [] = [r]+    insert x@(UMore t _ _) (y@(UMore p _ _):rs)+      | t == p = x : rs+      | otherwise = x : y : rs+    insert x@(UMore t _ _) (y@(UPred p _ _ _):rs)+      | t == p = x : rs+      | otherwise = x : y : rs+    insert x@(UPred t _ _ _) (y@(UPred p _ _ _):rs)+      | t == p = x : rs -- basis+      | otherwise = x : y : rs+    insert x@(UPred t _ _ _) (y@(UMore p _ _):rs)+      | t == p = insert x rs+      | otherwise = y : insert x rs