在BFS的实现中Haskell空间泄漏

时间:2011-04-16 07:37:26

标签: haskell memory-leaks space breadth-first-search

我已经连续几天撞击Haskell空间泄漏(堆栈溢出类型,自然)。令人沮丧的是因为我试图直接从CLR模仿BFS算法,这不是自然递归的。注意:我已经启用了BangPatterns,并且我已经在每个可能的地方放置了一个爆炸,试图分支和绑定这个问题,没有任何效果。我之前曾经在空间泄漏中战斗过,而且我不愿意放弃并在这一点上寻求帮助,但此时我已经陷入困境。我喜欢Haskell中的编码,我非常了解函数式编程的禅,但调试空间泄漏与在满是图钉的地板上滚动一样有趣。

那就是说,我的麻烦似乎是典型的“累加器”类型的空间泄漏。堆栈显然是在下面的代码中围绕对bfs'的调用建立的。任何太空漏洞都非常值得赞赏。

import qualified Data.Map as M
import qualified Data.IntSet as IS
import qualified Data.Sequence as S
import qualified Data.List as DL

data BfsColor = White | Gray | Black deriving Show
data Node =
Node {
  neighbors :: !IS.IntSet,
  color     :: !BfsColor,
  depth     :: !Int
   }

type NodeID = Int
type NodeQueue = S.Seq NodeID
type Graph = M.Map NodeID Node

bfs :: Graph -> NodeID -> Graph
bfs graph start_node =
  bfs' (S.singleton start_node) graph

bfs' :: NodeQueue -> Graph -> Graph
bfs' !queue !graph
  | S.null queue = graph
  | otherwise =
  let (u,q1) = pop_left queue
      Node children _ n = graph M.! u
      (g2,q2) = IS.fold (enqueue_child_at_depth $ n+1) (graph,q1) children
      g3 = set_color u Black g2
  in bfs' q2 g3

enqueue_child_at_depth :: Int -> NodeID -> (Graph, NodeQueue)
                                        -> (Graph, NodeQueue)
enqueue_child_at_depth depth child (graph,!queue)  =
  case get_color child graph of
    White     -> (set_color child Gray $ set_depth child depth graph,
                   queue S.|> child)
    otherwise -> (graph,queue)

pop_left :: NodeQueue -> (NodeID, NodeQueue)
pop_left queue =
  let (a,b) = S.splitAt 1 queue
  in (a `S.index` 0, b)

set_color :: NodeID -> BfsColor -> Graph -> Graph
set_color node_id c graph =
  M.adjust (\node -> node{color=c}) node_id graph

get_color :: NodeID -> Graph -> BfsColor
get_color node_id graph = color $ graph M.! node_id

set_depth :: NodeID -> Int -> Graph -> Graph
set_depth node_id d graph =
  M.adjust (\node -> node{depth=d}) node_id graph

2 个答案:

答案 0 :(得分:2)

这看起来容易理解。 (不过,你仍然可以将代码缩小1/2。)

现在,空间泄漏的性质变得明显。也就是说,从未评估的一件事是深度。它会堆积成一个大表达式1+1+...。您可以删除所有爆炸模式,并在

添加一个模式
enqueue_child_at_depth !depth child (graph,queue)

摆脱空间泄漏。

(进一步的代码提示:您可以用简单的列表替换IS.IntSet。队列最好按照

的方式解构和重建
go depth qs graph = case viewl qs of
    EmptyL  -> graph
    q :< qs ->
        let
            qs' = (qs ><) . Seq.fromList
                . filter (\q -> isWhite q graph)
                . neighbors q $ graph
        in ...

答案 1 :(得分:0)

首先,如果你能提供一些简单的测试用例(以代码的形式)来展示这个东西如何溢出,那将是非常有用的。 没有它,我个人只能推测原因。

作为猜测:IS.fold是否足够严格?好吧,例如,以下最简单的代码堆栈也会溢出(GHC with -O2):

{-# LANGUAGE BangPatterns #-}
import qualified Data.IntSet as IS

test s = IS.fold it 1 s
    where it !e !s = s+e

main = print $ test (IS.fromList [1..1000000])

这段代码的溢出问题可能是hackafixed(有更好的方法吗?),就像那样:

test s = foldl' it 1 (IS.toList s)
    where it !e !s = s+e

也许你想在代码中查看IS.fold