切断惰性列表生成

Question

我想知道是否有人对如何创建一个函数有任何见解，该函数将接受一个列表并仅返回可以在 x 时间内生成的术语。

例如，我有一个函数需要大约 10 分钟才能返回几个术语。我不想猜测我能够生成多少项（使用 take x），而是想将一个无限列表输入到我的低效函数中，并让一个单独的函数决定何时超时。

所以像这样： [5,7,10] = takeUntilTime (10 sec) 。 inefficientFunction $ [1..]

我对 haskell 还很陌生，但我想我可以编写该函数来在每个新术语生成后检查计时器，并在时间已过时停止。

但是，如果第四个任期需要永恒怎么办？有没有办法阻止 inefficientFunction 完成第四项的生成，即使它已经开始了？

我对直接答案不抱太大希望，但我很欣赏对此的任何直觉。谢谢。

Answer 1

还没有经过太多测试，但这似乎有效，至少在小范围内有效。

import Control.Concurrent
import Control.Exception
import Control.Monad

takeUntilTime :: Int -> [a] -> IO [a]
takeUntilTime limit list = do
    me <- myThreadId
    bracket (forkIO $ threadDelay limit >> throwTo me NonTermination) killThread
        . const $ tryTake list
  where
    (/:/) = liftM2 (:)
    tryTake list = handle (\NonTermination -> return []) $
        case list of
            [] -> return []
            x:xs -> evaluate x /:/ tryTake xs

ghci> takeUntilTime 1000000 [x | x <- [1..], x == 0]
[]
(1.02 secs, 153111264 bytes)
ghci> takeUntilTime 1000000 [maximum [y `mod` x | y <- [1..100000]] | x <- [1..]]
[0,1,2,3]
(1.00 secs, 186234264 bytes)

Answer 2

我认为你想要的是这样的： System.Timeout

它允许IO事件超时。它有一个函数，其类型为：

timeout :: Int -> IO a -> IO (Maybe a)

我认为你应该能够使用它。我的方法是使用超时函数和迭代深化方法将越来越多的内容输入到您的函数中，直到它起作用。这样，当一个人最终超时时，你就知道你已经走得足够远了。

Answer 3

我认为你问了两个问题。
1. 如何设置从无限列表中获取元素的时间限制。
2. 如何终结一个阻塞函数，或者创建一个非阻塞函数，比如一些网络IO函数。

第二个可以参考http://twelvestone.com/forum_thread/view/32028 一些想法。
那么对于第一个，您可以假设 inefficientFunction 是非阻塞的。

Answer 4

受到 ephemient 的回答的启发，我想我应该发布他的解决方案的两个概括。

解决方案 1

import Control.Concurrent
import Control.Exception
import Control.Monad

doUntilTime :: Int -> IO a {- must handle NonTermination exception! -} -> IO a
doUntilTime limit action = do
  me <- myThreadId
  bracket (forkIO $ threadDelay limit >> throwTo me NonTermination) killThread
           . const $ action

示例

(/:/) = liftM2 (:)
tryTake list = handle (\NonTermination -> return []) $
   case list of
     [] -> return []
     x:xs -> evaluate x /:/ tryTake xs

test = do
  res <- doUntilTime 1000000 (tryTake [1..])
  putStrLn (show $ length res)

解决方案 2

在此解决方案中，您将一个默认值、一个输入和一个预递归函数传递给doUntilTime< /代码>。

预递归函数的编写风格是第一个参数（我们称之为 self），用于之前使用递归调用的地方。这使您不必显式处理 NonTermination 异常。

import Control.Concurrent
import Control.Exception
import Control.Monad

doUntilTime :: Int -> a -> b -> ((a -> IO b) -> (a -> IO b)) -> IO b
doUntilTime limit input defaultVal action = do
    me <- myThreadId
    bracket (forkIO $ threadDelay limit >> throwTo me NonTermination) killThread
        . const $ fix action input
  where
    fix f = f (\a -> handle (\NonTermination -> return defaultVal) (fix f a))

(/:/) = liftM2 (:)

-- tryTake is written in a "pre-recursive" style. There are no
-- occurrences of "tryTake" in the body only occurrences of
-- "self" (the first parameter)
tryTake :: ([Int] -> IO [Float]) -> ([Int] -> IO [Float])
tryTake self list =
   case list of
     [] -> return []
     x:xs -> evaluate (fromIntegral x) /:/ self xs

test = do
  res <- doUntilTime 1000000 [1..] [] tryTake
  print (length res)