packages feed

TernaryTrees 0.1.1.1 → 0.1.2.0

raw patch · 5 files changed

+88/−111 lines, 5 files

Files

Data/Map/TernaryMap.hs view
@@ -9,191 +9,163 @@ import Data.Bits import Data.Binary import Control.Monad-import qualified Data.Set.TernarySet as S import Prelude hiding (lookup)  --- | Elem2 a b is used to hold elements of a list after insertion, and--- indicate that we've reached the end of the list.-data Elem2 a b = C !a-               | Val b-             deriving (Show) -- | TernaryMap a b is ternary tree. It is commonly used for storing word lists -- like dictionaries.-data TernaryMap a b = TNode !(Elem2 a b) !(TernaryMap a b) !(TernaryMap a b) !(TernaryMap a b)-                    | TEnd+data TernaryMap a b = Node !a !(TernaryMap a b) !(TernaryMap a b) !(TernaryMap a b)+                    | Null b !(TernaryMap a b)+                    | End                deriving (Show, Eq) --instance Eq a => Eq (Elem2 a b) where-    (Val _) == (Val _) = True-    (Val _) == x        = False-    x        == (Val _) = False-    (C a)    == (C b)    = a == b---- | All elements are greater than the Val Elem, otherwise they are--- ordered according to their own ord instance (for the `compare (C x) (C y)` case).-instance (Ord a) => Ord (Elem2 a b) where-    compare (Val _) (Val _)   = EQ-    compare (Val _) x         = LT-    compare x        (Val _)  = GT-    compare (C x) (C y)       = compare x y--isVal (Val _) = True-isVal _       = False- -- | Quickly build a tree without an initial tree. This should be used -- to create an initial tree, using insert there after. singleton :: Ord a => [a] -> b -> TernaryMap a b-singleton (x:xs) b = TNode (C x) TEnd (singleton xs b) TEnd-singleton []     b = TNode (Val b) TEnd TEnd TEnd+singleton (x:xs) b = Node x End (singleton xs b) End+singleton []     b = Null b End  -- | Inserts an entrie into a tree. Values with the same key will be replaced -- with the newer value. insert :: Ord a => [a] -> b -> TernaryMap a b -> TernaryMap a b--- General case-insert xss@(x:xs) b (TNode ele l e h) =-    case compare (C x) ele of-        LT -> TNode ele (insert xss b l) e h-        EQ -> TNode ele l (insert xs b e) h-        GT -> TNode ele l e (insert xss b h)--- Insert new elements quickly-insert xss@(x:xs) b TEnd =-    singleton xss b--- end of word in non empty tree-insert [] b (TNode ele l e h) = -    case compare (Val b) ele of-        EQ -> TNode (Val b) l e h-        LT  -> TNode ele (insert [] b l) e h--- end of word in empty tree-insert [] b TEnd =-    TNode (Val b) TEnd TEnd TEnd+insert xss@(_:_)  b End              = singleton xss b+insert xss@(_:_)  b (Null b' rest)   = Null b' $ insert xss b rest+insert []         b End              = Null b End+insert []         b (Node ele l e h) = Node ele (insert [] b l) e h+insert []         b (Null _ rest)    = Null b rest+insert xss@(x:xs) b (Node ele l e h) =+    case compare x ele of+        LT -> Node ele (insert xss b l) e h+        EQ -> Node ele l (insert xs b e) h+        GT -> Node ele l e (insert xss b h)   -- | Returns true if the `[a]` is a key in the TernaryMap. member :: Ord a => [a] -> TernaryMap a b -> Bool-member          _ TEnd              = False-member         [] (TNode ele l e h) = isVal ele || member [] l-member xss@(x:xs) (TNode ele l e h) = -    case compare (C x) ele of+member         _   End             = False+member         [] (Null _ _)       = True+member         [] (Node _ l _ _)   = member [] l+member xss@(_:_)  (Null _ rest)    = member xss rest+member xss@(x:xs) (Node ele l e h) = +    case compare x ele of         LT -> member xss l         EQ -> member  xs e         GT -> member xss h + lookup :: Ord a => [a] -> TernaryMap a b -> Maybe b-lookup _ TEnd = Nothing-lookup [] (TNode (Val b) _ _ _) = Just b-lookup [] (TNode ele l _ _)     = lookup [] l-lookup xss@(x:xs) (TNode ele l e h) =-    case compare (C x) ele of+lookup _ End                       = Nothing+lookup [] (Null b _)               = Just b+lookup [] (Node _ l _ _)           = lookup [] l+lookup xs (Null _ rest)            = lookup xs rest+lookup xss@(x:xs) (Node ele l e h) =+    case compare x ele of         LT -> lookup xss l         EQ -> lookup  xs e         GT -> lookup xss h+ (!) :: Ord a => TernaryMap a b -> [a] -> Maybe b (!) = flip lookup  -- | Returns the number of non-Val Elems. not exported treeSize :: TernaryMap a b -> Int-treeSize TEnd = 0-treeSize (TNode (Val _) l e h) = treeSize l + treeSize e + treeSize h-treeSize (TNode _ l e h) = 1 + treeSize l + treeSize e + treeSize h+treeSize End = 0+treeSize (Node _ l e h) = 1 + treeSize l + treeSize e + treeSize h+treeSize (Null _ rest) = treeSize rest  -- | Counts how many entries there are in the tree. size :: TernaryMap a b -> Int-size TEnd = 0-size (TNode (Val _) l _ h) = 1 + size l + size h-size (TNode _ l e h) = size l + size e + size h+size End            = 0+size (Node _ l e h) = size l + size e + size h+size (Null _ rest)  = 1 + size rest  -- | Creates a new tree from a list of 'strings' fromList :: Ord a => [([a],b)] -> TernaryMap a b-fromList = foldl (\tree (as,b) -> insert as b tree) TEnd+fromList = foldl (\tree (as,b) -> insert as b tree) empty  -- | An empty map. empty :: TernaryMap a b-empty = TEnd+empty = End  -- | Makes a list of all the values in the map. elems :: TernaryMap a b -> [b]-elems (TEnd) = []-elems (TNode (Val v) l _ h) = elems l ++ (v : elems h)-elems (TNode _ l e h)       = elems l ++ (elems e ++ elems h)+elems  End           = []+elems (Node _ l e h) = elems l ++ (elems e ++ elems h)+elems (Null b rest)  = b : elems rest  -- | Returns true if the map is empty. null :: TernaryMap a b -> Bool-null TEnd = True-null _    = False+null End = True+null _   = False  -- keySet :: TernaryMap a b -> S.TernarySet a--- keySet TEnd = S.TEnd--- keySet (TNode (C x) l e h) = S.TNode (S.C x) (keySet l) (keySet e) (keySet h)--- keySet (TNode (Val _) l e h) = S.TNode (S.Null) (keySet l) (keySet e) (keySet h)+-- keySet End = S.End+-- keySet (Node (C x) l e h) = S.Node (S.C x) (keySet l) (keySet e) (keySet h)+-- keySet (Node (Val _) l e h) = S.Node (S.Null) (keySet l) (keySet e) (keySet h) -instance Functor (Elem2 a) where-    fmap _ (C x) = C x-    fmap f (Val b) = Val . f $ b  instance Functor (TernaryMap a) where-    fmap f (TNode ele l e h)     = TNode (fmap f ele) (fmap f l) (fmap f e) (fmap f h)-    fmap _ TEnd = TEnd--instance (Binary a, Binary b) => Binary (Elem2 a b) where-    put (C a) = putWord8 0 >> put a-    put (Val b) = putWord8 1 >> put b-    get = do-        n <- getWord8-        case n of-            0 -> liftM C get-            1 -> liftM Val get+    fmap _ End = End+    fmap f (Null b rest)    = Null (f b) (fmap f rest)+    fmap f (Node ele l e h) = Node ele (fmap f l) (fmap f e) (fmap f h)  -- | A rather long Binary instance, that uses binary numbers to indicate--- where TEnds are efficiently.+-- where Ends are efficiently. instance (Binary a, Binary b) => Binary (TernaryMap a b) where-    put (TNode ch TEnd TEnd TEnd) = do+    put (Node ch End End End) = do         putWord8 0         put ch-    put (TNode ch TEnd TEnd h) = do+    put (Node ch End End h) = do         putWord8 1         put ch         put h-    put (TNode ch TEnd e TEnd) = do+    put (Node ch End e End) = do         putWord8 2         put ch         put e-    put (TNode ch TEnd e h) = do+    put (Node ch End e h) = do         putWord8 3         put ch         put e         put h-    put (TNode ch l TEnd TEnd) = do+    put (Node ch l End End) = do         putWord8 4         put ch         put l-    put (TNode ch l TEnd h) = do+    put (Node ch l End h) = do         putWord8 5         put ch         put l         put h-    put (TNode ch l e TEnd) = do+    put (Node ch l e End) = do         putWord8 6         put ch         put l         put e     -- General case-    put (TNode ch l e h) = do+    put (Node ch l e h) = do         putWord8 7         put ch         put l         put e         put h-    put TEnd = putWord8 8+    put (Null b End) = putWord8 8 >> put b+    put (Null b rest) = do+        putWord8 9+        put b+        put rest+    put End = putWord8 10      get = do         tag <- getWord8-        if tag < 8-          then do-                ch <- get-                l <- if (tag `testBit` 2) then get else return TEnd-                e <- if (tag `testBit` 1) then get else return TEnd-                h <- if (tag `testBit` 0) then get else return TEnd-                return (TNode ch l e h)-          else return TEnd+        case tag of+            _ | tag < 8 ->+                do+                    ch <- get+                    l <- if (tag `testBit` 2) then get else return End+                    e <- if (tag `testBit` 1) then get else return End+                    h <- if (tag `testBit` 0) then get else return End+                    return (Node ch l e h)+            8 -> liftM (flip Null End) get+            9 -> liftM2 Null get get+            _ -> return End
Data/Set/StringSet.hs view
@@ -113,10 +113,11 @@         put l         put e         put h-    put End = putWord8 8+    put (Null End) = putWord8 8     put (Null rest) = do         putWord8 9         put rest+    put End = putWord8 10          get = do         tag <- getWord8@@ -128,6 +129,7 @@                     e <- if (tag `testBit` 1) then get else return End                     h <- if (tag `testBit` 0) then get else return End                     return (Node ch l e h)+            8 -> return (Null End)             9 -> liftM Null get             _ -> return End
Data/Set/TernarySet.hs view
@@ -153,10 +153,11 @@         put l         put e         put h-    put End = putWord8 8+    put (Null End) = putWord8 8     put (Null rest) = do         putWord8 9         put rest+    put End = putWord8 10          get = do         tag <- getWord8@@ -168,6 +169,7 @@                     e <- if (tag `testBit` 1) then get else return End                     h <- if (tag `testBit` 0) then get else return End                     return (Node ch l e h)+            8 -> return (Null End)             9 -> liftM Null get             _ -> return End
Main.hs view
@@ -3,6 +3,7 @@ import Data.Binary -- import Data.Set.TernarySet import Data.Set.StringSet+-- import Data.Set import System.IO import System.Environment @@ -30,8 +31,9 @@     putStr "done.\nRead in data matches original: "     print (tree == ntree) -- check the read in tree is the same as the one we wrote         -- -    -- putStrLn "\n-- Enter a word to see if it is in the dictionary (^C to exit):"-    -- interact' (("-- " ++) . show . (`isElem` tree)) -- enter a word to see if it's in the tree+    -- Comment out these lines for benchmarking.+    putStrLn "\n-- Enter a word to see if it is in the dictionary (^C to exit):"+    interact' ((++ "\n> ") . ("-- " ++) . show . (`member` tree)) -- enter a word to see if it's in the tree      interact' :: (String -> String) -> IO () interact' f = do
TernaryTrees.cabal view
@@ -1,5 +1,5 @@ Name:                   TernaryTrees-Version:                0.1.1.1+Version:                0.1.2.0 Category:               Data Structures Synopsis:               Efficient pure ternary tree Sets and Maps Description:            Ternary trees are an efficient structure often used for storing@@ -20,12 +20,11 @@ 			. 			New in this version: 			.-			* Refactored a lot of the datatypes for the Sets (much of their code is-			  exactly the same now)+			* Changed TernaryMap to match the Set implementations more. 			.-			* Made the get implementation shorter and clearer (thanks to olsner on IRC)+			* Changed the Data.Binary instance again, hopefully it'll remain more stable from here on. 			.-			* There is now a darcs repo: <http://random.axman6.com/darcs/TernaryTrees/>+			* Changed the tdict source to actually do what i said it would, by actually asking the user for input. 			. 			&#169; 2009 by Alex Mason (<http://random.axman6.com/blog/>). BSD3 license.