当你的算法依赖于懒惰时,如何修复由懒惰引起的空间泄漏

Question

我有一些生成搜索树的算法:

data SearchTree a = Solution a | Contradiction | Search [ SearchTree a ]
  deriving (Show, Functor)

该算法懒惰地生成这棵树.我还定义了一个简单的求值器,它实际上只是深度优先搜索.

simpleEval :: MonadPlus m => SearchTree a -> m a
simpleEval (Solution a) = return a 
simpleEval Contradiction = mzero 
simpleEval (Search ps) = foldr mplus mzero $ map simpleEval ps 

我注意到我的算法产生的许多解决方案看起来像下面的搜索树:

nest :: Int -> SearchTree a -> SearchTree a 
nest 0 = id 
nest n = nest (n-1) . Search . (:[]) 

tree0 = Search ts where 
  ts = cycle $ t0 : replicate 100 t1 ++ [t2]
  t0 = nest 100 $ Solution 'a' 
  t1 = nest 1000 $ Contradiction 
  t2 = nest 4 $ Solution 'b' 

也就是说,它们有很多非常深的分支,没有解决方案,一些深层分支有一个解决方案,很少有浅层分支和解决方案.在此基础上,我决定要另一个评估员,一个将"放弃"太分支的分支.叫它cutoffEval.cutoffEval 5 tree0应该只找到bs因为它有无限多的深度小于5的分支要考虑,它们只包含bs.我是这样实现的:

cutoff :: (MonadPlus m) => Int -> SearchTree a -> (m a, [SearchTree a])
cutoff cu = go cu where 
  plus ~(m0, l0) ~(m1, l1) = (mplus m0 m1, l0 ++ l1)
  zero = (mzero, [])

  go 0 x             = (mzero, [x])
  go _ Contradiction = zero
  go _ (Solution a)  = (return a, [])
  go d (Search ps)   = foldr plus zero $ map (go $ d-1) ps

cutoffEval :: MonadPlus m => Int -> SearchTree a -> m a
cutoffEval cu = go where 
  go t = case cutoff cu t of (r,ts) -> foldr mplus mzero $ r : map go ts 

但与以下相比,此功能会产生巨大的空间泄漏simpleEval:

putStrLn $ take 4000 $ simpleEval tree0  -- 2MB residency
putStrLn $ take 4000 $ cutoffEval 10 tree0  -- 600MB residency

分析表明几乎所有的分配都发生在cutoff.go; 并且大部分的分配是由于某些神秘的调用main:Tree.sat_s5jg和(,)构造函数.在我看来,由于无可辩驳的模式,元组构造函数被构建为thunk而不是被强制plus; 通常空间泄漏的解决方案是让你的功能更严格,但是这里删除无可辩驳的模式导致cutoff挂起,所以我不能这样做.

我用GHC 7.6,7.8和7.10测试了这个.每个人都发现了这个问题.

所以我的问题是:可以cutoffEval写成在恒定的空间中运行simpleEval吗？更一般地说,如果因为算法取决于它而无法使我的实现更严格,如何修复空间泄漏？

Answer 1

在我看来，内存泄漏的原因实际上是实现中的一个错误。您的cutoff功能将切断太深的分支与评估上部部分混合在一起。然后在 中cutoffEval，你深入到底部，砍掉分支，继续递归地探索它们。这本质上是广度优先搜索，cu在每次遍历中按级别进行。这意味着整个树最终将被构建并保留在内存中直到最后！（与深度优先搜索的情况不同，访问过的子树可以由 GC 回收。）

如果你只想剪掉太深的分支，那么得到结果的第一部分cutoff就是你想要的。

无论如何，我建议将评估器和截止部分分开（见下文）。在这种情况下，您可以仅在树的截止版本上使用原始评估器。

补充一点，从MonadPlus约束来看，您仅使用幺半群部分 -mzero和mplus。仅使用 . 会更干净、更通用Monoid。幺半群比单子多（例如，Sum仅计算解决方案，或Last找到最后的解决方案）。

simpleEval :: (Monoid m) => (a -> m) -> SearchTree a -> m
simpleEval f = go
  where
    go (Solution a) = f a
    go Contradiction = mempty
    go (Search ps) = mconcat $ map go ps 

cutoff :: Int -> SearchTree a -> SearchTree a
cutoff cu = go cu
  where 
    go 0 _             = Contradiction -- too deep branches are just failures
    go d (Search ps)   = Search $ map (go (d - 1)) ps
    go _ x             = x

cutoffEval :: (Monoid m) => Int -> (a -> m) -> SearchTree a -> m
cutoffEval cu f = simpleEval f . cutoff cu