我使用rpar/閱讀了 Simon Marlow 關于并行 Haskell 的書（第 1 章）rseq。
下面是代碼（解決魷魚游戲橋模擬）：
{-# 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 ((<&>))
import System.Environment (getArgs)
import System.Random (randomRIO)
game ::
Int -> -- number of steps
Int -> -- number of glass at each step
Int -> -- number of players
IO Int -- return the number of survivors
game totalStep totalGlass = go 1 totalGlass
where
go currentStep currentGlass numSurvivors
| numSurvivors == 0 || currentStep > totalStep = return numSurvivors
| otherwise = do
r <- randomRIO (1, currentGlass)
if r == 1
then go (currentStep 1) totalGlass numSurvivors
else go currentStep (currentGlass - 1) (numSurvivors - 1)
simulate :: Int -> IO Int -> IO [(Int, Int)]
simulate n game =
(newListArray (0, 16) (replicate 17 0) :: IO (IOUArray Int Int))
>>= go 1
>>= getAssocs
where
go i marr
| i <= n = do
r <- game
readArray marr r >>= writeArray marr r . ( 1)
go (i 1) marr
| otherwise = return marr
main1 :: IO ()
main1 = do
[n, steps, glassNum, playNum] <- getArgs <&> Prelude.map read
res <- simulate n (game steps glassNum playNum)
mapM_ print res
main2 :: IO ()
main2 = do
putStrLn "Running main2"
[n, steps, glassNum, playNum] <- getArgs <&> Prelude.map read
res <- runEval $ do
r1 <- rpar $ simulate (div n 2) (game steps glassNum playNum) >>= evaluate . force
r2 <- rpar $ simulate (div n 2) (game steps glassNum playNum) >>= evaluate . force
rseq r1
rseq r2
return $
(\l1 l2 -> zipWith (\e1 e2 -> (fst e1, snd e1 snd e2)) l1 l2)
<$> r1
<*> 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 ((<&>))
import System.Environment (getArgs)
import System.Random (StdGen)
import System.Random.Stateful
( StdGen,
applySTGen,
mkStdGen,
runSTGen,
uniformR,
)
game ::
Int -> -- number of steps
Int -> -- number of glass at each step
Int -> -- number of players
StdGen ->
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 > 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 -> (forall s. StdGen -> ST s (Int, StdGen)) -> [(Int, Int)]
simulate n game =
runST $
(newListArray (0, 16) (replicate 17 0) :: ST s1 (STUArray s1 Int Int))
>>= go 1 (mkStdGen n)
>>= getAssocs
where
go !i !g !marr
| i <= n = do
(r, g') <- game g
readArray marr r >>= writeArray marr r . ( 1)
go (i 1) g' marr
| otherwise = return marr
main :: IO ()
main = do
[n, steps, glassNum, playNum] <- getArgs <&> Prelude.map read
let res = runEval $ do
r1 <- rpar $ simulate (div n 2 - 1) (game steps glassNum playNum)
r2 <- rpar $ simulate (div n 2 1) (game steps glassNum playNum)
rseq r1
rseq r2
return $ zipWith (\e1 e2 -> (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 ((<&>))
import System.Environment (getArgs)
import System.Random (StdGen, uniformR, mkStdGen)
game ::
Int -> -- number of total steps
Int -> -- number of glass at each step
Int -> -- number of players
StdGen ->
(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 > 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 -> (StdGen -> (Int, StdGen)) -> [(Int, Int)]
simulate n game =
runST $
(newListArray (0, 16) (replicate 17 0) :: ST s1 (STUArray s1 Int Int))
>>= go 1 (mkStdGen n)
>>= getAssocs
where
go !i !g !marr
| i <= n = do
let (r, g') = game g
readArray marr r >>= writeArray marr r . ( 1)
go (i 1) g' marr
| otherwise = return marr
main :: IO ()
main = do
[n, steps, glassNum, playNum] <- getArgs <&> 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 -> (fst e1, snd e1 snd e2)) r1 r2
res' = par r1 (pseq r2 res)
mapM_ print res'
uj5u.com熱心網友回復：
您實際上并沒有使用任何并行性。你寫
r1 <- rpar $ simulate (div n 2) (game steps glassNum playNum) >>= evaluate . force
這會觸發一個執行緒來評估一個IO動作，而不是運行它。那沒用。
由于您simulate的本質上是pure，您應該通過交換適當的陣列型別等IO來將其從 轉換為ST s。然后您就可以rpar (runST $ simulate ...)并實際進行并行作業。我認為這些force呼叫在背景關系中沒有用/不合適；他們會更快地釋放陣列，但成本很高。
轉載請註明出處，本文鏈接：https://www.uj5u.com/caozuo/347707.html
標籤：哈斯克尔
上一篇：使用rank-N型別翻轉