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

Question

应该setInterval通过Javascript 使用,还是使用一些基于线程的惯用解决方案？

Answer 1

利用亚历山大,埃里克和路易特自己setInterval提出的一些挑战和评论让我尝试线程.这无缝地工作,代码非常干净,类似于以下内容:

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

这是我的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没有考虑操作本身所花费的时间。经过 n 次迭代后，操作的开始时间将至少偏离运行该操作 n 次所需的时间！

第二个稻草人解决方案：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约为千分之 n 秒，这在某些用例中可能可以忽略不计。

最终解决方案：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)