Haskell棘手的空间溢出

时间:2014-08-05 00:43:02

标签: haskell

尝试运行此代码时遇到空间溢出(我已经注释了我已经尝试过的更改):

{-# LANGUAGE BangPatterns #-}

import System.IO (hFlush, stdout)
import System.Environment (getArgs)
-- import Data.List (foldl')
import qualified Data.Map as Map
-- import qualified Data.Map.Strict as Map
-- import qualified Data.ByteString.Char8 as B


data Trie = Trie { isWord :: Bool, children :: Map.Map Char Trie }


initial :: Trie
initial = Trie False Map.empty


insertWord :: String -> Trie -> Trie
insertWord [] trie     = trie { isWord = True }
insertWord (c:cs) trie = trie { children = Map.insert c child $ children trie }
    where
      child = maybe (insertWord cs initial) (insertWord cs)
              (Map.lookup c (children trie))

-- insertWord :: String -> Trie -> Trie
-- insertWord [] trie     = trie { isWord = True }
-- insertWord (!c:(!cs)) trie = trie { children = Map.insert c child $ children trie }
--     where
--       child = let a = maybe (insertWord cs initial) (insertWord cs)
--                       (Map.lookup c (children trie))
--               in seq a a


fromWords :: [String] -> Trie
fromWords = foldr insertWord initial

-- fromWords :: [String] -> Trie
-- fromWords = foldl' (flip insertWord) initial


toWords :: Trie -> [String]
toWords = concatMap results . Map.toList . children
    where
      results (c, t) = (if isWord t then ([c]:) else id)
                       . map (\str -> c:str) $ toWords t


completions :: String -> Trie -> [String]
completions [] trie     = toWords trie
completions (c:cs) trie = maybe [] (map (c:) . completions cs)
                          (Map.lookup c $ children trie)


main :: IO ()
main = do
  [prefix] <- getArgs
  dict <- readFile "/usr/share/dict/words"
  mapM_ putStrLn (completions prefix (fromWords $ lines dict))
--  dict <- B.readFile "/usr/share/dict/words"
--  mapM_ putStrLn (completions prefix (fromWords $ map (B.unpack) $ B.lines dict))

输出:

$ ./trie abba
Stack space overflow: current size 8388608 bytes.
Use `+RTS -Ksize -RTS' to increase it.

&#34; + RTS -h&#34;:http://i.imgur.com/i3pdT7S.png

的输出

如果我指定&#34; + RTS -K1G&#34;我可以让代码工作。如果有人能指出我正确的方向,我真的很感激。

1 个答案:

答案 0 :(得分:1)

对于已注释的foldl'方法,您有正确的想法 - 您只需要确保在children时强制使用Trie;即使children严格的Trie字段。

data Trie = Trie { isWord :: Bool, children :: !(Map.Map Char Trie) }