Keep track of progress of a `map`

Question

I have a map operation (that is actually run in parallel using parMap from Control.Parallel.Strategies) that takes quite a while. Given that I know how many times the function is applied (n in this context), how can I easily display, every once in a while, how many of the n applications have been evaluated?

The obvious solution would be to make the map a mapM with some putStr inside the mapping function, but that would:

• take an unnecessary amount of efficiency
• not sample the status every once in a while but in every applications
• basically remove all the good things about a deterministic algorithm in the context of parallelism

So, is there a way to keep track of this information, that I'm missing, that avoids these problems?

Answer 1

In production you probably shouldn't use trace and are forced to deal with the complications of needing IO, but for tests you could modify the definition of parMap to take another parameter telling when to emit a count:

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

If the work packages given by each list element become to small, you could adapt parListChunk instead accordingly.