packages feed

TernaryTrees 0.1.2.0 → 0.1.3.0

raw patch · 8 files changed

+191/−113 lines, 8 files

Files

Data/Map/TernaryMap.hs view
@@ -4,44 +4,72 @@                 singleton,                 member,                 size,-                +                fromList,+                lookup,+                (!),+                findWithDefault,+                insertWith,+                insertWithKey,+                keys,+                assocs,+                elems,+                null                 ) where+import Data.Map.TernaryMap.Internal import Data.Bits import Data.Binary import Control.Monad-import Prelude hiding (lookup)+import Control.Arrow (first)+import Prelude hiding (null,lookup)  --- | TernaryMap a b is ternary tree. It is commonly used for storing word lists--- like dictionaries.-data TernaryMap a b = Node !a !(TernaryMap a b) !(TernaryMap a b) !(TernaryMap a b)-                    | Null b !(TernaryMap a b)-                    | End-               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 :: Ord a => [a] -> b -> TernaryMap a b-singleton (x:xs) b = Node x End (singleton xs b) End-singleton []     b = Null b End+singleton :: Ord k => [k] -> v -> TernaryMap k v+singleton (x:xs) v = Node x End (singleton xs v) End+singleton []     v = Null v 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-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) =+insert :: Ord k => [k] -> v -> TernaryMap k v -> TernaryMap k 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 -> 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)+        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)  --- | Returns true if the `[a]` is a key in the TernaryMap.-member :: Ord a => [a] -> TernaryMap a b -> Bool+-- | 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 :: Ord k => (v -> v -> v) -> [k] -> v -> TernaryMap k v -> TernaryMap k 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 -> 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)+++-- | 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 :: Ord k => ([k] -> v -> v -> v) -> [k] -> v -> TernaryMap k v -> TernaryMap k v+insertWithKey f ks v m = insertWith (f ks) ks v m+-- | Returns true if the `[k]` is a key in the TernaryMap.+member :: Ord k => [k] -> TernaryMap k v -> Bool member         _   End             = False member         [] (Null _ _)       = True member         [] (Node _ l _ _)   = member [] l@@ -53,9 +81,9 @@         GT -> member xss h  -lookup :: Ord a => [a] -> TernaryMap a b -> Maybe b+lookup :: Ord k => [k] -> TernaryMap k v -> Maybe v lookup _ End                       = Nothing-lookup [] (Null b _)               = Just b+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) =@@ -64,54 +92,78 @@         EQ -> lookup  xs e         GT -> lookup xss h -(!) :: Ord a => TernaryMap a b -> [a] -> Maybe b+(!) :: Ord k => TernaryMap k v -> [k] -> Maybe v (!) = flip lookup +findWithDefault :: Ord k => v -> [k] -> TernaryMap k 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 :: TernaryMap a b -> Int+treeSize :: TernaryMap k 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.-size :: TernaryMap a b -> Int+size :: TernaryMap k 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 :: Ord a => [([a],b)] -> TernaryMap a b-fromList = foldl (\tree (as,b) -> insert as b tree) empty+fromList :: Ord k => [([k],v)] -> TernaryMap k v+fromList = foldl (\tree (as,v) -> insert as v tree) empty  -- | An empty map.-empty :: TernaryMap a b+empty :: TernaryMap k v empty = End  -- | Makes a list of all the values in the map.-elems :: TernaryMap a b -> [b]+elems :: TernaryMap k v -> [v] elems  End           = [] elems (Node _ l e h) = elems l ++ (elems e ++ elems h)-elems (Null b rest)  = b : elems rest+elems (Null v rest)  = v : elems rest +-- | Returns a (sorted) list of all keys in the map.+keys :: TernaryMap k v -> [[k]]+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 :: TernaryMap k v -> [([k],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 :: TernaryMap a b -> Bool+null :: TernaryMap k v -> Bool null End = True null _   = False --- keySet :: TernaryMap a b -> S.TernarySet a+-- keySet :: TernaryMap k 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 (TernaryMap a) where+instance Functor (TernaryMap k) where     fmap _ End = End-    fmap f (Null b rest)    = Null (f b) (fmap f rest)+    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 a, Binary b) => Binary (TernaryMap a b) where+instance (Binary k, Binary v) => Binary (TernaryMap k v) where     put (Node ch End End End) = do         putWord8 0         put ch@@ -149,10 +201,10 @@         put l         put e         put h-    put (Null b End) = putWord8 8 >> put b-    put (Null b rest) = do+    put (Null v End) = putWord8 8 >> put v+    put (Null v rest) = do         putWord8 9-        put b+        put v         put rest     put End = putWord8 10 @@ -162,10 +214,12 @@             _ | 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+                    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+            10 -> return End+            _ -> error ("Invalid data in binary stream. tag: " ++ show tag) +
+ Data/Map/TernaryMap/Internal.hs view
@@ -0,0 +1,8 @@+module Data.Map.TernaryMap.Internal where++-- | TernaryMap k v is ternary tree. It is commonly used for storing word lists+-- like dictionaries.+data TernaryMap k v = Node !k !(TernaryMap k v) !(TernaryMap k v) !(TernaryMap k v)+                    | Null  v !(TernaryMap k v)+                    | End+               deriving (Show, Eq)
Data/Set/StringSet.hs view
@@ -4,18 +4,16 @@             singleton,             member,             size,-            fromList+            fromList,+            null,+            elems,             ) where+import Data.Set.StringSet.Internal+import Prelude hiding (null) import Data.Bits import Data.Binary import Control.Monad --- | StringSet is ternary tree. It is commonly used for storing word lists--- like dictionaries for spell checking etc.-data StringSet = Node {-# UNPACK #-} !Char !StringSet !StringSet !StringSet -- | Tree node -               | Null !StringSet -- | null nodes can only have a greater than branch by definition-               | End -- | a branch that doesn’t contain anything-               deriving (Show, Eq)  -- | Inserts a new list of elements into a tree. insert :: String -> StringSet -> StringSet@@ -48,11 +46,6 @@         EQ -> member  xs e         GT -> member xss h --- | Returns the number of non-Null Elems-treeSize :: StringSet -> Int-treeSize End = 0-treeSize (Null rest) = treeSize rest-treeSize (Node _ l e h) = 1 + treeSize l + treeSize e + treeSize h  -- | Counts how many entries there are in the tree. size :: StringSet -> Int@@ -64,6 +57,14 @@ fromList :: [String] -> StringSet fromList = foldl (flip insert) empty +-- | Returns a (sorted) list of all strings inserted into the set.+-- +-- > (elems . fromList) xs == (nub . sort) xs+elems :: StringSet -> [String]+elems End = []+elems (Null rest) = []:elems rest+elems (Node ele l e g) = elems l ++ (map (ele:) (elems e) ++ elems g)+ -- | An empty set. empty :: StringSet empty = End@@ -125,12 +126,13 @@             _ | 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+                    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-            _ -> return End+            10 -> return End+            _ -> error ("Invalid data in binary stream. tag: " ++ show tag)
+ Data/Set/StringSet/Internal.hs view
@@ -0,0 +1,21 @@+module Data.Set.StringSet.Internal where+import Data.Ratio++-- | StringSet is ternary tree. It is commonly used for storing word lists+-- like dictionaries for spell checking etc.+data StringSet = Node {-# UNPACK #-} !Char !StringSet !StringSet !StringSet -- | Tree node +               | Null !StringSet -- | null nodes can only have a greater than branch by definition+               | End -- | a branch that doesn’t contain anything+               deriving (Show, Eq)+++-- | Returns the number of non-Null Elems+treeSize :: StringSet -> Int+treeSize End = 0+treeSize (Null rest) = treeSize rest+treeSize (Node _ l e h) = 1 + treeSize l + treeSize e + treeSize h++-- -- | A rough comparison of how much space is being used compared to+-- -- the strings as a single string+-- compRatio :: StringSet -> Ratio Int+-- compRatio s = treeSize s % length . concat . elems $ s
Data/Set/TernarySet.hs view
@@ -4,33 +4,18 @@                 singleton,                 member,                 size,-                fromList+                fromList,+                null,+                elems,+                                 ) where+import Prelude hiding (null) import Data.Bits import Data.Binary import Control.Monad+import Data.Set.TernarySet.Internal  --- | Elem a is used to hold elements of a list after insertion, and--- indicate that we've reached the end of the list.--- data Elem a = C !a---             | Null---              deriving (Show, Eq)--- | TernarySet a is ternary tree. It is commonly used for storing word lists--- like dictionaries.-data TernarySet a = Node !a !(TernarySet a) !(TernarySet a) !(TernarySet a)-                  | Null !(TernarySet a)-                  | End-               deriving (Show, Eq)---- | All elements are greater than the Null Elem, otherwise they are--- ordered according to their own ord instance (for the `compare (C x) (C y)` case).--- instance Ord a => Ord (Elem a) where---     compare Null Null   = EQ---     compare Null x      = LT---     compare x    Null   = GT---     compare (C x) (C y) = compare x y- -- | 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] -> TernarySet a@@ -51,21 +36,6 @@         GT -> Node ele l e (insert xss h)  --- -- General case--- insert xss@(x:xs) (Node ele l e h) =---     case compare x ele of---         LT -> Node ele (insert xss l) e h---         EQ -> Node ele l (insert xs e) h---         GT -> Node ele l e (insert xss h)--- -- Insert new elements quickly--- insert xss@(_:_) End         = singleton xss--- -- End of word in non empty tree--- insert [] t@(Null rest)      = t--- insert [] t@(Node ele l e h) = Node ele (insert [] l) e h--- -- End of word in empty tree--- insert [] End                = Null End-- -- | Returns true if the `[a]` is in the TernarySet member :: Ord a => [a] -> TernarySet a -> Bool member         _   End             = False@@ -78,11 +48,6 @@         EQ -> member  xs e         GT -> member xss h --- | Returns the number of non-Null Elems. not exported-treeSize :: TernarySet a -> Int-treeSize End = 0-treeSize (Null rest) = treeSize rest-treeSize (Node _ l e h) = 1 + treeSize l + treeSize e + treeSize h  -- | Counts how many entries there are in the tree. size :: TernarySet a -> Int@@ -94,6 +59,12 @@ fromList :: Ord a => [[a]] -> TernarySet a fromList = foldl (flip insert) empty +-- | Returns a (sorted) list of all elements inserted into the set.+elems :: TernarySet a -> [[a]]+elems End = []+elems (Null rest) = []:elems rest+elems (Node ele l e g) = elems l ++ (map (ele:) (elems e) ++ elems g)+ -- | An empty set. empty :: TernarySet a  empty = End@@ -165,11 +136,12 @@             _ | 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+                    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-            _ -> return End+            10 -> return End+            _ -> error ("Invalid data in binary stream. tag: " ++ show tag)
+ Data/Set/TernarySet/Internal.hs view
@@ -0,0 +1,14 @@+module Data.Set.TernarySet.Internal where++-- | TernarySet a is ternary tree. It is commonly used for storing word lists+-- like dictionaries.+data TernarySet a = Node !a !(TernarySet a) !(TernarySet a) !(TernarySet a)+                  | Null !(TernarySet a)+                  | End+               deriving (Show, Eq)++-- | Returns the number of non-Null Elems.+treeSize :: TernarySet a -> Int+treeSize End = 0+treeSize (Null rest) = treeSize rest+treeSize (Node _ l e h) = 1 + treeSize l + treeSize e + treeSize h
Main.hs view
@@ -1,8 +1,12 @@ module Main where      import Data.Binary--- import Data.Set.TernarySet-import Data.Set.StringSet+import Data.Set.TernarySet+-- These imports are here for testing mainly+-- import Data.Set.StringSet+-- import Data.Map.TernaryMap+-- import qualified Data.Set.StringSet+-- import qualified Data.Map.TernaryMap -- import Data.Set import System.IO import System.Environment
TernaryTrees.cabal view
@@ -1,5 +1,5 @@ Name:                   TernaryTrees-Version:                0.1.2.0+Version:                0.1.3.0 Category:               Data Structures Synopsis:               Efficient pure ternary tree Sets and Maps Description:            Ternary trees are an efficient structure often used for storing@@ -20,11 +20,11 @@ 			. 			New in this version: 			.-			* Changed TernaryMap to match the Set implementations more.-			.-			* Changed the Data.Binary instance again, hopefully it'll remain more stable from here on.+			* Moved datatype definitions into .Internal modules so that+			  testing can be performed, without needing to export their definitions in the+			  main modules. 			.-			* Changed the tdict source to actually do what i said it would, by actually asking the user for input.+			* Checked a lot of the source with HLint 1.6 and made some minor changes based on that ((mostly redundant brackets)). 			. 			&#169; 2009 by Alex Mason (<http://random.axman6.com/blog/>). BSD3 license. 			@@ -38,6 +38,9 @@         Data/Map/TernaryMap.hs         Data/Set/TernarySet.hs         Data/Set/StringSet.hs+	Data/Set/StringSet/Internal.hs+	Data/Set/TernarySet/Internal.hs+	Data/Map/TernaryMap/Internal.hs  Library         Build-Depends: