diff --git a/Data/Set/StringSet.hs b/Data/Set/StringSet.hs new file mode 100644 --- /dev/null +++ b/Data/Set/StringSet.hs @@ -0,0 +1,95 @@ +module Data.Set.StringSet where +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 = SNode !Char !StringSet !StringSet !StringSet | SEnd + deriving (Show, Eq) + +-- | Inserts a new list of elements into a tree. +insert :: String -> StringSet -> StringSet +-- General case +insert xss@(x:xs) (SNode ele l e h) = + case compare x ele of + LT -> SNode ele (insert xss l) e h + EQ -> SNode ele l (insert xs e) h + GT -> SNode ele l e (insert xss h) +-- Insert new elements quickly +insert xss@(x:xs) SEnd = + insert' xss +-- SEnd of word in non empty tree +insert [] t@(SNode ele l e h) = + case compare '\0' ele of + EQ -> t + LT -> SNode ele (insert [] l) e h +-- SEnd of word in empty tree +insert [] SEnd = + SNode '\0' SEnd SEnd SEnd + +-- | Quickly build an initial tree. +insert' :: String -> StringSet +insert' (x:xs) = SNode x SEnd (insert' xs) SEnd +insert' [] = SNode '\0' SEnd SEnd SEnd + +-- | Returns true if the string is in the StringSet +isElem :: String -> StringSet -> Bool +isElem _ SEnd = False +isElem [] (SNode ele l e h) = ele == '\0' || isElem [] l +isElem xss@(x:xs) (SNode ele l e h) = + case compare x ele of + LT -> isElem xss l + EQ -> isElem xs e + GT -> isElem xss h + +-- | Returns the number of non-Null Elems +treeSize :: StringSet -> Int +treeSize SEnd = 0 +treeSize (SNode '\0' l e h) = treeSize l + treeSize e + treeSize h +treeSize (SNode _ l e h) = 1 + treeSize l + treeSize e + treeSize h + +-- | Counts how many entries there are in the tree. +numEntries :: StringSet -> Int +numEntries SEnd = 0 +numEntries (SNode '\0' l e h) = 1 + numEntries l + numEntries e + numEntries h +numEntries (SNode _ l e h) = numEntries l + numEntries e + numEntries h + +-- | Creates a new tree from a list of 'strings' +fromList :: [String] -> StringSet +fromList = foldl (flip insert) SEnd + + +instance Binary StringSet where + put SEnd = put (0 :: Word8) + -- Quite common, so speecialised + put (SNode ch SEnd SEnd SEnd) = do + putWord8 1 + put ch + -- Also common, basically what insert' produces. + put (SNode ch SEnd e SEnd) = do + putWord8 2 + put ch + put e + -- General case + put (SNode ch l e h) = do + putWord8 3 + put ch + put l + put e + put h + 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 + + + + diff --git a/Data/Set/TernarySet.hs b/Data/Set/TernarySet.hs new file mode 100644 --- /dev/null +++ b/Data/Set/TernarySet.hs @@ -0,0 +1,116 @@ +module Data.Set.TernarySet where +import Data.Binary +import Control.Monad + + +-- | 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 = TNode !(Elem a) !(TernarySet a) !(TernarySet a) !(TernarySet a) | TEnd + 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. +insert' :: [a] -> TernarySet a +insert' (x:xs) = TNode (C x) TEnd (insert' xs) TEnd +insert' [] = TNode Null TEnd TEnd TEnd + +-- | Inserts an entries into a tree. +insert :: Ord a => [a] -> TernarySet a -> TernarySet a +-- General case +insert xss@(x:xs) (TNode ele l e h) = + case compare (C x) ele of + LT -> TNode ele (insert xss l) e h + EQ -> TNode ele l (insert xs e) h + GT -> TNode ele l e (insert xss h) +-- Insert new elements quickly +insert xss@(x:xs) TEnd = + insert' xss +-- TEnd of word in non empty tree +insert [] t@(TNode ele l e h) = + case compare Null ele of + EQ -> t + LT -> TNode ele (insert [] l) e h +-- TEnd of word in empty tree +insert [] TEnd = + TNode Null TEnd TEnd TEnd + + +-- | Returns true if the `[a]` is in the TernarySet +isElem :: Ord a => [a] -> TernarySet a -> Bool +isElem _ TEnd = False +isElem [] (TNode ele l e h) = ele == Null || isElem [] l +isElem xss@(x:xs) (TNode ele l e h) = + case compare (C x) ele of + LT -> isElem xss l + EQ -> isElem xs e + GT -> isElem xss h + +-- | Returns the number of non-Null Elems +treeSize :: TernarySet a -> Int +treeSize TEnd = 0 +treeSize (TNode Null l e h) = treeSize l + treeSize e + treeSize h +treeSize (TNode _ l e h) = 1 + treeSize l + treeSize e + treeSize h + +-- | Counts how many entries there are in the tree. +numEntries :: TernarySet a -> Int +numEntries TEnd = 0 +numEntries (TNode Null l e h) = 1 + numEntries l + numEntries e + numEntries h +numEntries (TNode _ l e h) = numEntries l + numEntries e + numEntries h + +-- | Creates a new tree from a list of 'strings' +fromList :: Ord a => [[a]] -> TernarySet a +fromList = foldl (flip insert) TEnd + +instance Binary a => Binary (Elem a) where + put Null = putWord8 0 + put (C x) = putWord8 1 >> put x + get = do + n <- getWord8 + case n of + 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. +instance Binary a => Binary (TernarySet a) where + 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/LICENSE.txt b/LICENSE.txt new file mode 100644 --- /dev/null +++ b/LICENSE.txt @@ -0,0 +1,23 @@ +Copyright (c)© 2009, Alex Mason +All rights reserved. + +Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, this list of + conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright notice, this list + of conditions and the following disclaimer in the documentation and/or other materials + provided with the distribution. + * Neither the name of the Alex Mason nor the names of its contributors may be used to + endorse or promote products derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY +EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL +THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT +OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR +TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE diff --git a/Main.hs b/Main.hs new file mode 100644 --- /dev/null +++ b/Main.hs @@ -0,0 +1,35 @@ +module Main where + +import Data.Binary +-- import Data.Set.TernarySet +import Data.Set.StringSet +import System.IO +import System.Environment + +main = do + (file:_) <- getArgs -- get file name + contents <- readFile file -- read the file contents + -- input <- getContents + let wds = words contents -- separate the words + tree = fromList $ wds -- put them in the tree + newname = (file ++ ".bin") + -- print . treeSize $ tree + putStr "All input words are in dictionary: " + print . all (`isElem` tree) $ wds -- make sure all words are actually in the tree + putStr "Same number of words as input: " + print (numEntries tree == length wds) -- make sure the same number of words are in the tree + putStr ("Writing " ++ newname ++ "... ") + encodeFile newname tree -- write the tree to a file as "filename.bin" + putStr "done.\nReading data back in... " + ntree <- decodeFile newname -- read in the file and decode it + putStr "done.\nRead in data matches original: " + print (tree == ntree) -- check the read in tree is the same as the one we wrote + -- print 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 + putStrLn (f line) + interact' f diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,4 @@ +#! /usr/bin/env runhaskell + +> import Distribution.Simple +> main = defaultMain diff --git a/TernaryTrees.cabal b/TernaryTrees.cabal new file mode 100644 --- /dev/null +++ b/TernaryTrees.cabal @@ -0,0 +1,42 @@ +Name: TernaryTrees +Version: 0.0.1 +Category: Datatypes +Synopsis: Efficient pure ternary trees +Description: Ternary trees are an efficient structure often used for storing + strings for fast lookups. This package implements a generic tree + for storing lists of Ord instances, and a specialised String + implementation which is about 30% faster than the generic version. + + An example program is provided what shows how to use the package + as a dictionary program for spell checking, and how it can be + used to serialise data with Don Stewart's Data.Binary package. + + From my testing, using the /usr/shart/dict/words file on my system + (over 230,000 words), inserting all words, checking they all exist + 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). + + Future releases (coming very soon) will also have Map structures + for key/value lookups. +License: BSD3 +License-file: LICENSE.txt +Author: Alex Mason +Maintainer: Alex Mason +build-type: Simple +Cabal-Version: >= 1.2 +Extra-Source-Files: + Data/Set/TernarySet.hs + Data/Set/StringSet.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 + +Executable tdict + Main-Is: Main.hs + Build-Depends: base