pred-trie 0.0.12 → 0.1

raw patch · 5 files changed

+22/−207 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• pred-trie.cabal +1/−5
• src/Data/Trie/Pred/Hetero/Unified.hs +0/−59
• src/Data/Trie/Pred/Hetero/Unified/Tail.hs +0/−130
• src/Data/Trie/Pred/Unified.hs +3/−0
• src/Data/Trie/Pred/Unified/Tail.hs +18/−13

@@ -1,5 +1,5 @@ Name:                   pred-trie-Version:                0.0.12+Version:                0.1 Author:                 Athan Clark <athan.clark@gmail.com> Maintainer:             Athan Clark <athan.clark@gmail.com> License:                BSD3@@ -17,10 +17,6 @@                         Data.Trie.Pred.Unified.Tail                         Data.Trie.Pred.Disjoint                         Data.Trie.Pred.Disjoint.Tail-                        Data.Trie.Pred.Hetero.Unified-                        Data.Trie.Pred.Hetero.Unified.Tail-                       -- Data.Trie.Pred.Hetero.Disjoint-                       -- Data.Trie.Pred.Hetero.Disjoint.Tail   Build-Depends:        base >= 4.6 && < 5                       , semigroups 

@@ -1,59 +0,0 @@-module Data.Trie.Pred.Hetero.Unified-  ( RHUPTrie (..)-  , merge-  , lookup-  -- , lookupNearestParent-  , litSingleton-  , litExtrude-  , module Data.Trie.Pred.Hetero.Unified.Tail-  ) where--import Prelude hiding (lookup)-import Data.Trie.Pred.Hetero.Unified.Tail hiding (lookup, lookupNearestParent, merge)-import qualified Data.Trie.Pred.Hetero.Unified.Tail as NU-import Data.Monoid-import qualified Data.List.NonEmpty as NE-import Control.Applicative---data RHUPTrie t a b = Rooted { root :: Maybe a-                             , children :: [HUPTrie t a b] }--instance (Eq t) => Monoid (RHUPTrie t a b) where-  mempty = Rooted Nothing []-  mappend = Data.Trie.Pred.Hetero.Unified.merge--merge :: (Eq t) => RHUPTrie t a b -> RHUPTrie t a b -> RHUPTrie t a b-merge (Rooted mx xs) (Rooted my ys) =-  Rooted (getLast $ Last mx <> Last my) $ NU.sort $ foldr go [] $ xs ++ ys-  where-    go :: (Eq t) => HUPTrie t a b -> [HUPTrie t a b] -> [HUPTrie t a b]-    go a [] = [a]-    go a (b:bs) | NU.areDisjoint a b =        a : b : bs-                | otherwise          = NU.merge a b : bs--lookup :: (Eq t) => [t] -> RHUPTrie t a b -> Maybe (Either a b)-lookup [] (Rooted mx _) = Left <$> mx-lookup ts (Rooted _ xs) = firstJust $ map (NU.lookup $ NE.fromList ts) xs---- lookupNearestParent :: (Eq t) => [t] -> RHUPTrie t a b -> Maybe x--- lookupNearestParent [] (Rooted mx _) = mx--- lookupNearestParent ts (Rooted mx xs) =---   getFirst $ (First $ firstJust $ map (NU.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] -> a -> RHUPTrie t a b-litSingleton [] x = Rooted (Just x) []-litSingleton ts x = Rooted Nothing [NU.litSingletonTail (NE.fromList ts) x]---litExtrude :: [t] -> RHUPTrie t a b -> RHUPTrie t a b-litExtrude [] r = r-litExtrude [t] (Rooted mx xs) = Rooted Nothing [HUMore t mx xs]-litExtrude ts (Rooted mx xs) = Rooted Nothing [NU.litExtrudeTail (init ts) $-                                                 HUMore (last ts) mx xs-                                              ]

@@ -1,130 +0,0 @@-{-# LANGUAGE-  GADTs-  #-}--module Data.Trie.Pred.Hetero.Unified.Tail-  ( HUPTrie (..)-  , lookup-  --, lookupNearestParent-  , merge-  , areDisjoint-  , litSingletonTail-  , litExtrudeTail-  , sort-  ) where--import Prelude hiding (lookup)-import Data.List.NonEmpty as NE hiding (map, sort)-import Control.Applicative---data HUPTrie t a b where-  HUMore :: t-         -> Maybe a-         -> [HUPTrie t a b]-         -> HUPTrie t a b-  HUPred :: t-         -> (t -> Maybe r)-         -> Maybe (r -> b)-         -> [HUPTrie t (r -> a) (r -> b)]-         -> HUPTrie t a b----- | Overwrites when similar, leaves untouched when not-merge :: (Eq t) => HUPTrie t a b -> HUPTrie t a b -> HUPTrie t a b-merge xx@(HUMore t mx xs) yy@(HUMore p my ys)-  | t == p = HUMore p my $ sort $ xs ++ ys-  | otherwise = xx-merge xx@(HUPred t q mrx xrs) yy@(HUPred p w mry yrs)-  | t == p = yy -- predicate children are incompatible-  | otherwise = xx-merge xx@(HUMore t mx xs) yy@(HUPred p w mrx xrs)-  | t == p = yy -- rightward bias-  | otherwise = xx-merge xx@(HUPred t q mrx xrs) yy@(HUMore p my ys)-  | t == p = yy -- rightward bias-  | otherwise = xx---areDisjoint :: (Eq t) => HUPTrie t a b -> HUPTrie t a b -> Bool-areDisjoint (HUMore t _ _)    (HUMore p _ _)    = t /= p-areDisjoint (HUPred t _ _ _)  (HUPred p _ _ _)  = t /= p-areDisjoint (HUPred t _ _ _)  (HUMore p _ _)    = t /= p-areDisjoint (HUMore t _ _)    (HUPred p _ _ _)  = t /= p---lookup :: Eq t => NonEmpty t -> HUPTrie t a b -> Maybe (Either a b)-lookup (t:|ts) (HUMore t' mx xs)-  | t == t' = case ts of-    [] -> Left <$> mx-    _  -> firstJust $ map (lookup $ NE.fromList ts) xs-  | otherwise = Nothing-lookup (t:|ts) (HUPred _ p mrx xrs) =-  p t >>=-    \r -> case ts of-      [] -> Right <$> ($ r) <$> mrx-      _  -> case firstJust (map (lookup $ NE.fromList ts) xrs) of-              Nothing -> Nothing-              Just es -> Just $ appEither es r-  where-    appEither :: Either (r -> a) (r -> b) -> r -> Either a b-    appEither (Left f) r = Left $ f r-    appEither (Right g) r = Right $ g r----- lookupNearestParent :: Eq t => NonEmpty t -> UPTrie t x -> Maybe x--- lookupNearestParent tss@(t:|ts) trie@(UMore 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@(UPred 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 -> a -> HUPTrie t a b-litSingletonTail (t:|[]) x = HUMore t (Just x) []-litSingletonTail (t:|ts) x = HUMore t Nothing  [litSingletonTail (NE.fromList ts) x]---litExtrudeTail :: [t] -> HUPTrie t a b -> HUPTrie t a b-litExtrudeTail [] r = r-litExtrudeTail (t:ts) r = HUMore t Nothing [litExtrudeTail ts r]----- also does a non-deterministic merge - make sure your nodes are disjoint & clean-sort :: (Eq t) => [HUPTrie t a b] -> [HUPTrie t a b]-sort = foldr insert []-  where-    insert :: (Eq t) => HUPTrie t a b -> [HUPTrie t a b] -> [HUPTrie t a b]-    insert r [] = [r]-    insert x@(HUMore t _ _) (y@(HUMore p _ _):rs)-      | t == p = x : rs-      | otherwise = x : y : rs-    insert x@(HUMore t _ _) (y@(HUPred p _ _ _):rs)-      | t == p = x : rs-      | otherwise = x : y : rs-    insert x@(HUPred t _ _ _) (y@(HUPred p _ _ _):rs)-      | t == p = x : rs -- basis-      | otherwise = x : y : rs-    insert x@(HUPred t _ _ _) (y@(HUMore p _ _):rs)-      | t == p = insert x rs-      | otherwise = y : insert x rs-

@@ -30,6 +30,9 @@   mempty = Rooted Nothing []   mappend = Data.Trie.Pred.Unified.merge +instance (Show t) => Show (RUPTrie t x) where+  show = showTrie+ assignLit :: Eq t => [t] -> Maybe x -> RUPTrie t x -> RUPTrie t x assignLit [] mx (Rooted my ys) = Rooted mx ys assignLit ts mx (Rooted my ys) = Rooted my $

@@ -36,6 +36,11 @@ showTail (UMore t mx xs) = "(UMore " ++ show t ++ ") [" ++ concatMap showTail xs ++ "] " showTail (UPred t p mx xs) = "(UPred " ++ show t ++ ") [" ++ concatMap showTail xs ++ "] " +-- | Ignores contents+instance (Show t) => Show (UPTrie t x) where+  show = showTail++-- | Assigns a value to literal constructors assignLit :: (Eq t) => NonEmpty t -> Maybe x -> UPTrie t x -> UPTrie t x assignLit (t:|ts) mx yy@(UMore p my ys)   | t == p = case ts of@@ -83,20 +88,20 @@ lookupNearestParent :: Eq t => NonEmpty t -> UPTrie t x -> Maybe x lookupNearestParent tss@(t:|ts) trie@(UMore 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+    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@(UPred 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+    \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  @@ -106,12 +111,12 @@ firstJust (Nothing:xs) = firstJust xs firstJust (Just x :xs) = Just x -+-- | Create a singleton trie out of literal constructors 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] -+-- | Push a trie down with literal constructors litExtrudeTail :: [t] -> UPTrie t x -> UPTrie t x litExtrudeTail [] r = r litExtrudeTail (t:ts) r = UMore t Nothing [litExtrudeTail ts r]