Haskell中map length . group实现质因数分解为何比显式递归慢很多？

现有如下整数n的质因数分解算法：设d'为上一轮找到的n的因数，初始值d'=1；找到大于d'的最小因数d，再求取能整除n的d的最高次幂e，将d^e加入结果，对n/d^e重复上述流程，直到n变为1。此处暂不考虑在sqrt n处停止等数学优化。

通过两种方式实现该算法：

• 第一种先生成除法「尝试」列表，再按因数对成功的尝试分组。例如n=20时，先生成[(2,20),(2,10),(2,5),(3,5),(4,5),(5,5),(5,1)]，再通过group等库函数转换为目标结果[(2,2),(5,1)]。
• 第二种是显式递归实现，全程跟踪指数e，找到最大e后将d^e加入结果，再继续查找下一个d。

给出的实现代码如下：

{-# OPTIONS_GHC -O2 #-}
module GroupCheck where
import Data.List
import Data.Maybe

implement1 :: Integral t=> t -> [(t,Int)]                    -- IMPLEMENTATION 1
implement1  = map (\xs-> (head xs,length xs)).factorGroups where
  tryDiv (d,n)
    | n `mod` d == 0 = (d,n `div` d)
    | n == 1 = (1,1) -- hack
    | otherwise = (d+1,n)
  divTrials n = takeWhile (/=(1,1)) $ (2,n): map tryDiv (divTrials n)
  factorGroups = filter (not.null).map tail.group.map fst.divTrials

implement2 :: Show t => Integral t => t -> [(t,Int)]         -- IMPLEMENTATION 2
implement2 num = keep2 $ tail $ go (1,0,1,num) where
  range d n = [d+1..n]
  nextd d n = fromMaybe n $ find ((0==).(n`mod`)) (range d n)
  update (d,e,de,n)
    | n `mod` d == 0 = update (d,e+1,de*d,n`div`d)
    | otherwise      = (d,e,de,n)
  go (d,e,de,1) = [(d,e,de,1)]
  go (d,e,de,n) = (d,e,de,n) : go (update (nextd d n,0,1,n))
  keep2 = map (\(d,e,_,_)->(d,e))

main :: IO ()
main = do
  let n = 293872
  let ans1 = implement1 n 
  let ans2 = implement2 n
  print ans1
  print ans2

性能分析结果显示tryDiv和divTrials合计占用了超过99%的执行时间：

> stack ghc -- -main-is GroupCheck.main -prof -fprof-auto -rtsopts GroupCheck 
> ./GroupCheck +RTS -p >/dev/null && cat GroupCheck.prof


           GroupCheck +RTS -p -RTS

        total time  =       18.34 secs   (18338 ticks @ 1000 us, 1 processor)
        total alloc = 17,561,404,568 bytes  (excludes profiling overheads)

COST CENTRE          MODULE     SRC                          %time %alloc

implement1.divTrials GroupCheck GroupCheck.hs:12:3-69         52.6   69.2
implement1.tryDiv    GroupCheck GroupCheck.hs:(8,3)-(11,25)   47.2   30.8

问题1、1.5：第一种实现性能差的根本原因 #

你预想的列表融合并没有生效，核心问题出在divTrials的实现上：

1. 自递归列表无法触发GHC的build/foldr融合：GHC的列表融合仅对符合build范式的列表生产者生效，比如map、filter、unfoldr、枚举序列等。你写的divTrials n = takeWhile (/=(1,1)) $ (2,n): map tryDiv (divTrials n)是自引用的递归列表生成器，不在融合规则的匹配范围内，所以中间的(d,n)二元组会被实打实分配到堆内存，每一个元素都要经历分配、读取、丢弃的完整流程，17G的内存分配就是直接证据，大量时间都消耗在了内存操作和GC上。
2. 额外的中间结构开销：group函数会为每一组连续相同元素生成一个子列表，后续取head、length、tail、过滤空列表的操作也会产生额外的遍历和内存开销，进一步拉低性能。
3. 显式递归的implement2所有参数都是直接在函数调用时传递，没有中间列表的堆分配开销，所有运算都可以在寄存器或栈上完成，自然性能快得多。

问题2：聚合连续相同块不需要必须写显式递归 #

你不需要完全放弃组合子写法，只要调整写法适配GHC的优化规则即可：

1. 把自递归的divTrials改成用unfoldr实现，unfoldr是标准的生产者，完全支持列表融合，可以避免生成中间的尝试列表。
2. 不要用group生成子列表再计数，直接写一个折叠函数对连续相同元素计数，或者用Data.List.groupWith配合折叠，避免生成中间子列表的开销。
3. 调整后的组合子实现性能可以和显式递归持平，不需要手动写底层递归。

内容的提问来源于stack exchange，提问作者cobra