Утечка пространства в Haskell при внедрении BFS - PullRequest
Новая
       13

Утечка пространства в Haskell при внедрении BFS

3 голосов
/ 16 апреля 2011

Я бился головой от утечки из пространства Haskell (естественно, типа переполнения стека) в течение нескольких дней подряд.Это разочаровывает, потому что я пытаюсь подражать алгоритму BFS прямо из CLR, который не является естественно рекурсивным.NB: я включил 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 ]

2 голосов
/ 16 апреля 2011

Это выглядит намного проще для понимания.(Хотя вы все еще можете уменьшить код на 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 ...

)

0 голосов
/ 16 апреля 2011

Прежде всего, было бы очень полезно, если бы вы могли предоставить какой-нибудь простой тестовый пример (в форме кода), который демонстрирует переполнение стека этой вещи.Без этого я лично могу только размышлять на предмет причины для этого.

В качестве предположения: достаточно ли IS.fold строг?Ну, например, следующие простейшие переполнения стека кода (GHC с -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])

Проблема переполнения с этим кодом может быть исправлена ​​(есть ли лучший способ?), Например: 

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

Может быть, вы тоже хотите посмотреть на IS.fold в своем коде.

...