Следите за прогрессом "карты"

У меня есть операция map (которая фактически выполняется параллельно с использованием parMap from Control.Parallel.Strategies), которая занимает довольно много времени. Учитывая, что я знаю, сколько раз функция применяется (n в этом контексте), как я могу время от времени отображать, сколько из приложений n было оценено?

Очевидным решением было бы сделать отображение a mapM с некоторым putStr внутри функции сопоставления, но это:

• возьмите ненужный объем эффективности.
• не проверять статус каждый раз в то время, а в каждом приложении
• в основном удалить все хорошие вещи об детерминированном алгоритме в контексте parallelism

Итак, есть ли способ отслеживать эту информацию, которую мне не хватает, что позволяет избежать этих проблем?

Ответы

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]))

seconds :: Int
seconds = 1000000

progress :: [a] -> IO ()
progress [] = return ()
progress [email protected](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