Tieni traccia dei progressi di una `mappa`

Question

Ho un'operazione map (che viene effettivamente eseguita in parallelo utilizzando parMap da Control.Parallel.Strategies) che richiede un po 'di tempo. Dato che so quante volte viene applicata la funzione (n in questo contesto), come posso visualizzare facilmente, ogni tanto, quante delle applicazioni n sono state valutate?

La soluzione più ovvia sarebbe quella di fare la mappa di un mapM con alcuni putStr all'interno della funzione di mappatura, ma sarebbe:

• prendere una quantità necessaria di efficienza
• non assaggiare lo stato ogni volta in un mentre ma in ogni applicazioni
• fondamentalmente rimuovere tutte le cose buone di un algoritmo deterministico nel contesto di parallelismo

Quindi, c'è un modo per tenere traccia di questa informazione, che mi manca, che evita questi problemi?

Answer 1

Nella produzione probabilmente non dovrebbe usare traccia e sono costretti ad affrontare le complicazioni di aver bisogno di IO, ma per i test è possibile modificare la definizione di parMap di prendere un altro parametro dire quando per emettere un conteggio:

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

Se i pacchetti di lavoro dati da ciascun elemento di lista diventano troppo piccoli, è possibile adattare parListChunk di conseguenza.

Answer 2

Si potrebbe provare a creare questo comportamento utilizzando 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 

Fare attenzione in quanto ho paura che timeout è interrompere la computazione. Se c'è un altro thread che valuta x dovrebbe andare bene, ma se questo è l'unico thread che lo fa potrebbe causare un livelock se 5 secondi non bastano.