[Haskell-cafe] Stack overflow with my Trie implementation
Pete Kazmier
pete-expires-20070615 at kazmier.com
Thu Apr 26 14:40:51 EDT 2007
I've modified my Norvig spelling corrector to use a trie instead of
Data.Map in the hopes of improving performance. Plus, this is fun and
a great learning exercise for me. Unfortunately, when I load my trie
with a large amount of data, I get a stack overflow. It's unclear to
me why this is happening. I specifically use foldl' to avoid this
situation when building my trie. Could someone shed some light on the
situation for me?
Here is the code:
> module Main where
>
> import Data.List (foldl')
> import Data.Maybe (maybe, fromMaybe)
> import Prelude hiding (lookup)
> import qualified Data.Map as M
>
> data Trie a = T (Maybe a) (M.Map Char (Trie a)) deriving (Show)
>
> main = do
> -- big.txt is a large file of words: http://www.norvig.com/big.txt
> c <- readFile "big.txt"
> let freqTrie = foldl' incWordCount empty (words c)
> print $ lookup "evening" freqTrie
> where
> incWordCount m w = insertWith (+) w 1 m
>
> empty :: Trie a
> empty = T Nothing M.empty
>
> lookup :: String -> Trie a -> Maybe a
> lookup ([]) (T Nothing m) = Nothing
> lookup ([]) (T (Just v) m) = return v
> lookup (k:ks) (T _ m) = case M.lookup k m of
> Nothing -> Nothing
> Just trie -> lookup ks trie
>
> findWithDefault :: a -> String -> Trie a -> a
> findWithDefault v k t = fromMaybe v (lookup k t)
>
> member :: String -> Trie a -> Bool
> member k t = maybe False (const True) (lookup k t)
>
> insertWith :: (a -> a -> a) -> String -> a -> Trie a -> Trie a
> insertWith fn ([]) v (T Nothing m) = T (Just v) m
> insertWith fn ([]) v (T (Just v') m) = T (Just $ fn v v') m
> insertWith fn (k:ks) v (T mv m) = T mv (M.insertWith const k newtrie m)
> where
> oldtrie = M.findWithDefault empty k m
> newtrie = insertWith fn ks v oldtrie
>
> {-- I also tried to use this line instead of the one above to see
> if this had any impact. Unfortunately, I obtained the same
> results.
>
> insertWith fn ([]) v (T (Just v') m) = let x = fn v v' in seq x T (Just x) m
> --}
More information about the Haskell-Cafe
mailing list