递归列表 zipWith 导致空间泄漏

Question

我的空间泄漏发生在我的个人项目中。但我不希望有人在我的项目中解决它。我想要理解它。

我通过编写以下算法来复现我的空间泄漏：

u是由以下序列定义的：

• u(0) = 1
• u(1) = 2
• u(2) = 1
• u(4) = 3
• …
• u(19) = 11

此后，u被定义为：u(n) = u(n-5) + u(n-10) - u(n-15)

在Haskell中很容易实现，对吧？

import System.Environment (getArgs)

u = [1, 2, 1, 3, 1, 4, 1, 5, 1, 6, 1, 7, 1, 8, 1, 9, 1, 10, 1, 11]
        ++ zipWith3 go u' u'' u'''
    where u' = drop 15 u
          u'' = drop 10 u
          u''' = drop 5 u
          go a b c = a + b - c

main = do
    args <- getArgs
    let n = read $ args !! 0
    putStrLn $ show $ u !! n

不幸的是，这个空间有漏洞：

$ time ./algo 9999999
Stack space overflow: current size 8388608 bytes.
Use `+RTS -Ksize -RTS' to increase it.
1.17user 0.19system 0:01.37elapsed 100%CPU (0avgtext+0avgdata 865124maxresident)k
0inputs+0outputs (0major+215695minor)pagefaults 0swaps

看起来Haskell正在缓存整个列表，而我希望它只缓存最后20个元素。

例如，这是我的C实现：

#include <stdint.h>
#include <stdio.h>

int main(int argc, char **argv)
{
    size_t cursor;
    int64_t buffer[20] = {1, 2, 1, 3, 1, 4, 1, 5, 1, 6, 1, 7, 1, 8, 1, 9, 1, 10, 1, 11};
    int n = atoi(argv[1]);

    for (cursor = 20; cursor <= n; cursor++) {
        buffer[cursor%20] = buffer[(cursor+20-5)%20] + buffer[(cursor+20-10)%20] - buffer[(cursor+20-15)%20];
    }

    printf("%d\n", buffer[n%20]);
    return 0;

}

$ ./a.out 9999999
5000001

我的 C 代码实现时间复杂度为 O(n)，空间复杂度为 O(1)。但是我的 Haskell 实现似乎使用了 O(n) 的空间。

为什么 Haskell 能够在 斐波那契数列 中找到答案，但在我的自定义序列中却不能？我做错了什么？你会如何在 Haskell 中实现这个算法？

- Antoine Catton

---

你用 -O2 编译了吗？另外，由于它是 GHC 喜欢保留的顶级值，尝试在 main 中使用 where 定义它。 - bheklilr

带/不带 -O2，在顶层/main函数闭包中，在这四种情况下，它都不会改变任何东西:(。 - Antoine Catton

Answer 1

好的，那是一个堆栈溢出，但您还有一个空间泄漏，这更容易用几个词解释清楚。

当您执行索引u !! n时，u看起来像

1 : 2 : 1 : ... : 11 : <go thunk> : ... : <go thunk> : <zipWith3 thunk>

当你提取列表 中索引为n的最后一个<go thunk>时，每个<go thunk>都引用了u中先前的元素，因此（几乎）需要保留u中的所有内容在内存中（实际上不需要前五个元素左右）。

栈溢出的问题在于，为了计算 中的第9999999个元素，您首先必须评估第9999994个元素，而为了评估该元素，您首先必须评估第9999989个元素，以此类推。在评估第9999994个元素后，如何继续评估第9999999个元素就进入堆栈，这就是堆栈溢出的原因（我想这也是一种空间泄漏）。

这两个问题都可以通过强制构建或遍历u列表的元素来解决。由于您说不希望有人解决空间泄漏的问题，因此我将其留作练习，尽管有一种特别巧妙且可能不明显的方法来解决它。

---

编辑添加：我心目中可能太聪明的修复方法只是将最后一行更改为

    putStrLn $ show $ foldr ((:) $!) [] u !! n

了解这个工作原理可能已经是一个足够的练习了。

更直接的方法是使用max taldykin的答案，或编写一个自定义索引函数，强制它跳过要丢弃的元素之前的元素。

- Reid Barton

---

你说出了我的心声；这看起来像是由于懒惰导致的thunk积累。 - CR Drost

为什么Fibonacci算法没有出现任何"堆栈溢出"的情况呢？ - Antoine Catton

@AntoineCatton 你试过了吗？它会像你的“u”一样泄漏空间。 - András Kovács

正如我所说，我不想解决我项目中的具体问题（可能更加复杂）。但是我对这个虚构算法的解决方案很感兴趣，以便我能够理解它。（你不必这样做，我喜欢练习） - Antoine Catton

Answer 2

这里是遵循Reid Barton答案的代码：

{-# LANGUAGE BangPatterns #-}
import System.Environment (getArgs)

u :: [Int]
u = [1, 2, 1, 3, 1, 4, 1, 5, 1, 6, 1, 7, 1, 8, 1, 9, 1, 10, 1, 11]
        ++ go u' u'' u'''
    where u' = drop 15 u
          u'' = drop 10 u
          u''' = drop 5 u
          go ((!a):as) ((!b):bs) ((!c):cs)
            = a + b - c
            : go as bs cs

它使用BangPatterns扩展来强制计算thunks。 （我还添加了类型注释来使用Int而不是Integer，这样可以稍微快一些。）

您可以看到它在常量空间中运行（1M in use是输出的相关部分）：

$ ./xx 99999999 +RTS -t
50000001
<<ghc: 8000065016 bytes, 15319 GCs, 36596/44312 avg/max bytes residency (2 samples), 1M in use, 0.00 INIT (0.00 elapsed), 2.82 MUT (2.78 elapsed), 0.01 GC (0.06 elapsed) :ghc>>

- max taldykin