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一次。 相反，讓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

當然，對於一個完整的堆棧項目，所有這些標志 go 到一個 cabal 文件中，運行stack bench將執行 rest。

最后但並非最不重要的。 線程太多。

在問題中，您有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)