Утечка пространства в динамическом Хаскеле

Я разместил этот вопрос несколько дней назад: производительность Haskell с использованием динамического программирования, и мне было рекомендовано использовать ByteStrings вместо Strings. После реализации алгоритма с помощью ByteStrings программа вылетает, выходя за пределы памяти.

import Control.Monad
import Data.Array.IArray
import qualified Data.ByteString as B

main = do
  n <- readLn
  pairs <- replicateM n $ do
    s1 <- B.getLine
    s2 <- B.getLine
    return (s1,s2)
  mapM_ (print . editDistance) pairs

editDistance :: (B.ByteString, B.ByteString) -> Int
editDistance (s1, s2) = dynamic editDistance' (B.length s1, B.length s2)
  where
    editDistance' table (i,j)
      | min i j == 0 = max i j
      | otherwise = min' (table!((i-1),j) + 1) (table!(i,(j-1)) + 1) (table!((i-1),(j-1)) + cost)
      where
        cost =  if B.index s1 (i-1) == B.index s2 (j-1) then 0 else 1
        min' a b = min (min a b)

dynamic :: (Array (Int,Int) Int -> (Int,Int) -> Int) -> (Int,Int) -> Int
dynamic compute (xBnd, yBnd) = table!(xBnd,yBnd)
  where
    table = newTable $ map (\coord -> (coord, compute table coord)) [(x,y) | x<-[0..xBnd], y<-[0..yBnd]]
    newTable xs = array ((0,0),fst (last xs)) xs

Потребление памяти, кажется, масштабируется с n, Длина входных строк составляет 1000 символов. Я ожидаю, что Haskell освободит всю память, используемую в editDistance после того, как каждое решение напечатано. Разве это не так? Если нет, как я могу заставить это?

Единственный другой реальный расчет, который я вижу, для cost но заставляя это с seq Ничего не сделал.

Источник

2 ответа

Решение

Конечно, ваша память будет увеличиваться с n если ты читаешь все n входные данные до вычисления каких-либо результатов и вывода на печать. Вы можете попробовать чередовать операции ввода и вывода:

main = do
  n <- readLn
  replicateM_ n $ do
    s1 <- B.getLine
    s2 <- B.getLine
    print (editDistance (s1,s2))

Или, в качестве альтернативы, используется ленивый ввод-вывод (непроверенный B.):

main = do
  n <- readLn
  cont <- getContents
  let lns = take n (lines cont)
      pairs = unfoldr (\case (x:y:rs) -> Just ((x,y),rs) ; _ -> Nothing) lns
  mapM_ (print . editDistance) pairs

РЕДАКТИРОВАТЬ: другие возможные сбережения включают использование распакованного массива и не заставляя весь strLen^2 список размеров через last во время строительства массива. Рассматривать array ((0,0),(xBnd,yBnd)) xs,

Источник

Я чувствую, что проблема в том, что ваш min' не достаточно строг. Поскольку он не вынуждает свои аргументы, он просто создает thunks для каждого элемента массива. Это приводит к увеличению объема используемой памяти, увеличению времени GC и т. Д.

Я бы попробовал:

{-# LANGUAGE BangPatterns #-}

...
min' !a !b !c = min a (min b c)
Источник
Другие вопросы по тегам