haskell - 在 Haskell 中更快地计算直方图

Question

我对 Haskell 很陌生，我想创建一个直方图。我正在使用 Data.Vector.Unboxed 来融合对数据的操作；速度非常快(当使用 -O -fllvm 编译时)，瓶颈是我的折叠应用程序；它聚合存储桶计数。

怎样才能让它更快？我读到了有关尝试通过保持严格来减少重击次数的内容，因此我通过使用 seq 和 Foldr' 来严格控制，但没有看到太多性能提升。我们强烈鼓励您提出想法。

import qualified Data.Vector.Unboxed as V

histogram :: [(Int,Int)]
histogram = V.foldr' agg [] $ V.zip k v
 where 
    n = 10000000
    c = 1000000
    k = V.generate n (\i -> i `div` c * c)
    v = V.generate n (\i -> 1)
    agg kv [] = [kv]
    agg kv@(k,v) acc@((ck,cv):as)
        | k == ck = let a = (ck,cv+v):as in a `seq` a
        | otherwise = let a = kv:acc in a `seq` a

main :: IO ()
main = print histogram 

编译:

ghc --make -O -fllvm histogram.hs

Answer 1

首先，使用-O2 -rtsopts编译程序。然后，为了初步了解可以优化的地方，请使用选项 +RTS -sstderr 运行程序:

$ ./question +RTS -sstderr
[(0,1000000),(1000000,1000000),(2000000,1000000),(3000000,1000000),(4000000,1000000),(5000000,1000000),(6000000,1000000),(7000000,1000000),(8000000,1000000),(9000000,1000000)]
   1,193,907,224 bytes allocated in the heap
   1,078,027,784 bytes copied during GC
     282,023,968 bytes maximum residency (7 sample(s))
      86,755,184 bytes maximum slop
             763 MB total memory in use (0 MB lost due to fragmentation)

                                    Tot time (elapsed)  Avg pause  Max pause
  Gen  0      1964 colls,     0 par    3.99s    4.05s     0.0021s    0.0116s
  Gen  1         7 colls,     0 par    1.60s    1.68s     0.2399s    0.6665s

  INIT    time    0.00s  (  0.00s elapsed)
  MUT     time    2.67s  (  2.68s elapsed)
  GC      time    5.59s  (  5.73s elapsed)
  EXIT    time    0.02s  (  0.03s elapsed)
  Total   time    8.29s  (  8.43s elapsed)

  %GC     time      67.4%  (67.9% elapsed)

  Alloc rate    446,869,876 bytes per MUT second

  Productivity  32.6% of total user, 32.0% of total elapsed

请注意，67% 您的时间都花在了 GC 上!显然有什么问题。为了找出问题所在，我们可以在启用堆分析的情况下运行程序(使用+RTS -h)，结果如下图:

所以，你泄露了重击。这是怎么发生的？查看代码，在 agg 中(递归地)构建 thunk 的唯一时间是进行加法时。通过添加 bang 模式使 cv 严格，从而解决了问题:

{-# LANGUAGE BangPatterns #-}
import qualified Data.Vector.Unboxed as V

histogram :: [(Int,Int)]
histogram = V.foldr' agg [] $ V.zip k v
 where
    n = 10000000
    c = 1000000
    k = V.generate n (\i -> i `div` c * c)
    v = V.generate n id
    agg kv [] = [kv]
    agg kv@(k,v) acc@((ck,!cv):as) -- Note the !
        | k == ck = (ck,cv+v):as
        | otherwise = kv:acc

main :: IO ()
main = print histogram

输出:

$ time ./improved +RTS -sstderr 
[(0,499999500000),(1000000,1499999500000),(2000000,2499999500000),(3000000,3499999500000),(4000000,4499999500000),(5000000,5499999500000),(6000000,6499999500000),(7000000,7499999500000),(8000000,8499999500000),(9000000,9499999500000)]
     672,063,056 bytes allocated in the heap
          94,664 bytes copied during GC
     160,028,816 bytes maximum residency (2 sample(s))
       1,464,176 bytes maximum slop
             155 MB total memory in use (0 MB lost due to fragmentation)

                                    Tot time (elapsed)  Avg pause  Max pause
  Gen  0       992 colls,     0 par    0.03s    0.03s     0.0000s    0.0001s
  Gen  1         2 colls,     0 par    0.03s    0.03s     0.0161s    0.0319s

  INIT    time    0.00s  (  0.00s elapsed)
  MUT     time    1.24s  (  1.25s elapsed)
  GC      time    0.06s  (  0.06s elapsed)
  EXIT    time    0.03s  (  0.03s elapsed)
  Total   time    1.34s  (  1.34s elapsed)

  %GC     time       4.4%  (4.5% elapsed)

  Alloc rate    540,674,868 bytes per MUT second

  Productivity  95.5% of total user, 95.1% of total elapsed

./improved +RTS -sstderr  1,14s user 0,20s system 99% cpu 1,352 total

这好多了。

<小时/>

现在您可能会问，即使您使用了 seq，为什么还会出现该问题？原因是 seq 仅强制第一个参数为 WHNF ，对于一对，(_,_)(其中 _ 是未评估的重击)已经是 WHNF!此外，seq a a 与 a 相同，因为它 seq a b(非正式地)意味着:在计算 b 之前先计算 a，所以 seq a a 只是意味着:在评估 a 之前评估 a，这与只评估 a 相同!