haskell - responsable - vladimir lenin fue el primer presidente de

Calcule la mayor cantidad posible de una lista 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 siguiente función, que mide un cómputo 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 puedo definir la función que quiero en términos de esto:

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)

Aunque 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 cambio, tuviera una función que pudiera provocar un cortocircuito en la evaluación si hubiera tardado demasiado:

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. ¿Hay una mejor manera de escribir la función timeLimited , por ejemplo, una que no sufra de un error flotante acumulado al sumar diferencias de tiempo varias veces?

Answer 1

Aquí hay un ejemplo que pude cocinar utilizando algunas de las sugerencias anteriores. No he realizado una gran cantidad de pruebas para asegurarme de que el trabajo se interrumpe exactamente cuando se acaba el tiempo, pero de acuerdo con los documentos de timeout de timeout , esto debería funcionar para todas las cosas que no usan 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 probémoslo 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]

Compilado y ejecutado con el time , parece funcionar (obviamente hay algunos gastos generales 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

Además, algo que destacar sobre este enfoque; ya que estoy encerrando toda la operación de ejecutar los cálculos y presionarlos en el tvar dentro de una llamada al timeout de timeout , es probable que se pierda algo de tiempo al crear la estructura de retorno, aunque asumo (si sus cálculos son costosos) ganó No cuenta ni mucho de su tiempo total.

Actualizar

Ahora que he tenido tiempo de pensarlo, debido a la flojera de Haskell, no estoy 100% seguro de que la nota anterior (sobre el tiempo dedicado a crear la estructura de retorno) sea correcta; 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 proporcionó usando timeout y evaluate . Se ve algo como esto (he omitido la parte que calcula cuánto tiempo queda: use getCurrentTime o similar para eso):

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

Si quieres más forzado que la forma normal de cabeza débil, puedes llamarlo con un argumento ya seq''d, por ejemplo, timeoutPure (deepseq v) lugar de timeoutPure v .

Answer 3

Utilizaría dos hilos junto con TVars y generaría una excepción (que hace que todas las transacciones en curso se retrotraigan) en el hilo de cálculo cuando se haya 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 que necesite ajustar forzarIntoTVar un poco para que, por ejemplo, los nodos de la lista NO se computen dentro de la transacción atómica, sino que primero se computen y luego se inicie una transacción atómica para considerarlos en la lista.

En cualquier caso, cuando se produce la 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.