Obliczyć jak najwięcej listy w ustalonym czasie

Question

Chcę napisać funkcję, która zajmuje limit czasu (w sekundach) i listę, i oblicza jak najwięcej elementów listy, jak to możliwe w terminie.

Moja pierwsza próba była najpierw napisać następującą funkcję, która razy czystą obliczenia i zwraca czas jaki upłynął wraz z wynikiem:

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) 

mogę następnie zdefiniować funkcję Chcę chodzi o to:

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) 

To jednak nie jest w porządku. Nawet ignorując błędy synchronizacji i błędy zmiennoprzecinkowe, podejście to nigdy nie zatrzymuje obliczeń elementu listy po uruchomieniu, co oznacza, że ​​może (i faktycznie normalnie) przekroczyć limit czasu.

Jeśli zamiast miałem funkcję, która mogłaby ocena zwarcie gdyby brać zbyt długo:

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

wtedy mógłbym napisać funkcję, że naprawdę ma:

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) 

Moje pytania to:

1. Jak napisać timeOut?
2. Czy istnieje lepszy sposób na zapisanie funkcji timeLimited, na przykład takiej, która nie cierpi z powodu nagromadzonego błędu zmiennoprzecinkowego od wielokrotnego sumowania różnic czasowych?

Answer 1

Oto przykład, który udało mi się ugotować za pomocą niektórych z powyższych sugestii. Nie wykonałem ogromnej ilości testów, aby upewnić się, że praca została odcięta dokładnie w momencie, gdy skończy się czas, ale na podstawie dokumentów dla timeout, powinno to działać we wszystkich rzeczach nie korzystających z 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:) 

Teraz spróbujmy coś kosztownego:

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] 

kompilowany i uruchamiany z time, to wydaje się działać (oczywiście istnieją pewne napowietrznych poza częścią czasowym, ale jestem na około 100ms :

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

również coś, aby pamiętać o tym podejściu, ponieważ jestem załączając całą operację prowadzenia obliczeń i przesuwając je na TVAR wewnątrz jednego połączenia do timeout, jakiś czas tutaj prawdopodobnie zagubił się w tworzeniu struktury powrotu, choć zakładam (jeśli twoje obliczenia są kosztowne), to nie będzie to stanowić dużej części czasu.

Aktualizacja

Teraz miałem trochę czasu, aby pomyśleć o tym, ze względu na lenistwo Haskell jest, nie jestem w 100% pozytywne noty powyżej (o czas spędzony tworzenia struktury zwracanej) jest poprawny; tak czy inaczej, daj mi znać, jeśli to nie jest wystarczająco precyzyjne, co próbujesz osiągnąć.

Answer 2

można zaimplementować timeOut z typem dałeś za pomocą timeout i evaluate. Wygląda to mniej więcej tak (mam pominięto część, która oblicza, ile czasu pozostało - użyj getCurrentTime lub podobny do tego):

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

Jeśli chcesz więcej niż tylko słaby zmuszając głowicy normalnej formie, ty można wywołać to z argumentem, który już istnieje, np timeoutPure (deepseq v) zamiast timeoutPure v.

Answer 3

użyłbym dwóch wątków wraz z TVars i podnieść wyjątek (który wywołuje każde trwające transakcji może zostać wycofana) w wątku obliczeń, gdy został osiągnięty limit czasu:

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 

W tym przykładzie (może) potrzebować nieco dostosować forceIntoTVar, aby np węzły listy są obliczane wewnątrz transakcji atomowej, ale najpierw obliczane, a następnie rozpoczynana jest transakcja atomowa w celu uwzględnienia ich na liście.

W każdym przypadku, gdy wyjątek zostanie podniesiony, trwająca transakcja zostanie wycofana lub trwające obliczenia zostaną zatrzymane, zanim wynik zostanie dodany do listy i to jest to, czego chcesz.

Należy wziąć pod uwagę, że podczas wykonywania indywidualnych obliczeń w celu przygotowania węzła o wysokiej częstotliwości, ten przykład jest prawdopodobnie bardzo kosztowny w porównaniu do braku użycia STM.