algorithm - Haskell的无限/惰性储层采样

我试图在haskell中实现一个简单的储油层采样，然后http://jeremykun.com/2013/07/05/reservoir-sampling/（注意，显示的算法可能在语义上不正确）
根据这一点：Iterative or Lazy Reservoir Sampling除非提前知道种群数量，否则不可能进行懒惰的水库采样。
即便如此，我也不明白为什么（从操作上讲）下面的sampleReservoir不能在无限列表中工作。懒惰到底在哪里被打破？

import System.Random (randomRIO)

-- equivalent to python's enumerate
enumerate :: (Num i, Enum i) => i -> [e] -> [(i, e)]
enumerate start = zip [start..]

sampleReservoir stream =
    foldr
        (\(i, e) reservoir -> do
            r <- randomRIO (0.0, 1.0) :: IO Double -- randomRIO gets confused about 0.0 and 1.0
            if r < (1.0 / fromIntegral i) then
                fmap (e:) reservoir
            else
                reservoir)
        (return [])
        (enumerate 1 stream)

挑战和考验是fmap (take 1) $ sampleReservoir [1..]。
此外，如果水库取样不能偷懒，那么什么样的方法可以得到一个偷懒列表并生成一个抽样的偷懒列表呢？
我认为在输出中也必须有一种方法使上面的函数变懒，因为我可以改变这一点：

if r < (1.0 / fromIntegral i) then
    fmap (e:) reservoir
else

致：

if r < (1.0 / fromIntegral i) then
    do
        print e
        fmap (e:) reservoir

当函数在列表上迭代时，将显示结果。使用协程抽象，可能会有一个print e，而不是yield e，剩下的计算可以作为一个延续。

最佳答案

问题是io monad在操作之间保持一个严格的序列。写入fmap (e:) reservoir将首先执行与reservoir相关联的所有效果，如果输入列表是无限的，则效果是无限的。
我可以通过自由使用unsafeInterleaveIO来解决这个问题，这允许您打破IO的语义：

sampleReservoir2 :: [e] -> IO [e]
sampleReservoir2 stream =
    foldr
        (\(i, e) reservoir -> do
            r <- unsafeInterleaveIO $ randomRIO (0.0, 1.0) :: IO Double -- randomRIO gets confused about 0.0 and 1.0
            if r < (1.0 / fromIntegral i) then unsafeInterleaveIO $ do
                rr <- reservoir
                return (e:rr)
            else
                reservoir)
        (return [])
        (enumerate 1 stream)

显然，这将允许IO操作的交错，但是由于您所做的一切都是生成随机数，所以这不重要。但是，这个解决方案不是很令人满意；正确的解决方案是稍微重构代码。您应该生成一个随机数的无限列表，然后使用这个无限列表（惰性地）使用foldr：

sampleReservoir3 :: MonadRandom m => [a] -> m [a]
sampleReservoir3 stream = do
  ws <- getRandomRs (0, 1 :: Double)
  return $ foldr
     (\(w, (i, e)) reservoir ->
        (if w < (1 / fromIntegral i) then (e:) else id) reservoir
     )
     []
     (zip ws $ enumerate 1 stream)

这也可以（等价地）写成

sampleReservoir4 :: [a] -> IO [a]
sampleReservoir4 stream = do
  seed <- newStdGen
  let ws = randomRs (0, 1 :: Double) seed
  return $ foldr
     (\(w, (i, e)) reservoir ->
        (if w < (1 / fromIntegral i) then (e:) else id) reservoir
     )
     []
     (zip ws $ enumerate 1 stream)

另外，我不确定算法的正确性，因为它似乎总是首先返回输入列表的第一个元素。不是很随意。