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

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

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

按时间对（时间，事件）对列表进行排序
睡眠列表中的第一个事件时间与当前时间之间的差异
当你醒来时，get/update当前时间，并执行并从列表的前面删除所有时间“过期”的事件（即，事件时间等于或早于当前时间）。
如果列表仍然非空，跳到第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

Answer 2

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

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

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

How to reduce the time deviation when using threads?

multithreading

haskell

ghc