TernaryTrees 0.2.0.0 → 0.2.0.2

raw patch · 5 files changed

+239/−131 lines, 5 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Data/Map/StringMap.hs +194/−77
• Data/Map/StringMap/Internal.hs +12/−0
• Data/Map/TernaryMap.hs +1/−1
• Data/Set/StringSet.hs +19/−50
• TernaryTrees.cabal +13/−3

@@ -1,107 +1,224 @@--module Data.Map.StringMap where+module Data.Map.StringMap (+                StringMap,+                insert,+                singleton,+                member,+                size,+                fromList,+                lookup,+                (!),+                findWithDefault,+                insertWith,+                insertWithKey,+                keys,+                assocs,+                elems,+                null+                ) where+import Data.Map.StringMap.Internal+import Data.Bits import Data.Binary import Control.Monad+import Control.Arrow (first)+import Prelude hiding (null,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 CharEl a b = C !Char | Val b-             deriving (Show)--- | StringMap a is ternary tree. It is commonly used for storing word lists--- like dictionaries for spell checking etc.-data StringMap a = SNode {-# UNPACK #-}!Char !(StringMap a) !(StringMap a) !(StringMap a)-                 | SElemNode a !(StringMap a) !(StringMap a) !(StringMap a)-                 | SEnd-               deriving (Show, Eq) +-- | Quickly build a tree without an initial tree. This should be used+-- to create an initial tree, using insert there after.+singleton :: String -> v -> StringMap v+singleton (x:xs) v = Node x End (singleton xs v) End+singleton []     v = Null v End --- | Inserts a new list of elements into a tree.-insert :: String -> a -> StringMap a -> StringMap a--- General case-insert xss@(x:xs) val (SNode ele l e h) =+-- | Inserts an entrie into a tree. Values with the same key will be replaced+-- with the newer value.+insert :: String -> v -> StringMap v -> StringMap v+insert xss@(_:_)  v End              = singleton xss v+insert xss@(_:_)  v (Null v' rest)   = Null v' $ insert xss v rest+insert []         v End              = Null v End+insert []         v (Node ele l e h) = Node ele (insert [] v l) e h+insert []         v (Null _ rest)    = Null v rest+insert xss@(x:xs) v (Node ele l e h) =     case compare x ele of-        LT -> SNode ele (insert xss val l) e h-        EQ -> SNode ele l (insert xs val e) h-        GT -> SNode ele l e (insert xss val h)-        --- Insert new elements quickly-insert xss@(x:xs) val SEnd =-    insert' xss val-    --- SEnd of word in non empty tree-insert [] val t@(SNode ele l e h) = -    case compare '\0' ele of-        EQ -> t-        LT  -> SNode ele (insert [] val l) e h-        --- SEnd of word in empty tree-insert [] val SEnd =-    SElemNode val SEnd SEnd SEnd+        LT -> Node ele (insert xss v l) e h+        EQ -> Node ele l (insert xs v e) h+        GT -> Node ele l e (insert xss v h) --- | Quickly build an initial tree.-insert' :: String -> a -> StringMap a-insert' (x:xs) a = SNode x SEnd (insert' xs a) SEnd-insert' []     a = SElemNode a SEnd SEnd SEnd --- | Returns true if the string is in the StringMap-isElem :: String -> StringMap a -> Bool-isElem          _ SEnd              = False-isElem         [] (SNode ele l e h) = ele == '\0' || isElem [] l-isElem xss@(x:xs) (SNode ele l e h) = +-- | Inserts a new value into the tree with a given function that combines the new value+-- and the old value together to for a new entry.+-- +-- > insertWith f key newval (fromList [(notkey,val1),(key,oldval)]) == fromList [(notkey,val1),(key,f newval oldval)]+insertWith ::(v -> v -> v) -> String -> v -> StringMap v -> StringMap v+insertWith _ xss@(_:_)  v End              = singleton xss v+insertWith f xss@(_:_)  v (Null v' rest)   = Null (f v v') $ insertWith f xss v rest+insertWith _ []         v End              = Null v End+insertWith f []         v (Node ele l e h) = Node ele (insertWith f [] v l) e h+insertWith _ []         v (Null _ rest)    = Null v rest+insertWith f xss@(x:xs) v (Node ele l e h) =     case compare x ele of-        LT -> isElem xss l-        EQ -> isElem  xs e-        GT -> isElem xss h+        LT -> Node ele (insertWith f xss v l) e h+        EQ -> Node ele l (insertWith f xs v e) h+        GT -> Node ele l e (insertWith f xss v h) --- | Returns the number of non-Null Elems-treeSize :: StringMap a -> Int-treeSize SEnd = 0-treeSize (SElemNode _ l e h) = treeSize l + treeSize e + treeSize h-treeSize (SNode _ l e h) = 1 + treeSize l + treeSize e + treeSize h +-- | Inserts a new value into the tree with a given function that combines the new value+-- and the old value together to for a new entry.+-- +-- > insertWithKey f key newval (fromList [(notkey,val1),(key,oldval)]) == fromList [(notkey,val1),(key,f key newval oldval)]+insertWithKey :: (String -> v -> v -> v) -> String -> v -> StringMap v -> StringMap v+insertWithKey f ks v m = insertWith (f ks) ks v m+-- | Returns true if the `String` is a key in the TernaryMap.+member :: String -> StringMap v -> Bool+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 :: String -> StringMap v -> Maybe v+lookup _ End                       = Nothing+lookup [] (Null v _)               = Just v+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++(!) :: StringMap v -> String -> Maybe v+(!) = flip lookup++findWithDefault :: v -> String -> StringMap v -> v+findWithDefault k _ End                       = k+findWithDefault _ [] (Null v _)               = v+findWithDefault k [] (Node _ l _ _)           = findWithDefault k [] l+findWithDefault k xs (Null _ rest)            = findWithDefault k xs rest+findWithDefault k xss@(x:xs) (Node ele l e h) =+    case compare x ele of+        LT -> findWithDefault k xss l+        EQ -> findWithDefault k  xs e+        GT -> findWithDefault k xss h++-- | Returns the number of non-Val Elems. not exported+treeSize :: StringMap v -> Int+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.-numEntries :: StringMap a -> Int-numEntries SEnd = 0-numEntries (SElemNode _ l e h) = 1 + numEntries l + numEntries e + numEntries h-numEntries (SNode _ l e h) = numEntries l + numEntries e + numEntries h+size :: StringMap v -> Int+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 :: [(String,a)] -> StringMap a-fromList = foldl (\t (k,v) -> insert k v t) SEnd+fromList :: [(String,v)] -> StringMap v+fromList = foldl (\tree (as,v) -> insert as v tree) empty +-- | An empty map.+empty :: StringMap v+empty = End -instance Binary a => Binary (StringMap a) where-    put SEnd = put (0 :: Word8)-    -- Quite common, so speecialised-    put (SNode ch SEnd SEnd SEnd) = do+-- | Makes a list of all the values in the map.+elems :: StringMap v -> [v]+elems  End           = []+elems (Node _ l e h) = elems l ++ (elems e ++ elems h)+elems (Null v rest)  = v : elems rest++-- | Returns a (sorted) list of all keys in the map.+keys :: StringMap v -> [String]+keys End              = []+keys (Null _ rest)    = []:keys rest+keys (Node ele l e g) = keys l ++ map (ele:) (keys e) ++ keys g+++-- | Returns a (sorted) list of all keys in the map.+assocs :: StringMap v -> [(String,v)]+assocs  End             = []+assocs (Null v rest)    = ([],v):assocs rest+assocs (Node ele l e g) = assocs l ++ map (first (ele:)) (assocs e) ++ assocs g++-- | Returns true if the map is empty.+null :: StringMap v -> Bool+null End = True+null _   = False++-- keySet :: StringMap v -> S.TernarySet a+-- 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 (StringMap) where+    fmap _ End = End+    fmap f (Null v rest)    = Null (f v) (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 Ends are efficiently.+instance Binary v => Binary (StringMap v) where+    put (Node ch End End End) = do+        putWord8 0+        put ch+    put (Node ch End End h) = do         putWord8 1         put ch-    -- Also common, basically what insert' produces.-    put (SNode ch SEnd e SEnd) = do+        put h+    put (Node ch End e End) = do         putWord8 2         put ch         put e-    -- General case-    put (SNode ch l e h) = do+    put (Node ch End e h) = do         putWord8 3         put ch+        put e+        put h+    put (Node ch l End End) = do+        putWord8 4+        put ch         put l+    put (Node ch l End h) = do+        putWord8 5+        put ch+        put l+        put h+    put (Node ch l e End) = do+        putWord8 6+        put ch+        put l         put e+    -- General case+    put (Node ch l e h) = do+        putWord8 7+        put ch+        put l+        put e         put h+    put (Null v End) = putWord8 8 >> put v+    put (Null v rest) = do+        putWord8 9+        put v+        put rest+    put End = putWord8 10+     get = do         tag <- getWord8         case tag of-            0 -> return SEnd-            1 -> do-                ch <- get-                return (SNode ch SEnd SEnd SEnd)-            2 -> do-                ch <- get-                e <- get-                return (SNode ch SEnd e SEnd)-            3 -> liftM4 SNode get get get get----+            _ | 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+            10 -> return End+            _ -> error ("Invalid data in binary stream. tag: " ++ show tag)

@@ -0,0 +1,12 @@+module Data.Map.StringMap.Internal where++-- | StringMap v is ternary tree. It is commonly used for storing word lists+-- like dictionaries.+data StringMap v = +                    -- | Nodes contain key elements only+                      Node {-# UNPACK #-}!Char !(StringMap v) !(StringMap v) !(StringMap v)+                    -- | Null nodes contain the value pointed to by the key list+                    | Null  v !(StringMap v)+                    -- | An empty tree+                    | End+               deriving (Show, Eq)

@@ -15,7 +15,7 @@                 elems,                 null                 ) where-import Data.Map.TernaryMap.Internal+import Data.Map.TernaryMap.Internal (TernaryMap(..)) import Data.Bits import Data.Binary import Control.Monad

@@ -7,6 +7,7 @@             fromList,             null,             elems,+            empty,             ) where import Data.Set.StringSet.Internal import Prelude hiding (null)@@ -15,7 +16,7 @@ import Control.Monad  --- | Inserts a new list of elements into a tree.+-- | Inserts a new 'String' element into a tree. insert :: String -> StringSet -> StringSet insert xss@(_:_)  End              = singleton xss insert xss@(_:_)  (Null rest)      = Null $ insert xss rest@@ -53,7 +54,7 @@ size (Null rest) = 1 + size rest size (Node _ l e h) = size l + size e + size h --- | Creates a new tree from a list of 'strings'+-- | Creates a new tree from a list of 'Strings' fromList :: [String] -> StringSet fromList = foldl (flip insert) empty @@ -77,59 +78,27 @@ -- | A rather long Binary instance, that uses binary numbers to indicate -- where Ends are efficiently. instance Binary StringSet where-    put (Node ch End End End) = do-        putWord8 0-        put ch-    put (Node ch End End h) = do-        putWord8 1-        put ch-        put h-    put (Node ch End e End) = do-        putWord8 2-        put ch-        put e-    put (Node ch End e h) = do-        putWord8 3-        put ch-        put e-        put h-    put (Node ch l End End) = do-        putWord8 4-        put ch-        put l-    put (Node ch l End h) = do-        putWord8 5-        put ch-        put l-        put h-    put (Node ch l e End) = do-        putWord8 6-        put ch-        put l-        put e-    -- General case-    put (Node ch l e h) = do-        putWord8 7-        put ch-        put l-        put e-        put h-    put (Null End) = putWord8 8-    put (Null rest) = do-        putWord8 9-        put rest+    put (Node ch End End End)   = putWord8 0 >> put ch+    put (Node ch End End h)     = putWord8 1 >> put ch >> put h+    put (Node ch End e End)     = putWord8 2 >> put ch >> put e+    put (Node ch End e h)       = putWord8 3 >> put ch >> put e >> put h+    put (Node ch l End End)     = putWord8 4 >> put ch >> put l+    put (Node ch l End h)       = putWord8 5 >> put ch >> put l >> put h+    put (Node ch l e End)       = putWord8 6 >> put ch >> put l >> put e+    put (Node ch l e h)         = putWord8 7 >> put ch >> put l >> put e >> put h+    put (Null End)              = putWord8 8+    put (Null rest)             = putWord8 9 >> put rest     put End = putWord8 10          get = do         tag <- getWord8         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)+            _ | 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 -> return (Null End)             9 -> liftM Null get             10 -> return End

@@ -1,5 +1,5 @@ Name:                   TernaryTrees-Version:                0.2.0.0+Version:                0.2.0.2 Category:               Data Structures Synopsis:               Efficient pure ternary tree Sets and Maps Description:            Ternary trees are an efficient structure often used for storing@@ -20,7 +20,7 @@ 			. 			New in this version: 			.-			* Added a StringMap type, which should be more efficient than using TernaryMap String a+			* Fixed Other-Modules cabal entry so Internal files were added. 			. 			&#169; 2009 by Alex Mason (<http://random.axman6.com/blog/>). BSD3 license. 			@@ -35,15 +35,25 @@         Data/Map/StringMap.hs         Data/Set/TernarySet.hs         Data/Set/StringSet.hs+        Data/Map/StringMap/Internal.hs         Data/Set/StringSet/Internal.hs         Data/Set/TernarySet/Internal.hs         Data/Map/TernaryMap/Internal.hs + Library         Build-Depends:                 base >= 4.0.0.0, base < 5.0.0.0, binary >= 0.5.0.0         Exposed-modules:-                Data.Set.TernarySet, Data.Set.StringSet, Data.Map.TernaryMap, Data.Map.StringMap+                Data.Set.TernarySet,+                Data.Set.StringSet,+                Data.Map.TernaryMap,+                Data.Map.StringMap+        Other-Modules:+                Data.Map.TernaryMap.Internal,+                Data.Set.TernarySet.Internal,+                Data.Set.StringSet.Internal,+                Data.Map.StringMap.Internal  Executable tdict   Main-Is:        Main.hs