动态 Haskell 中的空间泄漏答案

【问题标题】：Space leak in dynamic Haskell动态 Haskell 中的空间泄漏
【发布时间】：2016-10-07 20:25:12
【问题描述】：

我几天前发布了这个问题：Haskell performance using dynamic programming，建议使用 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 强制它什么也没做。

【问题讨论】：

我无法重现您的问题。您使用的是什么版本的 GHC？你用什么标志编译？
@ThomasM.DuBuisson 这是通过 HackerRank 竞赛完成的。环境使用 ghc 7.8，只提供 512 MB 内存。据我所知，没有标志。
或者我误解了你的问题。当然，内存显然与n 呈线性关系，因为您在执行任何操作之前从标准输入读取n 字符串行。这是全部还是您观察到 editDistance 在某个维度上占用了太多内存？
@ThomasM.DuBuisson 大部分内存使用在 editDistance 中构造的动态表中。看来我有足够的空间容纳 3-4 或这些桌子，因为它不会在 n 小于 4 时崩溃。但是在构建了一张桌子之后，可以拉出答案，我将不再需要那张桌子，但它似乎持续存在。
另外，不要通过last 强制整个列表，只需使用该值 - 毕竟你知道：array ((0,0),(xBnd,yBnd)) xs。请注意，列表的长度为strLen^2，因此您分配了大量内存只是为了稍后释放它。

标签： performance haskell lazy-evaluation space-leak

【解决方案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。

【讨论】：

【解决方案2】：

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

我会尝试：

{-# LANGUAGE BangPatterns #-}

...
min' !a !b !c = min a (min b c)

【讨论】：