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

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)

我的问题是:

1. 我怎么写timeOut？
2. 是否有更好的方法来编写函数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

此外,有关此方法的注意事项; 因为我正在封闭运行计算的整个操作并在一次调用中将它们推送到tvar timeout,这里有一段时间可能会在创建返回结构时丢失,尽管我假设(如果你的计算成本很高)它赢了"帐户或大部分时间.

更新

现在我已经有时间考虑一下,由于Haskell的懒惰,我不是100%肯定上面的注释(关于创建返回结构的时间)是正确的; 无论哪种方式,让我知道这是不是足够精确,你想要完成什么.