diff --git a/Data/Map/TernaryMap.hs b/Data/Map/TernaryMap.hs --- a/Data/Map/TernaryMap.hs +++ b/Data/Map/TernaryMap.hs @@ -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) + diff --git a/Data/Map/TernaryMap/Internal.hs b/Data/Map/TernaryMap/Internal.hs new file mode 100644 --- /dev/null +++ b/Data/Map/TernaryMap/Internal.hs @@ -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) diff --git a/Data/Set/StringSet.hs b/Data/Set/StringSet.hs --- a/Data/Set/StringSet.hs +++ b/Data/Set/StringSet.hs @@ -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) diff --git a/Data/Set/StringSet/Internal.hs b/Data/Set/StringSet/Internal.hs new file mode 100644 --- /dev/null +++ b/Data/Set/StringSet/Internal.hs @@ -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 diff --git a/Data/Set/TernarySet.hs b/Data/Set/TernarySet.hs --- a/Data/Set/TernarySet.hs +++ b/Data/Set/TernarySet.hs @@ -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) diff --git a/Data/Set/TernarySet/Internal.hs b/Data/Set/TernarySet/Internal.hs new file mode 100644 --- /dev/null +++ b/Data/Set/TernarySet/Internal.hs @@ -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 diff --git a/Main.hs b/Main.hs --- a/Main.hs +++ b/Main.hs @@ -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 diff --git a/TernaryTrees.cabal b/TernaryTrees.cabal --- a/TernaryTrees.cabal +++ b/TernaryTrees.cabal @@ -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)). . © 2009 by Alex Mason (). 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: