异步代码在haskell中运行速度比同步版本慢

Question

对以下内容进行基准测试：

#!/usr/bin/env stack
-- stack --resolver lts-16.2 script --package async --package criterion

import           Control.Concurrent.Async (async, replicateConcurrently_)
import           Control.Monad            (replicateM_, void)
import           Criterion.Main

main :: IO ()
main = defaultMain [
    bgroup "tests" [ bench "sync" $ nfIO syncTest
                   , bench "async" $ nfIO asyncTest
                   ]
    ]

syncTest :: IO ()
syncTest = replicateM_ 100000 dummy

asyncTest :: IO ()
asyncTest = replicateConcurrently_ 100000 dummy

dummy :: IO Int
dummy = return $ fib 10000000000

fib :: Int -> Int
fib 0 = 1
fib 1 = 1
fib n = fib (n - 1) + fib (n - 2)

给我这个：

% ./applicative-v-monad.hs
benchmarking tests/sync
time                 2.120 ms   (2.075 ms .. 2.160 ms)
                     0.997 R²   (0.994 R² .. 0.999 R²)
mean                 2.040 ms   (2.023 ms .. 2.073 ms)
std dev              77.37 ?s   (54.96 ?s .. 122.8 ?s)
variance introduced by outliers: 23% (moderately inflated)

benchmarking tests/async
time                 475.3 ms   (310.7 ms .. 642.8 ms)
                     0.984 R²   (0.943 R² .. 1.000 R²)
mean                 527.2 ms   (497.9 ms .. 570.9 ms)
std dev              41.30 ms   (4.833 ms .. 52.83 ms)
variance introduced by outliers: 21% (moderately inflated)

很明显 asyncTest 的运行时间比 syncTest 长。

我原以为并发运行昂贵的操作会比按顺序运行它们更快。我的推理有什么缺陷吗？

Answer 1

这个基准测试存在一些问题。

首先是懒惰

正如@David Fletcher 指出的那样，您并不是在强制计算 fib。解决这个问题通常很简单：

dummy :: IO Int
dummy = return $! fib 10000000000

这足以让我们等待永恒。将其降低到更易于管理的程度是我们接下来应该做的事情：

dummy :: IO Int
dummy = return $! fib 35

这通常就足够了，但是 ghc 太聪明了，它会看到这个计算真的很纯粹，并且会将 100000 次迭代的循环优化为单个计算并返回 100000 次相同的结果，因此实际上它只会计算这个 fib一次。相反，让 makefib取决于迭代次数：

xs :: [Int]
xs = [1..35]

syncTest :: IO ()
syncTest = mapM_ dummy xs

asyncTest :: IO ()
asyncTest = mapConcurrently_ dummy xs

dummy :: Int -> IO Int
dummy n = return $! fib n

下一个问题是编译

stack script将在没有线程环境的情况下运行经过迭代的代码。因此，您的代码将缓慢且按顺序运行。我们通过手动编译和一些标志来修复它：

$ stack exec --resolver lts-16.2 --package async --package criterion -- ghc -threaded -O2 -rtsopts -with-rtsopts=-N bench-async.hs
$ stack exec --resolver lts-16.2 -- ./bench-async

当然，对于一个完整的堆栈项目，所有这些标志都进入一个 cabal 文件，运行stack bench将完成剩下的工作。

最后但并非最不重要的。线程太多。

在你的问题中asyncTest = replicateConcurrently_ 100000 dummy。除非迭代次数非常低，事实并非如此，否则您不想为此使用async它，因为产生至少 100000 个线程不是免费的，最好对此类工作负载使用工作窃取调度程序。我专门为此编写了一个库：scheduler

这是一个如何使用它的示例：

import qualified Control.Scheduler as S

main :: IO ()
main = defaultMain [
    bgroup "tests" [ bench "sync" $ whnfIO syncTest
                   , bench "async" $ nfIO asyncTest
                   , bench "scheduler" $ nfIO schedulerTest
                   ]
    ]
schedulerTest :: IO ()
schedulerTest = S.traverseConcurrently_ S.Par dummy xs

现在这将为我们提供更合理的数字：

benchmarking tests/sync
time                 246.7 ms   (210.6 ms .. 269.0 ms)
                     0.989 R²   (0.951 R² .. 1.000 R²)
mean                 266.4 ms   (256.4 ms .. 286.0 ms)
std dev              21.60 ms   (457.3 ?s .. 26.92 ms)
variance introduced by outliers: 18% (moderately inflated)

benchmarking tests/async
time                 135.4 ms   (127.8 ms .. 147.9 ms)
                     0.992 R²   (0.980 R² .. 1.000 R²)
mean                 134.8 ms   (129.7 ms .. 138.0 ms)
std dev              6.578 ms   (3.605 ms .. 9.807 ms)
variance introduced by outliers: 11% (moderately inflated)

benchmarking tests/scheduler
time                 109.0 ms   (96.83 ms .. 120.3 ms)
                     0.989 R²   (0.956 R² .. 1.000 R²)
mean                 111.5 ms   (108.0 ms .. 120.2 ms)
std dev              7.574 ms   (2.496 ms .. 11.85 ms)
variance introduced by outliers: 12% (moderately inflated)