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

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

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

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

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

Ответ 1

В производстве вы, вероятно, не должны использовать трассировку и вынуждены иметь дело с осложнениями, связанными с 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.

Ответ 2

Можно попытаться создать такое поведение, используя timeout.

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

Будьте осторожны, так как я боюсь, что timeout прерывает вычисление. Если есть другой поток, который оценивает x, это должно быть хорошо, но если это единственный поток, который может вызвать ожидание, если 5 секунд недостаточно.