Tính toán càng nhiều danh sách càng tốt trong một khoảng thời gian cố định

Question

Tôi muốn viết một hàm cần có giới hạn thời gian (tính bằng giây) và danh sách, và tính nhiều phần tử trong danh sách càng tốt trong giới hạn thời gian.

nỗ lực đầu tiên của tôi là đầu tiên viết hàm sau, mà lần một tính tinh khiết và trả về thời gian trôi qua cùng với kết quả:

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) 

tôi sau đó có thể xác định chức năng tôi muốn về điều này:

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) 

Điều này không hoàn toàn đúng. Thậm chí bỏ qua lỗi thời gian và lỗi dấu phẩy động, cách tiếp cận này không bao giờ dừng tính toán của một phần tử trong danh sách khi nó đã bắt đầu, có nghĩa là nó có thể (và thực tế, bình thường sẽ) vượt quá giới hạn thời gian của nó.

Nếu thay vào đó tôi đã có một chức năng mà có thể đánh giá ngắn mạch nếu nó đã lấy quá dài:

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

sau đó tôi có thể viết các chức năng mà tôi thực sự muốn:

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) 

Câu hỏi của tôi là:

1. Làm cách nào để viết timeOut?
2. Có cách nào tốt hơn để viết hàm timeLimited, ví dụ: một cách không bị lỗi tích lũy dấu phẩy động từ việc thêm chênh lệch thời gian nhiều lần?

Answer 1

Đây là một ví dụ tôi có thể nấu ăn bằng một số gợi ý ở trên. Tôi đã không thực hiện một số lượng lớn các thử nghiệm để đảm bảo công việc được cắt chính xác khi hết giờ, nhưng dựa trên các tài liệu cho timeout, điều này sẽ làm việc cho tất cả mọi thứ không sử dụng 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:) 

Bây giờ chúng ta hãy thử nó trên một cái gì đó tốn kém:

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] 

Biên soạn và chạy với time, có vẻ như để làm việc (rõ ràng là có một số chi phí ngoài phần theo thời gian, nhưng tôi ở khoảng 100ms :

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

Ngoài ra, một điều cần lưu ý về cách tiếp cận này, vì tôi kèm theo toàn bộ hoạt động tính toán và đẩy chúng vào tvar bên trong một cuộc gọi đến timeout, một số thời gian ở đây có khả năng bị mất trong việc tạo ra cấu trúc trả về, mặc dù tôi giả sử (nếu tính toán của bạn là tốn kém) nó sẽ không chiếm hoặc nhiều thời gian tổng thể của bạn.

Cập nhật

Bây giờ tôi đã có một thời gian để suy nghĩ về nó, do sự lười biếng của Haskell, Tôi không phải 100% tích cực ghi chú ở trên (khoảng thời gian dành để tạo cấu trúc cửa sổ mới) là chính xác; dù bằng cách nào, hãy cho tôi biết nếu điều này không đủ chính xác cho những gì bạn đang cố gắng hoàn thành.

Answer 2

Bạn có thể triển khai timeOut với loại bạn đã sử dụng timeout và evaluate. Nó trông giống như thế này (tôi đã bỏ qua phần mà tính bao nhiêu thời gian còn lại - sử dụng getCurrentTime hoặc tương tự cho rằng):

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

Nếu bạn muốn biết thêm buộc hơn là chỉ hình thức bình thường yếu đầu, bạn có thể gọi điều này với một đối số đã có, ví dụ: timeoutPure (deepseq v) thay vì timeoutPure v.

Answer 3

Tôi sẽ sử dụng hai luồng cùng với TVars và nâng cao một ngoại lệ (gây ra mọi giao dịch liên tục được cuộn lại) trong thread tính toán khi thời gian chờ đã đạt được:

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 

Trong ví dụ này, bạn (có thể) cần điều chỉnh forceIntoTVar một chút để ví dụ các nút danh sách là NOT tính bên trong giao dịch nguyên tử nhưng lần đầu tiên được tính toán và sau đó một giao dịch nguyên tử được bắt đầu để chống lại chúng trong danh sách.

Trong mọi trường hợp, khi ngoại lệ được nâng lên, giao dịch đang diễn ra được khôi phục hoặc tính toán liên tục bị dừng trước khi kết quả được đưa vào danh sách và đó là những gì bạn muốn.

Điều bạn cần xem xét là khi tính toán riêng lẻ để chuẩn bị một nút chạy với tần số cao thì ví dụ này có thể rất tốn kém so với không sử dụng STM.