Haskell：尽管使用（2D）数组，但使用 DP 占用内存答案

【问题标题】：Haskell: Memory hog with DP despite using (2D) arrayHaskell：尽管使用（2D）数组，但使用 DP 占用内存
【发布时间】：2021-01-14 14:32:44
【问题描述】：

我正在尝试解决竞赛中的一个动态编程问题，这自然会限制执行时间和内存。粗略地说，该问题的剥离版本是首先按行生成一个表，然后处理每一列，这涉及将元素与其垂直相对的对应元素“配对”。这使我认为在内存中维护整个表是必要的。使用数组后，按照here的建议，速度还可以，但程序仍然占用内存。

问题

给定两个整数k 和n，定义

dp[j][0] = dp[j][n+1] = 0               for j=0,...k,
dp[0][m] = 1                            for m=1,...,n,
dp[j][m] = dp[j-1][m-1] + dp[j-1][m+1]  for j=0,...,k and m=1,...,n.

让vs[m] = sum [dp[j][m] * dp[k-j][m] | j<-[0..k]] 为所有m=1,...,n。

我需要计算vs[1],...,vs[n]，下面是我的代码。（即solve 函数。由于结果可能是大数，我们以10^9+7 为模计算它们。）

{-# LANGUAGE Safe #-}
{-# OPTIONS_GHC -O2 #-}

import safe Control.Arrow ((>>>))
import qualified Data.Text as T
import qualified Data.Text.IO as TI
import qualified Data.Map as M
import qualified Data.Array as A
import Data.List
import Data.Function

main :: IO ()
main = TI.getContents >>= (T.lines >>> drop 0 >>> tcio >>> (mapM_ putStrLn)) where
    tcio :: [T.Text] -> [String]
    tcio [] = []
    tcio (nkq : rest) = ((:[]). istoline . solve . linetois) nkq  ++ tcio rest;
    linetoi t = f 0 t where f n t = if (T.null) t then n else f (10*n + (on (-) fromEnum (T.head t) '0') ) (T.tail t) ;
    linetois = (map linetoi).(T.words); linestoiss = map linetois;
    itoline = show; istoline = unwords . (map itoline); isstolines = map istoline

solve :: [Int] -> [Int]
solve [n,k,_] = vs where
    dpf 0 m = if m==0 || m==n+1 then 0 else 1
    dpf j m = if m==0 || m==n+1 then 0 else (dp A.! (j-1) A.! (m-1)) `madd` (dp A.! (j-1) A.! (m+1))
    dp = A.listArray (0,k)  [(A.listArray (0,n+1) [dpf j m | m <- [0..(n+1)]]) | j<-[0..k]]
    vs = [foldl1' madd ([(dp A.! j A.! m) `mmult` (dp A.! (k-j) A.! m) | j<-[0..k]]) | m<-[0..(n+1)]]
    madd = modp (+)
    mmult a b = fromInteger $ modp (*) (toInteger a) (toInteger b)
    modp f a b = (f a b)`mod` (10^9+7)

问题

对于k=5000 和n=1000，它消耗超过2GB 的内存！考虑到比赛中设置的限制为 1GB 的实际问题，这远高于 1 GB。

分析结果是here。我想知道我是否有效地使用了数组结构。提供给A.listArray 的列表理解是否暗示在内部创建一个二维列表，有点违背目的？如果有的话，我们还能如何优化内存？

【问题讨论】：

顺便说一句，转换为Integer 并返回是不必要的。 Int在现代机器上是64位，存储(10^9+7)^2绰绰有余；如果您是偏执狂，请导入 Data.Int 并使用 Int64 甚至可以在旧机器上工作。
我没有发现 Int64 在算术和 IO/解析方面优于 Integer。

标签： haskell memory multidimensional-array dynamic-programming

【解决方案1】：

我不会为数组而烦恼。像这样走：

import Control.Monad

modulus :: Int
modulus = 10^9 + 7

plus :: Int -> Int -> Int
plus x y = (x + y) `rem` modulus

times :: Int -> Int -> Int
times x y = (x * y) `rem` modulus

initialize :: Int -> [Int]
initialize n = [0] ++ replicate (n-2) 1 ++ [1]

step :: [Int] -> [Int]
step xs = [0] ++ zipWith plus xs (drop 2 xs) ++ [0]

v :: [Int] -> Int
v xs = sum (zipWith times xs (reverse xs))

main :: IO ()
main = forever $ do
    line <- getLine
    n:k:_ <- mapM readIO (words line)
    putStrLn . unwords . map (show . v) . transpose . take k . iterate step $ initialize n

似乎比较节省内存：

% ghc -O2 test && echo 5000 1000 | /usr/bin/time ./test >/dev/null
[1 of 1] Compiling Main             ( test.hs, test.o )
Linking test ...
test: <stdin>: hGetLine: end of file
Command exited with non-zero status 1
0.56user 0.01system 0:00.58elapsed 99%CPU (0avgtext+0avgdata 68924maxresident)k
0inputs+0outputs (0major+16524minor)pagefaults 0swaps

【讨论】：

嗯..您的v 一次作用于单个行（“层”），我担心这不是问题陈述。要求是对单个“列”采取行动，每个“列”跨越以分层方式生成的行。
@cobra 啊！我确实看错了。这让问题更加更有趣，哈哈。
@cobra ...虽然这似乎并不重要？在将transpose 扔在那里之后，它似乎仍然只需要大约 70 Mb。我会尽快编辑。
谢谢，您的代码告诉我iterate 是多么整洁，除此之外。我已经编辑了您的代码以进行小修复（希望没问题？）。我用ghc -no-keep-hi-files -no-keep-o-files -prof -fprof-auto -rtsopts dan.hs && echo "1000 5000 1" | ./dan +RTS -p > /dev/null 和took 2.8 秒和2.9 GB 运行您的代码，这比我的代码稍快但占用空间稍多，除非我误读了它。无论如何，n=k=5000 限制为 3 秒和 1 GB 是比赛所期望的，这对于 Haskell 来说似乎遥不可及:(
@cobra 总分配与最大驻留完全不同。如果我编写一个执行十亿次的循环，并且在该循环中分配一个字节，然后立即对其进行垃圾回收，我将获得一个字节的最大驻留和十亿字节的总分配。

【解决方案2】：

只是为了好玩，我整理了一个使用可变未装箱数组的版本。我怀疑您的原始代码占用了太多内存，因为它存储了一些疯狂数量的 thunk，它们都相互引用。我没有费心为此做 IO（我真的不认为这是瓶颈），但以下运行在大约 200MB 的最大驻留中（大约是我更惯用的答案使用的 1/10）。

{-# LANGUAGE FlexibleContexts #-}

import Control.Monad
import Control.Monad.ST
import Data.Array.ST
import Data.Int

modulus :: Int64
modulus = 10^9+7

initialize :: Int -> Int -> ST s (STUArray s (Int, Int) Int64)
initialize k n = do
    arr <- newArray ((0, 0), (k, n+1)) 0
    forM_ [1..n] $ \m -> writeArray arr (0,m) 1
    forM_ [1..k] $ \j -> do
        forM_ [1..n] $ \m -> do
            up <- readArray arr (j-1, m-1)
            down <- readArray arr (j-1, m+1)
            writeArray arr (j,m) ((up + down) `rem` modulus)
    pure arr

collapse :: STUArray s (Int, Int) Int64 -> ST s (STUArray s Int Int64)
collapse arr = do
    ((xlo,ylo), (xhi,yhi)) <- getBounds arr
    v <- newArray (ylo, yhi) 0
    forM_ [ylo .. yhi] $ \m -> do
        vm <- go m xhi xlo xhi 0
        writeArray v m vm
    pure v
    where
    go m hi j j' acc
        | j > hi = pure acc
        | otherwise = do
            l <- readArray arr (j, m)
            r <- readArray arr (j', m)
            go m hi (j+1) (j'-1) ((acc + (l*r `rem` modulus)) `rem` modulus)

main :: IO ()
main = print (runSTUArray (initialize 5000 5000 >>= collapse))

【讨论】：