packages feed

pred-trie 0.0.2 → 0.0.3

raw patch · 7 files changed

+173/−197 lines, 7 files

Files

pred-trie.cabal view
@@ -1,5 +1,5 @@ Name:                   pred-trie-Version:                0.0.2+Version:                0.0.3 Author:                 Athan Clark <athan.clark@gmail.com> Maintainer:             Athan Clark <athan.clark@gmail.com> License:                BSD3@@ -14,8 +14,9 @@   HS-Source-Dirs:       src   GHC-Options:          -Wall   Exposed-Modules:      Data.Trie.Pred.Unified-                        Data.Trie.Pred.Unified.Fast-                        Data.Trie.Pred.Unified.Norm+                        Data.Trie.Pred.Unified.Tail+                        Data.Trie.Pred.Disjoint+                        Data.Trie.Pred.Disjoint.Tail   Build-Depends:        base >= 4 && < 5                       , semigroups
+ src/Data/Trie/Pred/Disjoint.hs view
@@ -0,0 +1,21 @@+module Data.Trie.Pred.Disjoint where++import Data.Trie.Pred.Disjoint.Tail+import qualified Data.Trie.Pred.Disjoint.Tail as ND+import Data.Monoid+++data RPDTrie p t x = Rooted (Maybe x) [NDPTrie p t x]++instance (Eq p, Eq t) => Monoid (RPDTrie p t x) where+  mempty = Rooted Nothing []+  mappend = Data.Trie.Pred.Disjoint.merge++merge :: (Eq p, Eq t) => RPDTrie p t x -> RPDTrie p t x -> RPDTrie p t x+merge (Rooted mx xs) (Rooted my ys) =+  Rooted my $ foldr go [] $ xs ++ ys+  where+    go :: (Eq p, Eq t) => NDPTrie p t x -> [NDPTrie p t x] -> [NDPTrie p t x]+    go a [] = [a]+    go a (b:bs) | ND.areDisjoint a b =          a : b : bs+                | otherwise          = (ND.merge a b) : bs
+ src/Data/Trie/Pred/Disjoint/Tail.hs view
@@ -0,0 +1,69 @@+{-# LANGUAGE+  GADTs+  #-}++module Data.Trie.Pred.Disjoint.Tail+  ( NDPTrie (..)+  , lookup+  , merge+  , areDisjoint+  ) where++import Prelude hiding (lookup)+import Data.List.NonEmpty hiding (map)+import Data.List.NonEmpty as NE hiding (map)++++data NDPTrie p t x where+  NDMore :: t+         -> Maybe x+         -> [NDPTrie p t x]+         -> NDPTrie p t x+  NDPred :: p+         -> (t -> Maybe r)+         -> Maybe (r -> x)+         -> [NDPTrie p t (r -> x)]+         -> NDPTrie p t x+++-- | Overwrites when similar, leaves untouched when not+merge :: (Eq p, Eq t) => NDPTrie p t x -> NDPTrie p t x -> NDPTrie p t x+merge xx@(NDMore t mx xs) yy@(NDMore p my ys)+  | t == p = NDMore p my $ foldr go [] $ xs ++ ys+  | otherwise = xx+  where+    go :: (Eq p, Eq t) => NDPTrie p t x -> [NDPTrie p t x] -> [NDPTrie p t x]+    go a [] = [a]+    go a (b:bs) | areDisjoint a b =       a : b : bs+                | otherwise       = (merge a b) : bs+merge xx@(NDPred t q mrx xrs) yy@(NDPred p w mry yrs)+  | t == p = yy+  | otherwise = xx+merge xx@(NDMore t mx xs) yy@(NDPred p w mrx xrs) = yy+merge xx@(NDPred t q mrx xrs) yy@(NDMore p my ys) = yy+++areDisjoint :: (Eq p, Eq t) => NDPTrie p t x -> NDPTrie p t x -> Bool+areDisjoint (NDMore t _ _)    (NDMore p _ _)    = t == p+areDisjoint (NDPred t _ _ _)  (NDPred p _ _ _)  = t == p+areDisjoint _ _ = True+++lookup :: Eq t => NonEmpty t -> NDPTrie p t x -> Maybe x+lookup (t:|ts) (NDMore t' mx xs)+  | t == t' = case ts of+    [] -> mx+    _  -> getFirst $ map (lookup $ NE.fromList ts) xs+  | otherwise = Nothing+lookup (t:|ts) (NDPred _ p mrx xrs) =+  p t >>=+    \r -> case ts of+      [] -> ($ r) <$> mrx+      _  -> ($ r) <$> (getFirst $ map (lookup $ NE.fromList ts) xrs)+++getFirst :: [Maybe a] -> Maybe a+getFirst [] = Nothing+getFirst (Nothing:xs) = getFirst xs+getFirst (Just x :xs) = Just x
src/Data/Trie/Pred/Unified.hs view
@@ -1,17 +1,17 @@ module Data.Trie.Pred.Unified where -import Data.Trie.Pred.Unified.Norm-import qualified Data.Trie.Pred.Unified.Norm as NU+import Data.Trie.Pred.Unified.Tail+import qualified Data.Trie.Pred.Unified.Tail as NU import Data.Monoid  -data RPTrie t x = Rooted (Maybe x) [NUPTrie t x]+data RPUTrie t x = Rooted (Maybe x) [NUPTrie t x] -instance (Eq t) => Monoid (RPTrie t x) where+instance (Eq t) => Monoid (RPUTrie t x) where   mempty = Rooted Nothing []   mappend = Data.Trie.Pred.Unified.merge -merge :: (Eq t) => RPTrie t x -> RPTrie t x -> RPTrie t x+merge :: (Eq t) => RPUTrie t x -> RPUTrie t x -> RPUTrie t x merge (Rooted mx xs) (Rooted my ys) =   Rooted my $ foldr go [] $ xs ++ ys   where
− src/Data/Trie/Pred/Unified/Fast.hs 
@@ -1,115 +0,0 @@-{-# LANGUAGE-  GADTs-  #-}--module Data.Trie.Pred.Unified.Fast-  ( FUPTrie (..)-  , lookup-  , merge-  , areDisjoint-  ) where--import Prelude hiding (lookup)-import Data.List.NonEmpty hiding (map)-import Data.List.NonEmpty as NE hiding (map)------ | A fast, unified, predicative trie. Singleton, leaf-ending--- branches have their own data constructor, predicate labels and literals--- have a unified type.-data FUPTrie t x where-  FURest :: NonEmpty t-         -> x-         -> FUPTrie t x-  FUMore :: t-         -> Maybe x-         -> NonEmpty (FUPTrie t x)-         -> FUPTrie t x-  FUPred :: t-         -> (t -> Maybe r)-         -> Maybe (r -> x)-         -> [FUPTrie t (r -> x)]-         -> FUPTrie t x----- | Overwrites when similar, leaves untouched when not-merge :: (Eq t) => FUPTrie t x -> FUPTrie t x -> FUPTrie t x-merge xx@(FURest tss@(t:|ts) x) yy@(FURest pss@(p:|ps) y)-  | tss == pss = yy-  | t == p     = let-                   xx' = FURest (NE.fromList ts) x-                   yy' = FURest (NE.fromList ps) y-                 in-                 FUMore p Nothing $-                   if areDisjoint xx' yy'-                     then NE.fromList [xx', yy']-                     else NE.fromList-                            [merge (FURest (NE.fromList ts) x) (FURest (NE.fromList ps) y)]-  | otherwise = xx-merge xx@(FUMore t mx xs) yy@(FUMore p my ys)-  | t == p = FUMore p my $ NE.fromList $ foldr go [] $ (NE.toList xs) ++ (NE.toList ys)-  | otherwise = xx-  where-    go :: (Eq t) => FUPTrie t x -> [FUPTrie t x] -> [FUPTrie t x]-    go a [] = [a]-    go a (b:bs) | areDisjoint a b =       a : b : bs-                | otherwise       = (merge a b) : bs-merge xx@(FUPred t q mrx xrs) yy@(FUPred p w mry yrs)-  | t == p = yy-  | otherwise = xx-merge xx@(FURest (t:|ts) x) yy@(FUMore p my ys)-  | t == p = case ts of-               [] -> FUMore p (Just x) ys-               _  -> FUMore p my $ fmap (merge $ FURest (NE.fromList ts) x) ys-  | otherwise = xx-merge xx@(FUMore t mx xs) yy@(FURest (p:|ps) y)-  | t == p = case ps of-               [] -> FUMore t (Just y) xs-               _  -> FUMore t mx $ fmap (flip merge $ FURest (NE.fromList ps) y) xs-  | otherwise = yy-merge xx@(FUMore t mx xs) yy@(FUPred p w mrx xrs)-  | t == p = yy -- predicate children are incompatible-  | otherwise = xx-merge xx@(FURest (t:|ts) x) yy@(FUPred p w mry yrs)-  | t == p = yy-  | otherwise = xx-merge xx@(FUPred t q mrx xrs) yy@(FUMore p my ys)-  | t == p = yy-  | otherwise = xx-merge xx@(FUPred t q mrx xrs) yy@(FURest (p:|ps) y)-  | t == p = yy-  | otherwise = xx---areDisjoint :: (Eq t) => FUPTrie t x -> FUPTrie t x -> Bool-areDisjoint (FURest (t:|_) _) (FURest (p:|_) _) = t == p-areDisjoint (FUMore t _ _)    (FUMore p _ _)    = t == p-areDisjoint (FURest (t:|_) _) (FUMore p _ _)    = t == p-areDisjoint (FUMore t _ _)    (FURest (p:|_) _) = t == p-areDisjoint (FUPred t _ _ _)  (FUPred p _ _ _)  = t == p-areDisjoint (FUPred t _ _ _)  (FUMore p _ _)    = t == p-areDisjoint (FUPred t _ _ _)  (FURest (p:|_) _) = t == p-areDisjoint (FUMore t _ _)    (FUPred p _ _ _)  = t == p-areDisjoint (FURest (t:|_) _) (FUPred p _ _ _)  = t == p---lookup :: Eq t => NonEmpty t -> FUPTrie t x -> Maybe x-lookup tss@(t:|ts) (FURest ps x) | tss == ps = Just x-                                 | otherwise = Nothing-lookup     (t:|ts) (FUMore t' mx xs) | t == t' =-  case ts of-    [] -> mx-    _  -> getFirst $ NE.toList $ fmap (lookup $ NE.fromList ts) xs-                                   | otherwise = Nothing-lookup     (t:|ts) (FUPred _ p mrx xrs) =-  p t >>=-    \r -> case ts of-      [] -> ($ r) <$> mrx-      _  -> ($ r) <$> (getFirst $ map (lookup $ NE.fromList ts) xrs)---getFirst :: [Maybe a] -> Maybe a-getFirst [] = Nothing-getFirst (Nothing:xs) = getFirst xs-getFirst (Just x :xs) = Just x
− src/Data/Trie/Pred/Unified/Norm.hs 
@@ -1,74 +0,0 @@-{-# LANGUAGE-  GADTs-  #-}--module Data.Trie.Pred.Unified.Norm-  ( NUPTrie (..)-  , lookup-  , merge-  , areDisjoint-  ) where--import Prelude hiding (lookup)-import Data.List.NonEmpty hiding (map)-import Data.List.NonEmpty as NE hiding (map)----data NUPTrie t x where-  NUMore :: t-         -> Maybe x-         -> [NUPTrie t x]-         -> NUPTrie t x-  NUPred :: t-         -> (t -> Maybe r)-         -> Maybe (r -> x)-         -> [NUPTrie t (r -> x)]-         -> NUPTrie t x----- | Overwrites when similar, leaves untouched when not-merge :: (Eq t) => NUPTrie t x -> NUPTrie t x -> NUPTrie t x-merge xx@(NUMore t mx xs) yy@(NUMore p my ys)-  | t == p = NUMore p my $ foldr go [] $ xs ++ ys-  | otherwise = xx-  where-    go :: (Eq t) => NUPTrie t x -> [NUPTrie t x] -> [NUPTrie t x]-    go a [] = [a]-    go a (b:bs) | areDisjoint a b =       a : b : bs-                | otherwise       = (merge a b) : bs-merge xx@(NUPred t q mrx xrs) yy@(NUPred p w mry yrs)-  | t == p = yy-  | otherwise = xx-merge xx@(NUMore t mx xs) yy@(NUPred p w mrx xrs)-  | t == p = yy -- predicate children are incompatible-  | otherwise = xx-merge xx@(NUPred t q mrx xrs) yy@(NUMore p my ys)-  | t == p = yy-  | otherwise = xx---areDisjoint :: (Eq t) => NUPTrie t x -> NUPTrie t x -> Bool-areDisjoint (NUMore t _ _)    (NUMore p _ _)    = t == p-areDisjoint (NUPred t _ _ _)  (NUPred p _ _ _)  = t == p-areDisjoint (NUPred t _ _ _)  (NUMore p _ _)    = t == p-areDisjoint (NUMore t _ _)    (NUPred p _ _ _)  = t == p---lookup :: Eq t => NonEmpty t -> NUPTrie t x -> Maybe x-lookup (t:|ts) (NUMore t' mx xs)-  | t == t' = case ts of-    [] -> mx-    _  -> getFirst $ map (lookup $ NE.fromList ts) xs-  | otherwise = Nothing-lookup (t:|ts) (NUPred _ p mrx xrs) =-  p t >>=-    \r -> case ts of-      [] -> ($ r) <$> mrx-      _  -> ($ r) <$> (getFirst $ map (lookup $ NE.fromList ts) xrs)---getFirst :: [Maybe a] -> Maybe a-getFirst [] = Nothing-getFirst (Nothing:xs) = getFirst xs-getFirst (Just x :xs) = Just x
+ src/Data/Trie/Pred/Unified/Tail.hs view
@@ -0,0 +1,74 @@+{-# LANGUAGE+  GADTs+  #-}++module Data.Trie.Pred.Unified.Tail+  ( NUPTrie (..)+  , lookup+  , merge+  , areDisjoint+  ) where++import Prelude hiding (lookup)+import Data.List.NonEmpty hiding (map)+import Data.List.NonEmpty as NE hiding (map)++++data NUPTrie t x where+  NUMore :: t+         -> Maybe x+         -> [NUPTrie t x]+         -> NUPTrie t x+  NUPred :: t+         -> (t -> Maybe r)+         -> Maybe (r -> x)+         -> [NUPTrie t (r -> x)]+         -> NUPTrie t x+++-- | Overwrites when similar, leaves untouched when not+merge :: (Eq t) => NUPTrie t x -> NUPTrie t x -> NUPTrie t x+merge xx@(NUMore t mx xs) yy@(NUMore p my ys)+  | t == p = NUMore p my $ foldr go [] $ xs ++ ys+  | otherwise = xx+  where+    go :: (Eq t) => NUPTrie t x -> [NUPTrie t x] -> [NUPTrie t x]+    go a [] = [a]+    go a (b:bs) | areDisjoint a b =       a : b : bs+                | otherwise       = (merge a b) : bs+merge xx@(NUPred t q mrx xrs) yy@(NUPred p w mry yrs)+  | t == p = yy+  | otherwise = xx+merge xx@(NUMore t mx xs) yy@(NUPred p w mrx xrs)+  | t == p = yy -- predicate children are incompatible+  | otherwise = xx+merge xx@(NUPred t q mrx xrs) yy@(NUMore p my ys)+  | t == p = yy+  | otherwise = xx+++areDisjoint :: (Eq t) => NUPTrie t x -> NUPTrie t x -> Bool+areDisjoint (NUMore t _ _)    (NUMore p _ _)    = t == p+areDisjoint (NUPred t _ _ _)  (NUPred p _ _ _)  = t == p+areDisjoint (NUPred t _ _ _)  (NUMore p _ _)    = t == p+areDisjoint (NUMore t _ _)    (NUPred p _ _ _)  = t == p+++lookup :: Eq t => NonEmpty t -> NUPTrie t x -> Maybe x+lookup (t:|ts) (NUMore t' mx xs)+  | t == t' = case ts of+    [] -> mx+    _  -> getFirst $ map (lookup $ NE.fromList ts) xs+  | otherwise = Nothing+lookup (t:|ts) (NUPred _ p mrx xrs) =+  p t >>=+    \r -> case ts of+      [] -> ($ r) <$> mrx+      _  -> ($ r) <$> (getFirst $ map (lookup $ NE.fromList ts) xrs)+++getFirst :: [Maybe a] -> Maybe a+getFirst [] = Nothing+getFirst (Nothing:xs) = getFirst xs+getFirst (Just x :xs) = Just x