0

我在 CodeReview 中发布了同样的问题，但没有得到答案。所以我在这里碰运气。

这是我利用记忆和数组来提高性能和内存使用率的程序之一。性能似乎令人满意，但内存使用情况很荒谬，我不知道出了什么问题：

{-# LANGUAGE BangPatterns #-}
import Data.Functor
import Data.Array (Array)
import qualified Data.Array as Arr
import Control.DeepSeq

genColtzArr n = collatzArr
    where collatzArr = Arr.array (1, n) $ take n $ map (\v -> (v, collatz v 0)) [1..] 
          collatz 1 !acc  = 1 + acc
          collatz !m !acc
              | even m    = go (m `div` 2) acc
              | otherwise = go (3 * m + 1) acc
              where go !l !acc
                      | l <= n    = let !v = collatzArr Arr.! l in 1 + acc + v
                      | otherwise = collatz l $ 1 + acc

collatz这里的意思是这个家伙。这个函数应该接收一个数字n，然后返回一个索引从 1 到 的数组n，其中每个单元格包含通过应用 Collat​​z 公式从索引到 1 的链接的长度。

但是这种方法的内存使用率很高。这是分析器结果（ghc 选项-prof -fprof-auto -rtsopts、运行时选项+RTS -p、n == 500000）：

total alloc = 730,636,136 bytes  (excludes profiling overheads)

COST CENTRE              MODULE  %time %alloc

genColtzArr.collatz      Main     40.4   34.7
genColtzArr.collatz.go   Main     25.5   14.4


COST CENTRE                      MODULE                    no.     entries  %time %alloc   %time %alloc     

      genColtzArr                Main                      105           1    0.0    0.0    74.7   72.1
       genColtzArr.collatzArr    Main                      106           1    8.0   20.8    74.7   72.1
        genColtzArr.collatzArr.\ Main                      107      500000    0.9    2.2    66.8   51.3
         genColtzArr.collatz     Main                      109     1182582   40.4   34.7    65.9   49.1
          genColtzArr.collatz.go Main                      110     1182581   25.5   14.4    25.5   14.4

请注意，这-O2不是理想的答案。我想弄清楚这个程序有什么问题，一般来说，我应该如何发现 Haskell 代码中的时间和内存效率低下。具体来说，我不知道为什么这段带有尾递归和爆炸模式的代码会消耗这么多内存。

更新1：

相同的代码-s产生这个：

   1,347,869,264 bytes allocated in the heap
     595,901,528 bytes copied during GC
     172,105,056 bytes maximum residency (7 sample(s))
         897,704 bytes maximum slop
             315 MB total memory in use (0 MB lost due to fragmentation)

                                     Tot time (elapsed)  Avg pause  Max pause
  Gen  0      2408 colls,     0 par    0.412s   0.427s     0.0002s    0.0075s
  Gen  1         7 colls,     0 par    0.440s   0.531s     0.0759s    0.1835s

  INIT    time    0.000s  (  0.000s elapsed)
  MUT     time    0.828s  (  0.816s elapsed)
  GC      time    0.852s  (  0.958s elapsed)
  RP      time    0.000s  (  0.000s elapsed)
  PROF    time    0.000s  (  0.000s elapsed)
  EXIT    time    0.004s  (  0.017s elapsed)
  Total   time    1.684s  (  1.791s elapsed)

  %GC     time      50.6%  (53.5% elapsed)

  Alloc rate    1,627,861,429 bytes per MUT second

  Productivity  49.4% of total user, 46.4% of total elapsed

所以它需要300兆。那还是太大了。

更新2

完整代码

{-# LANGUAGE BangPatterns #-}
import Data.Functor
import Data.Array (Array)
import qualified Data.Array as Arr
import Control.DeepSeq

genColtzArr n = collatzArr
    where collatzArr = Arr.array (1, n) $ take n $ map (\v -> (v, collatz v 0)) [1..] 
          collatz 1 !acc  = 1 + acc
          collatz !m !acc
              | even m    = go (m `div` 2) acc
              | otherwise = go (3 * m + 1) acc
              where go !l !acc
                      | l <= n    = let !v = collatzArr Arr.! l in 1 + acc + v
                      | otherwise = collatz l $ 1 + acc


genLongestArr n = Arr.array (1, n) llist
    where colatz = genColtzArr n
          llist  = (1, 1):zipWith (\(n1, a1) l2 -> 
                                    let l1 = colatz Arr.! a1
                                     in (n1 + 1, if l2 < l1 then a1 else n1 + 1)) 
                                  llist (tail $ Arr.elems colatz)


main :: IO ()
main = getLine >> do
    ns <- map read <$> lines <$> getContents
    let m          = maximum ns
    let lar        = genLongestArr m
    let iter []    = return ()
        iter (h:t) = (putStrLn $ show $ lar Arr.! h) >> iter t
    iter ns
4

1 回答 1

2

正如 CodeReview 上的另一个答案所暗示的那样，一个 500000 个元素的盒装数组占用约 20MB 内存是可以的，但它不仅是数组，而且还有很多东西：

可拉兹 500000 +RTS -hr -L50

尽管您在任何地方都放置了爆炸模式，但数组初始化本身是一个惰性文件夹：

-- from GHC.Arr
array (l,u) ies
    = let n = safeRangeSize (l,u)
      in unsafeArray' (l,u) n
                      [(safeIndex (l,u) n i, e) | (i, e) <- ies]

unsafeArray' :: Ix i => (i,i) -> Int -> [(Int, e)] -> Array i e
unsafeArray' (l,u) n@(I# n#) ies = runST (ST $ \s1# ->
    case newArray# n# arrEleBottom s1# of
        (# s2#, marr# #) ->
            foldr (fill marr#) (done l u n marr#) ies s2#)

因此，除非您评估数组的最后一位，否则它会引用初始化中使用的列表。通常，在您评估数组时，可以对列表进行即时 GC，但在您的情况下，相互引用和自引用扰乱了常见的 GC 模式。

  • llist是自引用以产生每个元素，因此在您评估它的最后一个元素之前它不会被 GC
  • 它还包含一个引用，genColtzArr因此在完全评估genColtzArr之前不会被 GC'dllist
  • 你可能认为collatz是尾递归，但它不是，它是相互递归的，collatzArr所以在完全评估之前它们都不会被 GC

一切结合起来，您的程序将在内存中保留三个 500000 元素的类似列表的结构，并产生约 80MB 的峰值堆大小。

解决方案

显而易见的解决方案是在将每个数组/列表用于另一个之前将其强制为正常形式，这样您就不会在内存中保留相同数据的多个副本。

genLongestArr :: Int -> Array Int Int
genLongestArr n =
  let collatz = genColtzArr n
  -- deepseq genColtzArr before mapping over it
  -- this is equivalent to your recursive definition
  in collatz `deepseq` (Arr.listArray (1,n) $ fmap fst $ scanl' (maxWith snd) (0, 0) $ Arr.assocs collatz)

maxWith :: Ord a => (b -> a) -> b -> b -> b
maxWith f b b' = case compare (f b) (f b') of
  LT -> b'
  _  -> b

并在main：

-- deepseq lar before mapping over it
-- this is equivalent to your iter loop
lar `deepseq` mapM_ (print . (lar Arr.!)) ns

没有什么可以做的genColtzArr，它使用自己来记忆，所以相互递归是必要的。

现在堆图的峰值约为 20MB，因为它应该：

collat​​z2 500000 +RTS -hr -L50

（免责声明：此答案中的所有程序都是用 编译的-O0）

于 2016-03-11T12:26:14.833 回答