Есть ли утечка пространства в этой реализации LPath на Haskell?

Question

Ради интереса я пытаюсь написать реализацию алгоритма наивного длинного пути (для нахождения длины самого длинного ациклического пути в циклическом графе). Я начал с прямого порта императивного алгоритма, который работал и работал довольно хорошо.

data Route = Route {dest:: !Int32, cost:: !Int32}

type Node = [Route]

lPathImperative :: V.Vector Node -> Int32 -> UMV.IOVector Bool -> IO (Int32)
lPathImperative !nodes !nodeID !visited = do
  UMV.write visited (fromIntegral nodeID) True
  max <- newIORef 0
  Prelude.mapM_  (\ Route{dest, cost} -> do
         isVisited <- UMV.read visited (fromIntegral dest)
         case isVisited of
           True -> return ()
           False -> do
               dist <- fmap (+ cost) $ lPathImperative nodes dest visited
               maxVal <- readIORef max
               if dist > maxVal then writeIORef max dist else return ())
     (nodes V.! (fromIntegral nodeID))
  UMV.write visited (fromIntegral nodeID) False
  readIORef max

куда visited является неупакованным изменяемым вектором bools, представляющим, был ли каждый узел в графе в данный момент посещен, все инициализированы как ложные, а узлы - это вектор узлов.

Затем я попытался сделать его более функциональным, имея max как значение, которое передается в сгибе, а не как IORef, следующим образом:

lPathFun :: V.Vector Node -> Int32 -> UMV.IOVector Bool -> IO (Int32)
lPathFun !nodes !nodeID !visited = do
  UMV.write visited (fromIntegral nodeID) True
  let max = CM.foldM acc (0::Int32) (nodes V.! (fromIntegral nodeID))
  UMV.write visited (fromIntegral nodeID) False
  max
    where
      acc :: Int32 -> Route -> IO (Int32)
      acc maxDist Route{dest,cost}  = do
          isVisited <- UMV.read visited (fromIntegral dest)
          case isVisited of
            True -> return maxDist
            False -> do
              dist <- fmap (+ cost) $ lPathFun nodes dest visited
              return $ if dist > maxDist then dist else maxDist

Эта версия, однако, не завершается, работает в течение нескольких минут (другой потребовалось несколько секунд для того же ввода), прежде чем умереть с out of memory (requested 1048576 bytes), Я был бы признателен, если бы кто-нибудь мог взглянуть на мой код для lPathFun и посмотрим, что я делаю не так. Я пытался сделать все в этом строгим, но это не помогло, а также попытался сделать все ленивым, без изменений. Я даже пытался изменить type node в V.Vector route и используя строгий foldM' вместо этого, но безрезультатно.

Я подозреваю, что проблема в космической утечке. Это потому, что я пытался перевести lPathFun в OCaml, и он работал нормально (тот факт, что версия OCaml использует ручную рекурсию, не должен иметь значения: моя функциональная версия на Haskell изначально тоже использовала ручную рекурсию, но столкнулась с теми же проблемами, что и при использовании foldM):

type route = {dest: int; cost: int}
type node = route array

let rec lPathFun (nodes: node array) nodeID visited =
  visited.(nodeID) <- true;
  let rec loop i maxDist =
    if i < 0 then maxDist
    else
      let neighbour = nodes.(nodeID).(i) in
      if (not visited.(neighbour.dest))
      then
        let dist = neighbour.cost + lPathFun nodes neighbour.dest visited in
        let newMax = if dist > maxDist then dist else maxDist in
        loop (i-1) newMax
      else
        loop (i-1) maxDist in
  let (max: int) = loop (Array.length nodes.(nodeID) - 1) 0 in
  visited.(nodeID) <- false;
  max;;

Я использую версию GHC 7.8.3.

Answer 1

let max = ... выглядит здесь подозрительно:

lPathFun !nodes !nodeID !visited = do
  UMV.write visited (fromIntegral nodeID) True
  let max = CM.foldM acc (0::Int32) (nodes V.! (fromIntegral nodeID))
  UMV.write visited (fromIntegral nodeID) False
  max

Ваш код эквивалентен:

  UMV.write ... True
  UMV.write ... False
  CM.foldM acc ...

но я уверен, что вы хотите:

  UMV.write visited ... True
  max <- CM.foldM ...
  UMV.write visited ... False
  return max