Как контролировать процесс вычислений в Haskell

у меня есть функция в моем основном блоке

map anyHeavyFunction [list]

Я хотел бы показать индикатор выполнения в процессе вычислений или добавить дополнительные действия (пауза, стоп и т. д.), но потому что map является чистой функцией, я не могу сделать это напрямую. Я могу догадаться, что мне нужно использовать монады, но какая монада подходит? IO, State?

7
haskell

3 ответов

Я знаю, что есть по крайней мере одна библиотека на hackage, которая имеет некоторые готовые трансформаторы монады для этой задачи, но я обычно обращаюсь к пакету труб, чтобы свернуть свой собственный, когда мне это нужно. Я использую pipes-4.0.0 это будет на hackage в эти выходные, но вы можете захватить его из GitHub РЕПО до этого.

Я тоже пакет terminal-progress-bar, чтобы он также делал приятную анимацию терминала.

{-# 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

этот анимирует:

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

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

каждое обновление стирает последний бар, поэтому он занимает только одну строку на терминале. Затем он заканчивается так:

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

вот (своего рода) простой ответ, который меня не устраивает. Он основан на том, что @shellenberg хотел применить тяжелую функцию к каждому элементу (предположительно длинного) списка. Если достаточно переместить "индикатор выполнения" один раз для каждого элемента списка, то следующее можно превратить в общее решение.

прежде всего, вам нужно выбрать монаду, в которой вы будете работать. Это зависит от того, что именно ваш "индикатор выполнения". Для этого обсуждения, скажем что IO монады достаточно и того, что мы хотим, чтобы попеременно отображать символы -, /, | и \. Вам также (скорее всего) понадобится какое-то состояние S (здесь это только количество элементов, обработанных до сих пор, поэтому S и Int), поэтому настоящая монада будет StateT S IO.

предположим, что ваша оригинальная программа:

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"

(обратите внимание, что, очень удобно, тяжелая функция занимает одинаковое время для каждого элемента из списка.)

вот как вы могли бы преобразовать его, чтобы отобразить грубый "индикатор выполнения":

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"

интересный момент:seq на tick заставляет оценку результата для каждого элемента списка. Этого достаточно, если результат имеет базовый тип (Bool здесь). В противном случае неясно, что бы вы хотели сделать-помните, что Хаскелл ленив!

если вы хотите более тонкий индикатор выполнения или если вы не удовлетворены предположением, что один " тик " будет подсчитан для каждого элемента списка, тогда я считаю необходимым включить тиканье в логику тяжелой функции. Это делает его уродливым... Я хотел бы посмотреть, какие общие решения можно предложить для этого. Я все за Хаскелла, но я думаю, что это просто отстой для таких вещей, как прогресс-бары... Там нет бесплатного обеда; вы не можете быть чистыми и ленивыми и иметь ваши прогресс-бары легко!

EDIT: версия, которая использует ProgressBar модуль, предложенный @Davorak. Это, конечно, выглядит лучше, чем мой вращающийся бар.

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"

идея та же, недостатки тоже.

2

можно использовать parMap применять дорогостоящую функцию параллельно (если позволяют зависимости) и список TVars соответствует каждому списку (или куску) элемента (ов) и устанавливает их после завершения соответствующего приложения функции. Отдельный поток может проверить значения и обновить дисплей (очевидно, некоторые IO действие произойдет здесь).

0