记忆Collatz序列

Question

我已经在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指的是this guy。此函数假定接收一个数字Collatz，然后返回一个从1到n的索引数组，其中每个单元格都包含从索引到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代码中的时间和内存低效。具体地说，我不知道为什么这个带有尾递归和bang模式的代码会消耗这么多内存。

UPDATE1：

使用-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兆。这仍然太大了。

Update2

完整代码

{-# 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

Answer 1

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

​

​

尽管你把bang模式放在任何地方，数组初始化本身就是一个懒惰的文件夹：

-- 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直到llist是完整的，才会被GC。evaluated
• you可能认为llist是尾递归的，但事实并非如此，它与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：

​

​

(免责声明:此答案中的所有程序都是使用-O0__编译的)