为什么我的并行代码运行得很差？

Question

我一直在尝试并行化我的 Haskell 代码，但它变得越来越慢，所以我制作了一些示例代码来显示我的问题，这里是串行代码：

module Main where

import System.Environment

sumRangeSquares :: (Num a, Enum a) => a -> a -> a
sumRangeSquares start end = sum $ map (^2) [start .. end]

main :: IO ()
main = do
    [start, end] <- map read <$> getArgs
    print $ sumRangeSquares start end

编译并stack ghc -- -O2 -rtsopts -eventlog -threaded src/Main.hs运行 time ./src/Main 1 10000000，大约 0.4 秒完成

现在明显的并行对应物是：

module Main where

import Control.Parallel.Strategies
import System.Environment

sumRangeSquares :: (Num a, Enum a) => a -> a -> a
sumRangeSquares start end = sum $ parMap rseq (^2) [start .. end]

main :: IO ()
main = do
    [start, end] <- map read <$> getArgs
    print $ sumRangeSquares start end

以同样的方式编译并运行time ./src/Main 1 10000000 +RTS -N4 -lf -s需要超过 6 秒

这是创建的日志-s：

   2,661,959,552 bytes allocated in the heap
   1,891,228,032 bytes copied during GC
     468,753,512 bytes maximum residency (12 sample(s))
     307,102,616 bytes maximum slop
            1226 MiB total memory in use (0 MB lost due to fragmentation)

                                     Tot time (elapsed)  Avg pause  Max pause
  Gen  0      1837 colls,  1837 par   10.483s   2.705s     0.0015s    0.0080s
  Gen  1        12 colls,    11 par    5.157s   1.391s     0.1159s    0.5573s

  Parallel GC work balance: 26.09% (serial 0%, perfect 100%)

  TASKS: 10 (1 bound, 9 peak workers (9 total), using -N4)

  SPARKS: 10000000 (9998153 converted, 1847 overflowed, 0 dud, 0 GC'd, 0 fizzled)

  INIT    time    0.038s  (  0.038s elapsed)
  MUT     time    6.995s  (  2.158s elapsed)
  GC      time   15.639s  (  4.096s elapsed)
  EXIT    time    0.001s  (  0.005s elapsed)
  Total   time   22.673s  (  6.297s elapsed)

  Alloc rate    380,577,209 bytes per MUT second

  Productivity  30.8% of total user, 34.3% of total elapsed


real    0m6.374s
user    0m16.889s
sys 0m5.859s

这是事件日志，如 中所示threadscope Main.eventlog。

如图所示，有大量空闲时间，并且所有四个 HEC 在相对相同的时间运行和空闲。此外，还有大量的长时间空闲时间以及不平衡的火花池和火花创建。

Answer 1

创建新的 CPU 线程的成本很高，并且您要求为每个微小的计算创建一个新的线程。两个整数的乘积比创建一个新线程的成本要低得多。因此，您的机器正忙于创建和终止新线程，而不是做有用的工作。

当你拥有 CPU 时，你必须给它少量昂贵的工作才能获得性能提升。

这可能是一个尴尬但足够的例子：我们保留sumRangeSquare与顺序变体相同的内容，并将范围分成 4 部分，然后使用 运行 4 个并行线程sumRangeSquares，然后将 4 个输出相加得到最终结果。

module Main where

import Control.Parallel.Strategies
import System.Environment

sumRangeSquares :: (Integer, Integer) -> Integer
sumRangeSquares (start, end) = sum $ map (^2) [start .. end]

main :: IO ()
main = do
    [start, end] <- map (read :: (String -> Integer)) <$> getArgs
    let space = [(start+(i-1)*(div (end-start) 4), start+i*(div (end-start) 4)) | i <- [1..3]]
    print $ sum $ parMap rseq sumRangeSquares (space ++ [(snd $ last space, end)])

我使用 1 和 30 000 000 作为参数来获得更重要的结果，我为您提供了顺序变体：

time ./app/Main 1 30000000

real    0m1,353s
user    0m1,350s
sys     0m0,004s

对于我的并行，使用一个线程运行：

time ./app/Main 1 30000000 +RTS -N1 -lf

real    0m1,334s
user    0m1,311s
sys     0m0,022s

对于我的并行，使用四个线程运行：

time ./app/Main 1 30000000 +RTS -N4 -lf

real    0m0,416s
user    0m1,386s
sys     0m0,024s