Блог

Сравнение следующего:

 #!/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.

Я бы подумал, что одновременное выполнение дорогостоящих действий будет быстрее, чем выполнение их последовательно. Есть ли какой-то недостаток в моих рассуждениях?

С этим тестом есть несколько проблем.

Прежде всего, лень

Как указал @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)