Calcular la mayor cantidad de una lista posible en un tiempo fijo

Question

Quiero escribir una función que tome un límite de tiempo (en segundos) y una lista, y calcule tantos elementos de la lista como sea posible dentro del límite de tiempo.

Mi primer intento fue escribir primero la función siguiente, que veces un cálculo puro y devuelve el tiempo transcurrido, junto con el resultado:

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) 

Entonces puede definir la función que quiero en términos de lo siguiente:

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) 

Esto no es del todo correcto. Incluso ignorando los errores de sincronización y los errores de punto flotante, este enfoque nunca detiene el cálculo de un elemento de la lista una vez que ha comenzado, lo que significa que puede (y de hecho, normalmente lo hará) superar su límite de tiempo.

Si en lugar de eso tenía una función que podría Evaluación cortocircuito si se hubiera tomado demasiado tiempo:

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

entonces podría escribir la función que realmente quiero:

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) 

Mis preguntas son:

1. ¿Cómo escribo timeOut?
2. ¿Existe alguna forma mejor de escribir la función timeLimited, por ejemplo, una que no tenga un error de punto flotante acumulado al sumar diferencias de tiempo varias veces?

Answer 1

Aquí hay un ejemplo que pude cocinar usando algunas de las sugerencias anteriores. No he realizado una gran cantidad de pruebas para asegurarme de que el trabajo se corte exactamente cuando se acaba el tiempo, pero de acuerdo con los documentos para timeout, esto debería funcionar para todo lo que no use 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:) 

Ahora vamos a probar en algo costoso:

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] 

compilada y ejecutada con time, parece que funciona (es obvio que hay cierta sobrecarga fuera de la parte cronometrada, pero estoy en aproximadamente 100 ms :

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

también, algo para tener en cuenta sobre este enfoque, ya que estoy adjuntando toda la operación de ejecutar los cálculos y empujándolos hacia el tvar dentro de una llamada a timeout, es probable que se pierda algo de tiempo en la creación de la estructura de retorno, aunque asumo que (si sus cálculos son costosos) no dará cuenta ni mucho de su tiempo total.

actualización

Ahora que he tenido algo de tiempo para pensar en ello, debido a la pereza de Haskell, no estoy 100% positiva la nota anterior (alrededor de tiempo pasó creación de la estructura de retorno) es correcto; De cualquier manera, avíseme si esto no es lo suficientemente preciso para lo que está tratando de lograr.

Answer 2

Puede implementar timeOut con el tipo que le dio el uso de timeout y evaluate. Se ve algo como esto (he omitido la parte que calcula la cantidad de tiempo que queda - utilizar getCurrentTime o similar para que):

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

Si quieres más que un simple forzando forma normal débil cabeza, puede llamar esto con un argumento ya seq'd, por ejemplo timeoutPure (deepseq v) en lugar de timeoutPure v.

Answer 3

me gustaría utilizar dos hilos junto con TVars y lanzar una excepción (que hace que todas las transacciones en curso que revertirse) en el hilo de cálculo cuando se ha alcanzado el tiempo de espera:

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 

En este ejemplo (puede) necesitar ajustar un poco la fuerza en el TV para que, por ejemplo, los nodos de lista son NOT compute dentro de la transacción atómica pero primero se computa y luego se inicia una transacción atómica para considerarlos en la lista.

En cualquier caso, cuando se produce una excepción, la transacción en curso se revierte o el cálculo en curso se detiene antes de que el resultado se incluya en la lista y eso es lo que desea.

Lo que debe tener en cuenta es que cuando los cálculos individuales para preparar un nodo se ejecutan con alta frecuencia, entonces este ejemplo es probablemente muy costoso en comparación con no usar STM.