动态Haskell中的空间泄漏

Question

我几天前发布了这个问题：Haskell使用动态编程的性能，建议使用ByteStrings而不是Strings。在用ByteStrings实现算法后，程序崩溃，超过了内存限制。

import Control.Monad
import Data.Array.IArray
import qualified Data.ByteString as B
main = do
  n <- readLn
  pairs <- replicateM n $ do
    s1 <- B.getLine
    s2 <- B.getLine
    return (s1,s2)
  mapM_ (print . editDistance) pairs
editDistance :: (B.ByteString, B.ByteString) -> Int
editDistance (s1, s2) = dynamic editDistance' (B.length s1, B.length s2)
  where
    editDistance' table (i,j)
      | min i j == 0 = max i j
      | otherwise = min' (table!((i-1),j) + 1) (table!(i,(j-1)) + 1) (table!((i-1),(j-1)) + cost)
      where
        cost =  if B.index s1 (i-1) == B.index s2 (j-1) then 0 else 1
        min' a b = min (min a b)
dynamic :: (Array (Int,Int) Int -> (Int,Int) -> Int) -> (Int,Int) -> Int
dynamic compute (xBnd, yBnd) = table!(xBnd,yBnd)
  where
    table = newTable $ map (coord -> (coord, compute table coord)) [(x,y) | x<-[0..xBnd], y<-[0..yBnd]]
    newTable xs = array ((0,0),fst (last xs)) xs

内存消耗似乎与n成比例。输入字符串的长度为1000个字符。我希望Haskell在打印每个解决方案后释放editDistance中使用的所有内存。事实并非如此吗？如果没有，我该如何强制执行？

我看到的唯一另一个真正的计算是cost，但用seq强制它并没有起到任何作用。

Answer 1

如果在计算任何结果和打印输出之前读取所有n输入，那么您的内存肯定会随着n而增加。您可以尝试交错输入和输出操作：

main = do
  n <- readLn
  replicateM_ n $ do
    s1 <- B.getLine
    s2 <- B.getLine
    print (editDistance (s1,s2))

或者使用懒惰IO(未经测试，可能需要免费的B.(：

main = do
  n <- readLn
  cont <- getContents
  let lns = take n (lines cont)
      pairs = unfoldr (case (x:y:rs) -> Just ((x,y),rs) ; _ -> Nothing) lns
  mapM_ (print . editDistance) pairs

编辑：其他可能的节省包括使用未装箱的阵列，并且在阵列构建过程中不通过last强制执行整个strLen^2大小列表。以array ((0,0),(xBnd,yBnd)) xs为例。

Answer 2

我的感觉是问题在于您的min'不够严格。因为它不强制参数，所以它只是为每个数组元素建立一个thunks。这会导致使用更多的内存，GC时间增加，等等。

我会试试：

{-# LANGUAGE BangPatterns #-}
...
min' !a !b !c = min a (min b c)