Haskell的无限/懒惰水库采样

时间:2015-11-25 15:54:33

标签: algorithm haskell sampling random-sample

我试图在http://jeremykun.com/2013/07/05/reservoir-sampling/之后在haskell中实现一个简单的油藏采样(注意所显示的算法可能在语义上不正确)

根据这个: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,其余的计算可以作为延续。

1 个答案:

答案 0 :(得分:3)

问题是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)

顺便说一下,我不确定算法的正确性,因为它似乎总是首先返回输入列表的第一个元素。不是很随机。