如何在GHCJS程序中定期執行操作？

Question

應該通過Javascript使用setInterval ，還是使用一些基於線程的慣用解決方案？

Answer 1

使用setInterval提出了亞歷山大，Erik和Luite自己的一些挑戰和評論讓我嘗試了線程。 這無縫地工作，代碼非常干凈，類似於以下內容：

import Control.Concurrent( forkIO, threadDelay )
import Control.Monad( forever )

... within an IO block
threadId <- forkIO $ forever $ do
  threadDelay (60 * 1000 * 1000) -- one minute in microseconds, not milliseconds like in Javascript!
  doWhateverYouLikeHere

Haskell具有輕量級線程的概念，因此這是以異步方式運行動作的慣用Haskell方式，就像使用Javascript setInterval或setTimeout 。

• Hackage
• 現實世界Haskell

Answer 2

如果你不關心動機，只需滾動到我的最佳解決方案runPeriodicallyConstantDrift下面。 如果您更喜歡結果較差的簡單解決方案，請參閱runPeriodicallySmallDrift 。

我的回答不是針對GHCJS的，並且沒有經過GHCJS測試，只有GHC，但它說明了OP天真解決方案的問題 。

第一個runPeriodicallyBigDrift解決方案： runPeriodicallyBigDrift

這是我的OP解決方案的版本，用於下面的比較：

import           Control.Concurrent ( threadDelay )
import           Control.Monad ( forever )

-- | Run @action@ every @period@ seconds.
runPeriodicallyBigDrift :: Double -> IO () -> IO ()
runPeriodicallyBigDrift period action = forever $ do
  action
  threadDelay (round $ period * 10 ** 6)

假設“定期執行一個動作”意味着動作每隔幾個周期開始一次， OP的解決方案threadDelay問題，因為threadDelay沒有考慮動作本身所花費的時間。 在n次迭代之后，動作的開始時間將至少漂移到運行動作n次所需的時間！

第二個runPeriodicallySmallDrift解決方案： runPeriodicallySmallDrift

因此，如果我們實際上想要在每個時段開始新的操作，我們需要考慮操作所需的時間。 如果周期與生成線程所需的時間相比相對較大，那么這個簡單的解決方案可能對您有用：

import           Control.Concurrent ( threadDelay )
import           Control.Concurrent.Async ( async, link )
import           Control.Monad ( forever )

-- | Run @action@ every @period@ seconds.
runPeriodicallySmallDrift :: Double -> IO () -> IO ()
runPeriodicallySmallDrift period action = forever $ do
  -- We reraise any errors raised by the action, but
  -- we don't check that the action actually finished within one
  -- period. If the action takes longer than one period, then
  -- multiple actions will run concurrently.
  link =<< async action
  threadDelay (round $ period * 10 ** 6)

在我的實驗中（下面有更多細節），在我的系統上生成一個線程需要大約0.001秒，因此在n次迭代之后runPeriodicallySmallDrift的漂移大約是千分之一秒，這在某些用例中可以忽略不計。

最終解決方案： runPeriodicallyConstantDrift

最后，假設我們只需要恆定漂移，這意味着漂移總是小於某個常數，並且不會隨着周期動作的迭代次數而增長。 我們可以通過跟蹤自開始以來的總時間來實現恆定漂移，並且當總時間是周期的n倍時開始第n次迭代：

import           Control.Concurrent ( threadDelay )
import           Data.Time.Clock.POSIX ( getPOSIXTime )
import           Text.Printf ( printf )

-- | Run @action@ every @period@ seconds.
runPeriodicallyConstantDrift :: Double -> IO () -> IO ()
runPeriodicallyConstantDrift period action = do
  start <- getPOSIXTime
  go start 1
  where
    go start iteration = do
      action
      now <- getPOSIXTime
      -- Current time.
      let elapsed = realToFrac $ now - start
      -- Time at which to run action again.
      let target = iteration * period
      -- How long until target time.
      let delay = target - elapsed
      -- Fail loudly if the action takes longer than one period.  For
      -- some use cases it may be OK for the action to take longer
      -- than one period, in which case remove this check.
      when (delay < 0 ) $ do
        let msg = printf "runPeriodically: action took longer than one period: delay = %f, target = %f, elapsed = %f"
                  delay target elapsed
        error msg
      threadDelay (round $ delay * microsecondsInSecond)
      go start (iteration + 1)
    microsecondsInSecond = 10 ** 6

基於以下實驗，漂移總是大約1/1000秒，與動作的迭代次數無關。

通過測試比較解決方案

為了比較這些解決方案，我們創建了一個動作來跟蹤它自己的漂移並告訴我們，並在上面的每個runPeriodically*實現中運行它：

import           Control.Concurrent ( threadDelay )
import           Data.IORef ( newIORef, readIORef, writeIORef )
import           Data.Time.Clock.POSIX ( getPOSIXTime )
import           Text.Printf ( printf )

-- | Use a @runPeriodically@ implementation to run an action
-- periodically with period @period@. The action takes
-- (approximately) @runtime@ seconds to run.
testRunPeriodically :: (Double -> IO () -> IO ()) -> Double -> Double -> IO ()
testRunPeriodically runPeriodically runtime period = do
  iterationRef <- newIORef 0
  start <- getPOSIXTime
  startRef <- newIORef start
  runPeriodically period $ action startRef iterationRef
  where
    action startRef iterationRef = do
      now <- getPOSIXTime
      start <- readIORef startRef
      iteration <- readIORef iterationRef
      writeIORef iterationRef (iteration + 1)
      let drift = (iteration * period) - (realToFrac $ now - start)
      printf "test: iteration = %.0f, drift = %f\n" iteration drift
      threadDelay (round $ runtime * 10**6)

以下是測試結果。 在每種情況下，測試運行0.05秒的動作，並使用兩倍的時間，即0.1秒。

對於runPeriodicallyBigDrift ，n次迭代后的漂移大約是單次迭代的運行時間的n倍，如預期的那樣。 在100次迭代之后，漂移為-5.15，並且僅從動作的運行時間預測的漂移為-5.00：

ghci> testRunPeriodically runPeriodicallyBigDrift 0.05 0.1
...
test: iteration = 98, drift = -5.045410253
test: iteration = 99, drift = -5.096661091
test: iteration = 100, drift = -5.148137684
test: iteration = 101, drift = -5.199764033999999
test: iteration = 102, drift = -5.250980596
...

對於runPeriodicallySmallDrift ，n次迭代后的漂移大約為0.001秒，可能是在我的系統上生成線程所需的時間：

ghci> testRunPeriodically runPeriodicallySmallDrift 0.05 0.1
...
test: iteration = 98, drift = -0.08820333399999924
test: iteration = 99, drift = -0.08908210599999933
test: iteration = 100, drift = -0.09006684400000076
test: iteration = 101, drift = -0.09110764399999915
test: iteration = 102, drift = -0.09227584299999947
...

對於runPeriodicallyConstantDrift ，漂移在大約0.001秒內保持不變（加上噪聲）：

ghci> testRunPeriodically runPeriodicallyConstantDrift 0.05 0.1
...
test: iteration = 98, drift = -0.0009586619999986112
test: iteration = 99, drift = -0.0011010979999994674
test: iteration = 100, drift = -0.0011610369999992542
test: iteration = 101, drift = -0.0004908619999977049
test: iteration = 102, drift = -0.0009897379999994627
...

如果我們關心恆定漂移的水平，那么更復雜的解決方案可以跟蹤平均恆定漂移並對其進行調整。

對有狀態周期循環的推廣

在實踐中，我意識到我的一些循環具有從一次迭代傳遞到下一次迭代的狀態。 這是runPeriodicallyConstantDrift的一個小概括，以支持：

import           Control.Concurrent ( threadDelay )
import           Data.IORef ( newIORef, readIORef, writeIORef )
import           Data.Time.Clock.POSIX ( getPOSIXTime )
import           Text.Printf ( printf )

-- | Run a stateful @action@ every @period@ seconds.
--
-- Achieves uniformly bounded drift (i.e. independent of the number of
-- iterations of the action) of about 0.001 seconds,
runPeriodicallyWithState :: Double -> st -> (st -> IO st) -> IO ()
runPeriodicallyWithState period st0 action = do
  start <- getPOSIXTime
  go start 1 st0
  where
    go start iteration st = do
      st' <- action st
      now <- getPOSIXTime
      let elapsed = realToFrac $ now - start
      let target = iteration * period
      let delay = target - elapsed
      -- Warn if the action takes longer than one period. Originally I
      -- was failing in this case, but in my use case we sometimes,
      -- but very infrequently, take longer than the period, and I
      -- don't actually want to crash in that case.
      when (delay < 0 ) $ do
        printf "WARNING: runPeriodically: action took longer than one period: delay = %f, target = %f, elapsed = %f"
          delay target elapsed
      threadDelay (round $ delay * microsecondsInSecond)
      go start (iteration + 1) st'
    microsecondsInSecond = 10 ** 6

-- | Run a stateless @action@ every @period@ seconds.
--
-- Achieves uniformly bounded drift (i.e. independent of the number of
-- iterations of the action) of about 0.001 seconds,
runPeriodically :: Double -> IO () -> IO ()
runPeriodically period action =
  runPeriodicallyWithState period () (const action)