haskell - 异步代码在 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 长。

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

Answer 1

此基准测试存在一些问题。

首先是懒惰

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

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

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

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

这通常就足够了，但是 ghc 太聪明了，它会发现这个计算真的很纯粹，会将 100000 次迭代的循环优化为一次计算，并返回相同的结果 100000 次，所以实际上它会计算这个小谎只有一次。相反，让 fib 取决于迭代次数:

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)