Compute as much of a list as possible in a fixed time

haskell, time, timeout

Solution

Here's an example I was able to cook up using some of the suggestions above. I've not done huge amounts of testing to ensure work is cut off exactly when the timer runs out, but based on the docs for `timeout`, this should work for all things not using 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:)

Now let's try it on something costly:

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]

Compiled and run with `time`, it seems to work (obviously there is some overhead outside the timed portion, but I'm at roughly 100ms:

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

Also, something to note about this approach; since I'm enclosing the entire operation of running the computations and pushing them onto the tvar inside one call to `timeout`, some time here is likely lost in creating the return structure, though I'm assuming (if your computations are costly) it won't account or much of your overall time.

Update

Now that I've had some time to think about it, due to Haskell's laziness, I'm not 100% positive the note above (about time-spent creating the return structure) is correct; either way, let me know if this is not precise enough for what you are trying to accomplish.

Problem

I want to write a function that takes a time limit (in seconds) and a list, and computes as many elements of the list as possible within the time limit. My first attempt was to first write the following function, which times a pure computation and returns the time elapsed along with the result: ``` 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) ``` I can then define the function I want in terms of this: ``` 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) ``` This isn't quite right though. Even ignoring timing errors and floating point errors, this approach never stops the computation of an element of the list once it has started, which means that it can (and in fact, normally will) overrun its time limit. If instead I had a function that could short-circuit evaluation if it had taken too long: ``` timeOut :: Time -> a -> IO (Maybe (a,t)) timeOut = undefined ``` then I could write the function that I really want: ``` 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) ``` My questions are: - How do I write `timeOut`? - Is there a better way to write the function `timeLimited`, for example, one that doesn't suffer from accumulated floating point error from adding up time differences multiple times?

Original source