使用线程时如何减少时间偏差？

Question

这是尝试编写一段简单的代码，它将获取当前时间并假设在适当的时候触发一个函数。

{-# LANGUAGE BlockArguments, NumericUnderscores #-}

module Main where

import Control.Concurrent
import Control.Monad (forever, forM, void)
import Data.Time.Clock

main :: IO ()
main = forever do
    forkIO writer
    threadDelay 1_000_000

writer :: IO ()
writer = print =<< getCurrentTime

得到这个：

2021-12-13 09:22:08.7632491 UTC
2021-12-13 09:22:09.7687358 UTC
2021-12-13 09:22:10.7756821 UTC
2021-12-13 09:22:11.7772306 UTC
2021-12-13 09:22:12.7954329 UTC
2021-12-13 09:22:13.8096189 UTC
2021-12-13 09:22:14.8218579 UTC
2021-12-13 09:22:15.826626 UTC
2021-12-13 09:22:16.8291541 UTC
2021-12-13 09:22:17.8358406 UTC
2021-12-13 09:22:18.8468617 UTC
2021-12-13 09:22:19.8490381 UTC
2021-12-13 09:22:20.859682 UTC
2021-12-13 09:22:21.868705 UTC
2021-12-13 09:22:22.88392 UTC
2021-12-13 09:22:23.8893969 UTC
2021-12-13 09:22:24.8940725 UTC
2021-12-13 09:22:25.9026013 UTC
2021-12-13 09:22:26.9181843 UTC
2021-12-13 09:22:27.920115 UTC
2021-12-13 09:22:28.9214061 UTC
2021-12-13 09:22:29.9236218 UTC
2021-12-13 09:22:30.9320501 UTC
2021-12-13 09:22:31.9359116 UTC
2021-12-13 09:22:32.9381218 UTC
2021-12-13 09:22:33.9541171 UTC
2021-12-13 09:22:34.9639691 UTC
2021-12-13 09:22:35.9767943 UTC
2021-12-13 09:22:36.9909998 UTC
2021-12-13 09:22:38.0016628 UTC
2021-12-13 09:22:39.0029746 UTC
2021-12-13 09:22:40.01921 UTC
2021-12-13 09:22:41.0337936 UTC
2021-12-13 09:22:42.0369494 UTC
2021-12-13 09:22:43.0403321 UTC
2021-12-13 09:22:44.0426835 UTC
2021-12-13 09:22:45.0468416 UTC
2021-12-13 09:22:46.0503551 UTC
2021-12-13 09:22:47.0557148 UTC
2021-12-13 09:22:48.066979 UTC
2021-12-13 09:22:49.0723431 UTC

您可能已经注意到，这些差异并不准确，timedif 中的错误对我来说可能至关重要。有什么办法可以改善吗？

当不同的线程使用打印功能时尝试了该选项，但从长远来看几乎没有什么区别。

谢谢！

Answer 1

现在，这是您最初问题的答案。秘诀在于，不要总是在事件之间等待一秒钟，而应该跟踪触发时间，始终将其递增一秒，并等待到达下一个触发时间所需的任何时间。它实际上在许多方面与我的其他答案相似：

{-# LANGUAGE NumericUnderscores #-}

module Main where

import Control.Concurrent
import Control.Monad
import Data.Time

main :: IO ()
main = everySecond =<< getCurrentTime

everySecond :: UTCTime -> IO ()
everySecond tick = do
  forkIO writer
  -- next tick in one second
  let nexttick = addUTCTime (secondsToNominalDiffTime 1) tick
  now <- getCurrentTime
  let wait = nominalDiffTimeToSeconds (diffUTCTime nexttick now)
  threadDelay $ ceiling (wait * 1_000_000)
  everySecond nexttick

writer :: IO ()
writer = print =<< getCurrentTime

样本输出：

2021-12-13 21:16:53.316687476 UTC
2021-12-13 21:16:54.318070692 UTC
2021-12-13 21:16:55.31821399 UTC
2021-12-13 21:16:56.318432887 UTC
2021-12-13 21:16:57.318432582 UTC
2021-12-13 21:16:58.318648861 UTC
2021-12-13 21:16:59.317988137 UTC
2021-12-13 21:17:00.318367675 UTC
2021-12-13 21:17:01.318565036 UTC
2021-12-13 21:17:02.317856019 UTC
2021-12-13 21:17:03.318285608 UTC
2021-12-13 21:17:04.318508451 UTC
2021-12-13 21:17:05.318487069 UTC
2021-12-13 21:17:06.318435325 UTC
2021-12-13 21:17:07.318504691 UTC
2021-12-13 21:17:08.318591666 UTC
2021-12-13 21:17:09.317797443 UTC
2021-12-13 21:17:10.317732578 UTC
2021-12-13 21:17:11.318100396 UTC
2021-12-13 21:17:12.318535002 UTC
2021-12-13 21:17:13.318008916 UTC
2021-12-13 21:17:14.317803441 UTC
2021-12-13 21:17:15.318220664 UTC
2021-12-13 21:17:16.318558786 UTC
2021-12-13 21:17:17.31793816 UTC
2021-12-13 21:17:18.322564881 UTC
2021-12-13 21:17:19.318923334 UTC
2021-12-13 21:17:20.318293808 UTC

Answer 2

不完全回答您的问题，但如果您想编写一个程序以在特定时间触发事件，更健壮的设计是：

1. 按时间对（时间、事件）对列表进行排序
2. 休眠列表中的第一个事件时间和当前时间之间的差异
3. 当您醒来时，获取/更新当前时间，然后执行并从列表的前面删除所有时间已“过期”的事件（即当前时间或之前的事件时间）时间）。
4. 如果列表仍为非空，请跳至第 2 步。

这避免了每秒轮询的需要（这可能不是什么大不了的事，但仍然......）并避免了由于您比预期更晚醒来而错过事件的可能性。

下面是一个示例程序。 （此程序依赖threadDelay 将负数视为零，以防事件需要很长时间才能运行，而实际时间超过了第一个未过期的事件。）

{-# LANGUAGE NumericUnderscores #-}

import Data.List
import Data.Time
import Control.Concurrent

data Event = Event
  { eventTime :: UTCTime
  , eventAction :: IO ()
  }

runEvents :: [Event] -> IO ()
runEvents = go . sortOn eventTime
  where go [] = return ()  -- no more events
        go events@(Event firstTime _ : _) = do
          now <- getCurrentTime
          let wait = nominalDiffTimeToSeconds (diffUTCTime firstTime now)
          threadDelay $ ceiling (wait * 1_000_000)
          now' <- getCurrentTime
          let (a, b) = span (expiredAsOf now') events
          mapM eventAction a  -- run the expired events
          go b  -- wait for the rest

        expiredAsOf t e = eventTime e <= t

main = do
  -- some example events
  now <- getCurrentTime
  let afterSeconds = flip addUTCTime now . secondsToNominalDiffTime
      evts = [ Event (afterSeconds 3) (putStrLn "3 seconds")
             , Event (afterSeconds 6) (putStrLn "6 seconds action # 1")
             , Event (afterSeconds 6) (putStrLn "6 seconds action # 2")
             , Event (afterSeconds 7) (putStrLn "Done after 7 seconds")
             ]
  runEvents evts