Question

我想编写一个占用时间限制（以秒为单位）和列表的函数，并在时间限制内尽可能多地计算列表中的元素。

我的第一次尝试是首先编写以下函数，该函数计算纯计算并返回结果所用的时间：

import Control.DeepSeq
import System.CPUTime

type Time = Double

timed :: (NFData a) => a -> IO (a, Time)
timed x = do t1 <- getCPUTime
             r  <- return $!! x
             t2 <- getCPUTime
             let diff = fromIntegral (t2 - t1) / 10^12
             return (r, diff)

然后我可以根据这个来定义我想要的功能：

timeLimited :: (NFData a) => Time -> [a] -> IO [a]
timeLimited remaining []     = return []
timeLimited remaining (x:xs) = if remaining < 0
    then return []
    else do
        (y,t) <- timed x
        ys    <- timeLimited (remaining - t) xs
        return (y:ys)

但这并不完全正确。即使忽略了定时错误和浮点错误，这种方法一旦启动就不会停止计算列表中的元素，这意味着它可以（实际上通常会）超出其时间限制。

如果相反，我有一个可以在评估时间过长的情况下进行短路评估的功能：

timeOut :: Time -> a -> IO (Maybe (a,t))
timeOut = undefined

然后我可以编写我真正想要的功能：

timeLimited' :: Time -> [a] -> IO [a]
timeLimited' remaining []     = return []
timeLimited' remaining (x:xs) = do
    result <- timeOut remaining x
    case result of
        Nothing    -> return []
        Just (y,t) -> do
            ys <- timeLimited' (remaining - t) xs
            return (y:ys)

我的问题是：

如何撰写timeOut？
是否有更好的方法来编写函数timeLimited，例如，一个不会因多次累加时间差而出现累积浮点错误的函数？

Answer 1

这是一个我能够使用上面的一些建议做饭的例子。我没有进行大量的测试以确保在计时器用完时切断工作，但根据timeout的文档，这应该适用于所有不使用FFI的东西。

import Control.Concurrent.STM
import Control.DeepSeq
import System.Timeout

type Time = Int

-- | Compute as many items of a list in given timeframe (microseconds)
--   This is done by running a function that computes (with `force`)
--   list items and pushed them onto a `TVar [a]`.  When the requested time
--   expires, ghc will terminate the execution of `forceIntoTVar`, and we'll
--   return what has been pushed onto the tvar.
timeLimited :: (NFData a) => Time -> [a] -> IO [a]
timeLimited t xs = do
    v <- newTVarIO []
    _ <- timeout t (forceIntoTVar xs v)
    readTVarIO v 

-- | Force computed values into given tvar
forceIntoTVar :: (NFData a) => [a] -> TVar [a] -> IO [()]
forceIntoTVar xs v = mapM (atomically . modifyTVar v . forceCons) xs

-- | Returns function that does actual computation and cons' to tvar value
forceCons :: (NFData a) => a -> [a] -> [a]
forceCons x = (force x:)

现在让我们尝试一下代价高昂的东西：

main = do
    xs <- timeLimited 100000 expensiveThing   -- run for 100 milliseconds
    print $ length $ xs  -- how many did we get?

-- | Some high-cost computation
expensiveThing :: [Integer]
expensiveThing = sieve [2..]
  where
      sieve (p:xs) = p : sieve [x|x <- xs, x `mod` p > 0]

编译并运行time，它似乎有效（显然在定时部分之外有一些开销，但我大概是100ms：

$ time ./timeLimited
1234
./timeLimited  0.10s user 0.01s system 97% cpu 0.112 total

此外，有关此方法的注意事项;因为我正在围绕运行计算的整个操作并在一次调用timeout内将它们推到tvar上，所以这里的一些时间可能会在创建返回结构时丢失，尽管我假设（如果你的计算是昂贵的）它不会占你的总时间。

<强>更新

现在我已经有时间考虑一下，由于Haskell的懒惰，我不是100％肯定上面的注释（关于创建返回结构的时间）是正确的;无论哪种方式，如果这对于你想要完成的事情不够精确，请告诉我。

Answer 2

您可以使用timeout和evaluate为您提供的类型实施timeOut。它看起来像这样（我省略了计算剩余时间的部分 - 使用getCurrentTime或类似的部分）：

timeoutPure :: Int -> a -> IO (Maybe a)
timeoutPure t a = timeout t (evaluate a)

如果你想要更强迫而不仅仅是弱头普通形式，你可以使用已经seq'd参数来调用它，例如： timeoutPure (deepseq v)代替timeoutPure v。

Answer 3

我会将两个线程与TVars一起使用，并在达到超时时在计算线程中引发异常（导致每个正在进行的事务被回滚）：

forceIntoTVar :: (NFData a) => [a] -> TVar [a] -> IO [()]
forceIntoTVar xs v = mapM (atomically . modifyTVar v . forceCons) xs

-- | Returns function that does actual computation and cons' to tvar value
forceCons :: (NFData a) => a -> [a] -> [a]
forceCons x = (force x:)

main = do

  v <- newTVarIO []
  tID <- forkIO $ forceIntoTVar args v
  threadDelay 200
  killThread tID
  readTVarIO v

在这个例子中，您（可能）需要稍微调整forceIntoTVar，以便例如列表节点在原子事务中是 NOT computet，但首先计算，然后开始原子事务将它们集中到列表中。

在任何情况下，当引发异常时，将回滚正在进行的事务，或者在结果被分配到列表之前停止正在进行的计算，这就是您想要的。

您需要考虑的是，当准备节点的各个计算以高频率运行时，与不使用STM相比，此示例可能非常昂贵。

在固定时间内尽可能多地计算列表

3 个答案: