#haskell
Вопрос:
Я следовал книге Саймона Марлоу о параллельном Хаскелле (глава 1), используя rpar / rseq .
Ниже приведен код (решение симуляции моста в игре Squid):
{-# LANGUAGE FlexibleContexts #-} import Control.DeepSeq (force) import Control.Exception (evaluate) import Control.Parallel.Strategies import Data.Array.IO ( IOUArray, getAssocs, newListArray, readArray, writeArray, ) import Data.Functor ((lt;amp;gt;)) import System.Environment (getArgs) import System.Random (randomRIO) game :: Int -gt; -- number of steps Int -gt; -- number of glass at each step Int -gt; -- number of players IO Int -- return the number of survivors game totalStep totalGlass = go 1 totalGlass where go currentStep currentGlass numSurvivors | numSurvivors == 0 || currentStep gt; totalStep = return numSurvivors | otherwise = do r lt;- randomRIO (1, currentGlass) if r == 1 then go (currentStep 1) totalGlass numSurvivors else go currentStep (currentGlass - 1) (numSurvivors - 1) simulate :: Int -gt; IO Int -gt; IO [(Int, Int)] simulate n game = (newListArray (0, 16) (replicate 17 0) :: IO (IOUArray Int Int)) gt;gt;= go 1 gt;gt;= getAssocs where go i marr | i lt;= n = do r lt;- game readArray marr r gt;gt;= writeArray marr r . ( 1) go (i 1) marr | otherwise = return marr main1 :: IO () main1 = do [n, steps, glassNum, playNum] lt;- getArgs lt;amp;gt; Prelude.map read res lt;- simulate n (game steps glassNum playNum) mapM_ print res main2 :: IO () main2 = do putStrLn "Running main2" [n, steps, glassNum, playNum] lt;- getArgs lt;amp;gt; Prelude.map read res lt;- runEval $ do r1 lt;- rpar $ simulate (div n 2) (game steps glassNum playNum) gt;gt;= evaluate . force r2 lt;- rpar $ simulate (div n 2) (game steps glassNum playNum) gt;gt;= evaluate . force rseq r1 rseq r2 return $ (l1 l2 -gt; zipWith (e1 e2 -gt; (fst e1, snd e1 snd e2)) l1 l2) lt;$gt; r1 lt;*gt; r2 mapM_ print res main = main2 Для main2 я скомпилировал с помощью:
ghc -O2 -threaded ./squid.hs и бежать, как:
./squid 10000000 18 2 16 RTS -N2 Я не могу понять, почему main1 это быстрее, чем main2 в то время main2 как в этом есть параллелизм.
Может ли кто-нибудь дать мне несколько комментариев по моему коду относительно того, правильно ли это использовать параллелизм?
Обновление: Вот обновленная версия (новая random довольно громоздка в использовании):
{-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-} import Control.Monad.ST (ST, runST) import Control.Parallel.Strategies (rpar, rseq, runEval) import Data.Array.ST ( STUArray, getAssocs, newListArray, readArray, writeArray, ) import Data.Functor ((lt;amp;gt;)) import System.Environment (getArgs) import System.Random (StdGen) import System.Random.Stateful ( StdGen, applySTGen, mkStdGen, runSTGen, uniformR, ) game :: Int -gt; -- number of steps Int -gt; -- number of glass at each step Int -gt; -- number of players StdGen -gt; ST s (Int, StdGen) -- return the number of survivors game ns ng = go 1 ng where go !cs -- current step number !cg -- current glass number !ns -- number of survivors !pg -- pure generator | ns == 0 || cs gt; ns = return (ns, pg) | otherwise = do let (r, g') = runSTGen pg (applySTGen (uniformR (1, cg))) if r == 1 then go (cs 1) ng ns g' else go cs (cg - 1) (ns - 1) g' simulate :: Int -gt; (forall s. StdGen -gt; ST s (Int, StdGen)) -gt; [(Int, Int)] simulate n game = runST $ (newListArray (0, 16) (replicate 17 0) :: ST s1 (STUArray s1 Int Int)) gt;gt;= go 1 (mkStdGen n) gt;gt;= getAssocs where go !i !g !marr | i lt;= n = do (r, g') lt;- game g readArray marr r gt;gt;= writeArray marr r . ( 1) go (i 1) g' marr | otherwise = return marr main :: IO () main = do [n, steps, glassNum, playNum] lt;- getArgs lt;amp;gt; Prelude.map read let res = runEval $ do r1 lt;- rpar $ simulate (div n 2 - 1) (game steps glassNum playNum) r2 lt;- rpar $ simulate (div n 2 1) (game steps glassNum playNum) rseq r1 rseq r2 return $ zipWith (e1 e2 -gt; (fst e1, snd e1 snd e2)) r1 r2 mapM_ print res Обновление 2:
Используйте чистый код, и затраченное время сократится до 7 секунд.
{-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-} import Control.Monad.ST ( runST, ST ) import Control.Parallel ( par, pseq ) import Data.Array.ST ( getAssocs, newListArray, readArray, writeArray, STUArray ) import Data.Functor ((lt;amp;gt;)) import System.Environment (getArgs) import System.Random (StdGen, uniformR, mkStdGen) game :: Int -gt; -- number of total steps Int -gt; -- number of glass at each step Int -gt; -- number of players StdGen -gt; (Int, StdGen) -- return the number of survivors game ts ng = go 1 ng where go !cs -- current step number !cg -- current glass number !ns -- number of survivors !pg -- pure generator | ns == 0 || cs gt; ts = (ns, pg) | otherwise = do let (r, g') = uniformR (1, cg) pg if r == 1 then go (cs 1) ng ns g' else go cs (cg - 1) (ns - 1) g' simulate :: Int -gt; (StdGen -gt; (Int, StdGen)) -gt; [(Int, Int)] simulate n game = runST $ (newListArray (0, 16) (replicate 17 0) :: ST s1 (STUArray s1 Int Int)) gt;gt;= go 1 (mkStdGen n) gt;gt;= getAssocs where go !i !g !marr | i lt;= n = do let (r, g') = game g readArray marr r gt;gt;= writeArray marr r . ( 1) go (i 1) g' marr | otherwise = return marr main :: IO () main = do [n, steps, glassNum, playNum] lt;- getArgs lt;amp;gt; Prelude.map read let r1 = simulate (div n 2 - 1) (game steps glassNum playNum) r2 = simulate (div n 2 1) (game steps glassNum playNum) res = zipWith (e1 e2 -gt; (fst e1, snd e1 snd e2)) r1 r2 res' = par r1 (pseq r2 res) mapM_ print res' Комментарии:
1. Я не вижу никаких веских причин использовать
STгенератор на основе этого. Вы можете использоватьStateGenM StdGenсStateT StdGen (ST s), что должно быть быстрее. Или вы можете передавать чистые генераторы вручную, что кажется немного раздражающим.2. @dfeuer спасибо, теперь намного быстрее.
3. @dfeuer я на самом деле использовал чистый генератор и переключил шаблон rpar/rseq на par/pseq
4.
parявляется своего рода неофициально устаревшим, потому что системе времени выполнения трудно определить, когда результат все еще необходим. Я бы не стал этим пользоваться.5. @dfeuer, это сбивает с толку, потому что я видел par в документации последнего руководства ghc, и они используют его в качестве своего рода основного примера…
Ответ №1:
На самом деле вы не используете никакого параллелизма. Ты пишешь
r1 lt;- rpar $ simulate (div n 2) (game steps glassNum playNum) gt;gt;= evaluate . force Это запускает поток для оценки IO действия, а не для его выполнения. Это бесполезно.
Поскольку ваш simulate по сути чистый, вы должны преобразовать его из IO в ST s , поменяв местами соответствующие типы массивов и т. Д. Тогда вы сможете rpar (runST $ simulate ...) и на самом деле работать параллельно. Я не думаю force , что вызовы полезны/уместны в контексте; они освободят массивы раньше, но со значительными затратами.
Комментарии:
1. Я сделал то, что вы предложили, и действительно, это быстрее. Но-N2 все еще медленнее, чем-N1. Это нормально? Кроме того, если я просто запущу его как ./myprog без каких-либо RTS, будет ли программа запускаться автоматически параллельно?
2. @McBearHolden, часто приходится много работать над тем, чтобы параллельный код действительно выигрывал. В этом случае я подозреваю, что вы на самом деле не выполняете достаточно интересной работы в каждом потоке по сравнению с количеством, которое вы делаете, чтобы объединить результаты.