diff --git a/Data/Map/TernaryMap.hs b/Data/Map/TernaryMap.hs
--- a/Data/Map/TernaryMap.hs
+++ b/Data/Map/TernaryMap.hs
@@ -25,12 +25,12 @@
-- 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
+ compare (Val _) x = LT
+ compare x (Val _) = GT
+ compare (C x) (C y) = compare x y
isVal (Val _) = True
-isVal _ = False
+isVal _ = False
-- | Quickly build a tree without an initial tree. This should be used
-- to create an initial tree, using insert there after.
@@ -108,32 +108,75 @@
-- | This binary instance saves some space by making special cases
-- of some commonly encountered structures in the trees.
instance (Binary a, Binary b) => Binary (TernaryMap a b) where
- put TEnd = putWord8 0
- -- Quite common, so specialised
put (TNode ch TEnd TEnd TEnd) = do
+ putWord8 0
+ put ch
+ put (TNode ch TEnd TEnd h) = do
putWord8 1
put ch
- -- Also common, basically what insert' produces.
+ put h
put (TNode ch TEnd e TEnd) = do
putWord8 2
put ch
put e
+ put (TNode ch TEnd e h) = do
+ putWord8 3
+ put ch
+ put e
+ put h
+ put (TNode ch l TEnd TEnd) = do
+ putWord8 4
+ put ch
+ put l
+ put (TNode ch l TEnd h) = do
+ putWord8 5
+ put ch
+ put l
+ put h
+ put (TNode ch l e TEnd) = do
+ putWord8 6
+ put ch
+ put l
+ put e
-- General case
put (TNode ch l e h) = do
- putWord8 3
+ putWord8 7
put ch
put l
put e
put h
+ put TEnd = putWord8 8
get = do
tag <- getWord8
case tag of
- 0 -> return TEnd
- 1 -> do
- ch <- get
- return (TNode ch TEnd TEnd TEnd)
- 2 -> do
+ 8 -> return TEnd
+ _ -> do
ch <- get
- e <- get
- return (TNode ch TEnd e TEnd)
- 3 -> liftM4 TNode get get get get
+ case tag of
+ 0 -> return (TNode ch TEnd TEnd TEnd)
+ 1 -> do
+ h <- get
+ return (TNode ch TEnd TEnd h)
+ 2 -> do
+ e <- get
+ return (TNode ch TEnd e TEnd)
+ 3 -> do
+ e <- get
+ h <- get
+ return (TNode ch TEnd e h)
+ 4 -> do
+ l <- get
+ return (TNode ch l TEnd TEnd)
+ 5 -> do
+ l <- get
+ h <- get
+ return (TNode ch l TEnd h)
+ 6 -> do
+ l <- get
+ e <- get
+ return (TNode ch l e TEnd)
+ 7 -> do
+ l <- get
+ e <- get
+ h <- get
+ return (TNode ch l e h)
diff --git a/Data/Set/StringSet.hs b/Data/Set/StringSet.hs
--- a/Data/Set/StringSet.hs
+++ b/Data/Set/StringSet.hs
@@ -58,37 +58,84 @@
fromList :: [String] -> StringSet
fromList = foldl (flip insert) SEnd
-
+-- | A rather long Binary instance, but uses binary numbers to indicate
+-- where SEnds are efficiently.
instance Binary StringSet where
- put SEnd = put (0 :: Word8)
- -- Quite common, so speecialised
put (SNode ch SEnd SEnd SEnd) = do
+ putWord8 0
+ put ch
+ put (SNode ch SEnd SEnd h) = do
putWord8 1
put ch
- -- Also common, basically what insert' produces.
+ put h
put (SNode ch SEnd e SEnd) = do
putWord8 2
put ch
put e
+ put (SNode ch SEnd e h) = do
+ putWord8 3
+ put ch
+ put e
+ put h
+ put (SNode ch l SEnd SEnd) = do
+ putWord8 4
+ put ch
+ put l
+ put (SNode ch l SEnd h) = do
+ putWord8 5
+ put ch
+ put l
+ put h
+ put (SNode ch l e SEnd) = do
+ putWord8 6
+ put ch
+ put l
+ put e
-- General case
put (SNode ch l e h) = do
- putWord8 3
+ putWord8 7
put ch
put l
put e
put h
+ put SEnd = putWord8 8
get = do
tag <- getWord8
case tag of
- 0 -> return SEnd
- 1 -> do
- ch <- get
- return (SNode ch SEnd SEnd SEnd)
- 2 -> do
+ 8 -> return SEnd
+ _ -> do
ch <- get
- e <- get
- return (SNode ch SEnd e SEnd)
- 3 -> liftM4 SNode get get get get
+ -- [h,e,l] <- forM [0..2] $ \b -> if (tag `testBit` b) then get else return SEnd
+ -- return (SNode ch l e h)
+ case tag of
+ 0 -> return (SNode ch SEnd SEnd SEnd)
+ 1 -> do
+ h <- get
+ return (SNode ch SEnd SEnd h)
+ 2 -> do
+ e <- get
+ return (SNode ch SEnd e SEnd)
+ 3 -> do
+ e <- get
+ h <- get
+ return (SNode ch SEnd e h)
+ 4 -> do
+ l <- get
+ return (SNode ch l SEnd SEnd)
+ 5 -> do
+ l <- get
+ h <- get
+ return (SNode ch l SEnd h)
+ 6 -> do
+ l <- get
+ e <- get
+ return (SNode ch l e SEnd)
+ 7 -> do
+ l <- get
+ e <- get
+ h <- get
+ return (SNode ch l e h)
+
diff --git a/Data/Set/TernarySet.hs b/Data/Set/TernarySet.hs
--- a/Data/Set/TernarySet.hs
+++ b/Data/Set/TernarySet.hs
@@ -84,35 +84,113 @@
0 -> return Null
1 -> liftM C get
--- | This binary instance saves some space by making special cases
--- of some commonly encountered structures in the trees.
+-- | This binary uses the fact that the number of TEnds can be represented
+-- in binary numbers to save a lot of space.
instance Binary a => Binary (TernarySet a) where
- put TEnd = put (0 :: Word8)
- -- Quite common, so speecialised
put (TNode ch TEnd TEnd TEnd) = do
+ putWord8 0
+ put ch
+ put (TNode ch TEnd TEnd h) = do
putWord8 1
put ch
- -- Also common, basically what insert' produces.
+ put h
put (TNode ch TEnd e TEnd) = do
putWord8 2
put ch
put e
+ put (TNode ch TEnd e h) = do
+ putWord8 3
+ put ch
+ put e
+ put h
+ put (TNode ch l TEnd TEnd) = do
+ putWord8 4
+ put ch
+ put l
+ put (TNode ch l TEnd h) = do
+ putWord8 5
+ put ch
+ put l
+ put h
+ put (TNode ch l e TEnd) = do
+ putWord8 6
+ put ch
+ put l
+ put e
-- General case
put (TNode ch l e h) = do
- putWord8 3
+ putWord8 7
put ch
put l
put e
put h
+ put TEnd = putWord8 8
get = do
tag <- getWord8
case tag of
- 0 -> return TEnd
- 1 -> do
- ch <- get
- return (TNode ch TEnd TEnd TEnd)
- 2 -> do
+ 8 -> return TEnd
+ _ -> do
ch <- get
- e <- get
- return (TNode ch TEnd e TEnd)
- 3 -> liftM4 TNode get get get get
+ case tag of
+ 0 -> return (TNode ch TEnd TEnd TEnd)
+ 1 -> do
+ h <- get
+ return (TNode ch TEnd TEnd h)
+ 2 -> do
+ e <- get
+ return (TNode ch TEnd e TEnd)
+ 3 -> do
+ e <- get
+ h <- get
+ return (TNode ch TEnd e h)
+ 4 -> do
+ l <- get
+ return (TNode ch l TEnd TEnd)
+ 5 -> do
+ l <- get
+ h <- get
+ return (TNode ch l TEnd h)
+ 6 -> do
+ l <- get
+ e <- get
+ return (TNode ch l e TEnd)
+ 7 -> do
+ l <- get
+ e <- get
+ h <- get
+ return (TNode ch l e h)
+
+
+
+
+
+
+ -- put TEnd = put (0 :: Word8)
+ -- -- Quite common, so speecialised
+ -- put (TNode ch TEnd TEnd TEnd) = do
+ -- putWord8 1
+ -- put ch
+ -- -- Also common, basically what insert' produces.
+ -- put (TNode ch TEnd e TEnd) = do
+ -- putWord8 2
+ -- put ch
+ -- put e
+ -- -- General case
+ -- put (TNode ch l e h) = do
+ -- putWord8 3
+ -- put ch
+ -- put l
+ -- put e
+ -- put h
+ -- get = do
+ -- tag <- getWord8
+ -- case tag of
+ -- 0 -> return TEnd
+ -- 1 -> do
+ -- ch <- get
+ -- return (TNode ch TEnd TEnd TEnd)
+ -- 2 -> do
+ -- ch <- get
+ -- e <- get
+ -- return (TNode ch TEnd e TEnd)
+ -- 3 -> liftM4 TNode get get get get
diff --git a/Main.hs b/Main.hs
--- a/Main.hs
+++ b/Main.hs
@@ -29,10 +29,10 @@
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
- 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
-
interact' :: (String -> String) -> IO ()
interact' f = do
line <- getLine
diff --git a/TernaryTrees.cabal b/TernaryTrees.cabal
--- a/TernaryTrees.cabal
+++ b/TernaryTrees.cabal
@@ -1,5 +1,5 @@
Name: TernaryTrees
-Version: 0.0.3.0
+Version: 0.0.4.0
Category: Data Structures
Synopsis: Efficient pure ternary tree Sets and Maps
Description: Ternary trees are an efficient structure often used for storing
@@ -16,15 +16,15 @@
in the tree, writing them to a binary file, reading them back in
and checking the read in result is the same as the original takes
slightly over 3 seconds using the StringSet. The written file is
- also slightly smaller than the input (by about 10% for shuffled data,
- and 7% for in order data).
+ also slightly smaller than the input (by over 40% in some cases).
.
New in this version:
.
- * Added the all important getVal function to Data.Map.TernaryMap.
- * (Hopefully fixed this .cabal file again).
+ * Made the Data.Binary instances much more efficient by using
+ binary numbers to represent the number of *End nodes.
.
- © 2009 by Alex Mason (); BSD3 license.
+ .
+ © 2009 by Alex Mason (). BSD3 license.
License: BSD3
License-file: LICENSE.txt