跟踪“地图”的进度
Keep track of progress of a `map`
我有一个 map
操作(实际上是 运行 并行使用 Control.Parallel.Strategies
中的 parMap
)需要相当长的时间。鉴于我知道该函数被应用了多少次(在此上下文中为 n
),我如何轻松地每隔一段时间显示有多少 n
应用程序已被评估?
最明显的解决方案是将映射设为 mapM
,在映射函数中包含一些 putStr
,但那样会:
- 不必要地提高效率
- 不是每隔一段时间采样状态,而是在每个应用程序中采样
- 基本上删除了并行上下文中确定性算法的所有优点
那么,有没有一种方法可以跟踪我丢失的这些信息,从而避免这些问题?
可以尝试使用 timeout 来制作此行为。
seconds :: Int
seconds = 1000000
progress :: [a] -> IO ()
progress [] = return ()
progress l@(x:xs) =
do r <- timeout (5 * seconds) x -- 5s
threadDelay (2 * seconds) -- 2s more delay
case r of
Nothing -> progress l -- retry
Just y -> do putStrLn "one done!"
progress xs
小心,因为我担心 timeout
正在中止计算。如果有另一个线程评估 x
应该没问题,但如果这是唯一一个执行此操作的线程,如果 5 秒不够,它可能会导致活锁。
在生产中你可能不应该使用跟踪并且被迫处理需要 IO 的复杂情况,但对于测试你可以修改 parMap 的定义以采用另一个参数来告诉何时发出计数:
import Control.Monad (sequence)
import Control.Parallel.Strategies (Strategy, using, rseq, rparWith, parMap)
import Debug.Trace (traceShow)
import System.IO (hFlush, hSetBuffering, BufferMode(NoBuffering), stdout)
evalList' :: Integer -> Strategy a -> Strategy [a]
evalList' t s as = sequence $ foldr f [] $ zip as [1..]
where f (a, n) ss | n `mod` t == 0 = s (traceShow n a):ss
| otherwise = s a:ss
parList' :: Integer -> Strategy a -> Strategy [a]
parList' t s = evalList' t (rparWith s)
parMap' :: Integer -> Strategy b -> (a -> b) -> [a] -> [b]
parMap' t s f xs = map f xs `using` parList' t s
-- some work to do
fib :: Integer -> Integer
fib 0 = 1
fib 1 = 1
fib n = fib (n-1) + fib(n-2)
main = do hSetBuffering stdout NoBuffering
print $ sum (parMap' 1000 rseq (fib.(+20).(`mod` 5)) ([1..10000]::[Integer]))
如果每个列表元素给出的工作包变小,你可以相应地修改parListChunk。
我有一个 map
操作(实际上是 运行 并行使用 Control.Parallel.Strategies
中的 parMap
)需要相当长的时间。鉴于我知道该函数被应用了多少次(在此上下文中为 n
),我如何轻松地每隔一段时间显示有多少 n
应用程序已被评估?
最明显的解决方案是将映射设为 mapM
,在映射函数中包含一些 putStr
,但那样会:
- 不必要地提高效率
- 不是每隔一段时间采样状态,而是在每个应用程序中采样
- 基本上删除了并行上下文中确定性算法的所有优点
那么,有没有一种方法可以跟踪我丢失的这些信息,从而避免这些问题?
可以尝试使用 timeout 来制作此行为。
seconds :: Int
seconds = 1000000
progress :: [a] -> IO ()
progress [] = return ()
progress l@(x:xs) =
do r <- timeout (5 * seconds) x -- 5s
threadDelay (2 * seconds) -- 2s more delay
case r of
Nothing -> progress l -- retry
Just y -> do putStrLn "one done!"
progress xs
小心,因为我担心 timeout
正在中止计算。如果有另一个线程评估 x
应该没问题,但如果这是唯一一个执行此操作的线程,如果 5 秒不够,它可能会导致活锁。
在生产中你可能不应该使用跟踪并且被迫处理需要 IO 的复杂情况,但对于测试你可以修改 parMap 的定义以采用另一个参数来告诉何时发出计数:
import Control.Monad (sequence)
import Control.Parallel.Strategies (Strategy, using, rseq, rparWith, parMap)
import Debug.Trace (traceShow)
import System.IO (hFlush, hSetBuffering, BufferMode(NoBuffering), stdout)
evalList' :: Integer -> Strategy a -> Strategy [a]
evalList' t s as = sequence $ foldr f [] $ zip as [1..]
where f (a, n) ss | n `mod` t == 0 = s (traceShow n a):ss
| otherwise = s a:ss
parList' :: Integer -> Strategy a -> Strategy [a]
parList' t s = evalList' t (rparWith s)
parMap' :: Integer -> Strategy b -> (a -> b) -> [a] -> [b]
parMap' t s f xs = map f xs `using` parList' t s
-- some work to do
fib :: Integer -> Integer
fib 0 = 1
fib 1 = 1
fib n = fib (n-1) + fib(n-2)
main = do hSetBuffering stdout NoBuffering
print $ sum (parMap' 1000 rseq (fib.(+20).(`mod` 5)) ([1..10000]::[Integer]))
如果每个列表元素给出的工作包变小,你可以相应地修改parListChunk。