Question

假设：

module Main where

import Control.Parallel.Strategies
import Control.Applicative

--main :: IO ()
--main = putStrLn . show $ spark [1..40]

main :: IO ()
main = putStrLn . show . runEval $ splitIt [1..40]

fib :: Int -> Int
fib x 
 | x <= 1    = 1
 | otherwise = fib (x-1) + fib (x-2)


spark :: [Int] -> [Int]
spark = parMap rpar  fib 

splitIt :: [Int] -> Eval [Int]
splitIt xs = let len = length xs
                 (as, bs) = splitAt (len `div` 2) xs
             in
              do
                xs <- fibPar as
                ys <- fibPar bs
                return $ xs ++ ys

fibPar :: [Int] -> Eval [Int]
fibPar []     = return []
fibPar (x:xs) = do
    a  <- rpar $ fib x
    as <- fibPar xs
    return $ a : as

我写了两种计算[1..40]每个元素的斐波纳契的方法。从Parallel and Concurrent Programming in Haskell开始，我以两种方式并行运行斐波纳契：

（1）在整个列表中使用parMap。（第一main）（2）将列表切成两半，用rpar（第二main）分割每项工作

通过阅读上述文字，我希望＃1更快：

这说明了并行化代码时的一个重要原则：尽量避免将工作划分为一小块固定数量的块。

我通过以下方式编译并运行了两个（仅包括1个main，注释掉了另一个）

编译 - ghc -O2 Fib.hs -threaded -rtsopts -eventlog
run - .\Fib.exe +RTS -N2 -s

以下是（1）和（2）的结果：

（1） - 使用parMap

 Tot time (elapsed)  Avg pause  Max pause
  Gen  0         0 colls,     0 par    0.000s   0.000s     0.0000s    0.0000s
  Gen  1         2 colls,     1 par    0.000s   0.000s     0.0001s    0.0001s

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

  TASKS: 4 (1 bound, 3 peak workers (3 total), using -N2)

  SPARKS: 80 (74 converted, 0 overflowed, 0 dud, 0 GC'd, 6 fizzled)

  INIT    time    0.000s  (  0.000s elapsed)
  MUT     time    8.594s  (  4.331s elapsed)
  GC      time    0.000s  (  0.000s elapsed)
  EXIT    time    0.000s  (  0.000s elapsed)
  Total   time    8.594s  (  4.332s elapsed)

  Alloc rate    12,259 bytes per MUT second

  Productivity 100.0% of total user, 198.4% of total elapsed

（2） - 拆分列表+每半使用rpar

                                     Tot time (elapsed)  Avg pause  Max pause
  Gen  0         0 colls,     0 par    0.000s   0.000s     0.0000s    0.0000s
  Gen  1         2 colls,     1 par    0.000s   0.000s     0.0002s    0.0003s

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

  TASKS: 4 (1 bound, 3 peak workers (3 total), using -N2)

  SPARKS: 40 (10 converted, 0 overflowed, 0 dud, 0 GC'd, 30 fizzled)

  INIT    time    0.000s  (  0.001s elapsed)
  MUT     time    7.453s  (  3.751s elapsed)
  GC      time    0.000s  (  0.000s elapsed)
  EXIT    time    0.000s  (  0.000s elapsed)
  Total   time    7.453s  (  3.752s elapsed)

  Alloc rate    14,398 bytes per MUT second

  Productivity 100.0% of total user, 198.6% of total elapsed

为什么不是，据我理解提示的文字，parMap版本比拆分+ rpar版本更快？

Answer 1

首先请注意，计算fib n所需的工作是指数级的。这意味着计算map fib [1..n]与计算fib (n+1)的时间大致相同。要查看此信息，只需打印为fib n的各种值计算n所需的时间：

import System.TimeIt
import Control.Monad
...
main = forM_ [1..40] $ \n -> timeIt $ print (fib n)

要使用两个线程有效地计算map fib [1..40]，您希望尽可能均衡每个线程完成的工作量。事实证明，一个工作得很好的分工是让一个线程计算map fib [1..38]而另一个计算[fib 39, fib 40]。

如果为每个fib i计算创建一个spark，则两个线程之间的分工完全是不确定的。为了平衡每个线程所做的工作，你实际上想要仔细制作火花是什么。

现在看看你的两个程序中创建的火花数量 - 一个80个，另一个40个。很明显，每个fib i都会被激发，这意味着在这两种情况下，fib i计算都会被随机分配给两个线程。

这是一种通过两个线程获得大约1.5的加速的方法：

import Control.Parallel.Strategies

fib :: Int -> Int
fib x 
 | x <= 1    = 1
 | otherwise = fib (x-1) + fib (x-2)

main = do
  let fs = (map fib [1..40]) `using` parListSplitAt 38 rdeepseq rdeepseq
  print fs

如果您查看RTS摘要，您会看到它只会创建两个火花 - 一个用于map fib [1..38]，另一个用于map fib [39,40]。

关于80个火花......如果你使用parMap rseq代替parMap rpar，产生的火花数量会下降到40个。所以很明显parMap rpar正在创造一个火花火花是完全多余的。总的来说，我会坚持rdeepseq作为一种评估策略 - 它更简单，更容易推理，更不容易出错。

Answer 2

我不确定接下来是否是影响时间的唯一因素，但它确实起到了重要作用。

使用列表，将此工作拆分为

效率很低

请记住，并行开始执行只需要很少的工作，因此开始为列表中的每个元素执行某些操作的最快方法就是一个接一个地运行它们并使用rpar激发它们。这就是parMap所做的。

在你的情况下，splitAt要做的工作要多得多：它需要遍历列表的一半，然后为另一个列表分配空间。您可能会在此遍历期间引发fib执行。

要了解我的意思，请尝试将[1..40]替换为(replicate 1000 35)。这更加可并行化：许多相当困难的问题，同样的困难。使用1000个元素长列表，splitIt运行超过100秒，而spark运行不到1秒。 您的解决方案最终会将大部分时间用于拆分和附加列表而不是计算任何内容。

理解Haskell并行Fibonacci结果

2 个答案: