Jak monitorować proces obliczeń w Haskell

Question

Mam funkcję w moim głównym bloku

map anyHeavyFunction [list] 

Chciałbym pokazać pasek postępu podczas procesu obliczeniowego lub dodać dodatkowe czynności (pauza, zatrzymanie procesu itd.) , ale ponieważ map jest czystą funkcją, nie mogę tego zrobić bezpośrednio. Mogę zgadywać, że muszę używać monad, ale jaka monada jest odpowiednia? IO, State?

Answer 1

Wiem, że w hackage jest co najmniej jedna biblioteka, która ma kilka gotowych transformatorów monad do tego zadania, ale zwykle zwracam się do pakietu rur, aby przetasować swój własny, kiedy go potrzebuję. Używam pipe-4.0.0, który będzie w hackage w ten weekend, ale możesz go wcześniej pobrać z github repo.

użyłem również terminal-progress-bar package so that it makes a nice terminal animation as well.

{-# language BangPatterns #-} 

import Pipes 
import qualified Pipes.Prelude as P 

import Control.Monad.IO.Class 

import System.ProgressBar 
import System.IO (hSetBuffering, BufferMode(NoBuffering), stdout) 

-- | Takes the total size of the stream to be processed as l and the function 
-- to map as fn 
progress l = loop 0 
    where 
    loop n = do 
     liftIO $ progressBar (msg "Working") percentage 40 n l 
     !x <- await -- bang pattern to make strict 
     yield x 
     loop (n+1) 

main = do 
    -- Force progress bar to print immediately 
    hSetBuffering stdout NoBuffering 
    let n = 10^6 
    let heavy x = last . replicate n $ x -- time wasting function 
    r <- P.toListM $ each [1..100] >-> P.map heavy >-> progress 100 
    putStrLn "" 
    return r 

To ożywia:

> Working [=>.......................] 7% 

> Working [=====>...................] 20% 

Każda zmiana powoduje skasowanie ostatniego pasek tak to tylko trwać jeden wiersz na terminalu. Następnie kończy się tak:

> main 
Working [=========================] 100% 
[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99,100] 

Answer 2

Można użyć funkcji parMap, aby zastosować kosztowną funkcję równolegle (jeśli pozwalają na to zależności) i listę TVars odpowiadającą każdej liście (lub fragmentowi) elementu (elementów) i ustawić je po ukończeniu odpowiedniej aplikacji. Oddzielny wątek mógł sprawdzić wartości i zaktualizować wyświetlacz (oczywiście działo się tutaj pewne działanie).

Answer 3

Oto (rodzaj) prosta odpowiedź, z której nie jestem zadowolony. Opiera się na fakcie, że @shellenberg chciał zastosować ciężką funkcję na każdym elemencie (podobno długiej) liście. Jeśli wystarczy przesunąć "pasek postępu" raz dla każdego elementu listy, to następujące rozwiązanie można przekształcić w ogólne rozwiązanie.

Przede wszystkim musisz wybrać monadę, w której będziesz pracować. To zależy od tego, jaki dokładnie jest twój "pasek postępu". W tej dyskusji powiedzmy, że monada IO wystarczy i że chcemy na przemian wyświetlać znaki: -, /, | i \. Będziesz także (najprawdopodobniej) potrzebował jakiegoś stanu S (tutaj jest to tylko liczba przetworzonych elementów, dlatego S to Int), więc prawdziwą monadą będzie StateT S IO.

Załóżmy, oryginalny program jest:

m = 100000 -- how many elements the list has 

-- Your (pure) function 
anyHeavyFunction :: Int -> Bool 
anyHeavyFunction n = 
    length [1..n] + length [n+1..4217] == 4217 

-- Your list 
list :: [Int] 
list = take m $ repeat 4217 

-- The main program 
main :: IO() 
main = do 
    let l = map anyHeavyFunction list 
    if and l 
    then putStrLn "OK" 
    else putStrLn "WRONG" 

(Zauważ, że bardzo wygodnie, ciężki funkcja zajmuje tyle samo czasu dla każdego elementu listy.)

ten sposób można go przekształcić aby wyświetlić surowy „pasek postępu”:

import Control.Monad.State 
import System.IO (hFlush, stdout) 

m = 100000 -- how many elements the list has 
k = 5000 -- how often you want to "tick" 

tick :: a -> StateT Int IO a 
tick x = do 
    s <- get 
    put $ s+1 
    when (s `mod` k == 0) $ liftIO $ do 
    let r = (s `div` k) `mod` 4 
    putChar $ "-/|\\" !! r 
    putChar '\b' 
    hFlush stdout 
    x `seq` return x 

-- Your (pure) function 
anyHeavyFunction :: Int -> Bool 
anyHeavyFunction n = 
    length [1..n] + length [n+1..4217] == 4217 

-- Your list 
list :: [Int] 
list = take m $ repeat 4217 

-- The main program 
main :: IO() 
main = do 
    l <- flip evalStateT 0 $ mapM (tick . anyHeavyFunction) list 
    if and l 
    then putStrLn "OK" 
    else putStrLn "WRONG" 

interesujący punkt: seq w tick sił ocenę konsekwencji dla każdy element listy. To wystarczy, jeśli wynik ma podstawowy typ (Bool). W przeciwnym razie nie jest jasne, co chcesz zrobić - pamiętaj, że Haskell jest leniwy!

Jeśli ktoś chce mieć lepszy pasek postępu lub jeśli nie jest zadowolony z założenia, że ​​jeden "tyknięcie" zostanie policzone dla każdego elementu listy, to uważam, że konieczne jest uwzględnienie tykania w logice ciężkiego funkcjonować. To sprawia, że ​​jest brzydka ... Chciałbym zobaczyć, jakie ogólne rozwiązania można do tego zasugerować. Jestem w Haskell, ale myślę, że po prostu jest do bani takie rzeczy jak paski postępu ... Nie ma darmowego lunchu; nie możesz być czysty i leniwy, a twoje paski postępu są łatwe!

---

EDIT: Wersja który wykorzystuje moduł ProgressBar sugerowanego przez @Davorak. Z pewnością wygląda ładniej niż mój obracający się pasek.

import Control.Monad.State 
import System.ProgressBar 
import System.IO (hSetBuffering, BufferMode(NoBuffering), stdout) 

m = 100000 -- how many elements the list has 
k = 5000 -- how often you want to "tick" 

tick :: a -> StateT Int IO a 
tick x = do 
    s <- get 
    put $ s+1 
    when (s `mod` k == 0) $ liftIO $ do 
    progressBar (msg "Working") percentage 40 (toInteger s) (toInteger m) 
    x `seq` return x 

-- Your (pure) function 
anyHeavyFunction :: Int -> Bool 
anyHeavyFunction n = 
    length [1..n] + length [n+1..4217] == 4217 

-- Your list 
list :: [Int] 
list = take m $ repeat 4217 

-- The main program 
main :: IO() 
main = do 
    hSetBuffering stdout NoBuffering 
    l <- flip evalStateT 0 $ mapM (tick . anyHeavyFunction) list 
    if and l 
    then putStrLn "OK" 
    else putStrLn "WRONG" 

Pomysł jest taki sam, wady też.