固定空间和线性时间随机算法的迭代

Question

我曾经问过类似的问题once。现在我会更具体。目的是学习一个Haskell习语来编写具有monadic结果的迭代算法。特别是，这可能对实现各种随机算法很有用，例如遗传算法等。

我写了一个示例程序，用Haskell中的这些算法表明了我的问题。它的完整来源是hpaste。

关键是随机更新一个元素（因此结果在State StdGen或其他一些monad中）：

type RMonad = State StdGen

-- An example of random iteration step: one-dimensional random walk.
randStep :: (Num a) => a -> RMonad a
randStep x = do
  rnd <- get
  let (goRight,rnd') = random rnd :: (Bool, StdGen)
  put rnd'
  if goRight
     then return (x+1)
     else return (x-1)

然后需要更新许多元素，并多次重复该过程。这是一个问题。由于每一步都是monad动作（:: a -> m a），重复多次，因此有效地组合这些动作很重要（快速忘记上一步）。从我之前的问题(Composing monad actions with folds)中学到的东西，seq和deepseq帮助构成了一元行动。所以我这样做：

-- Strict (?) iteration.
iterateM' :: (NFData a, Monad m) => Int -> (a -> m a) -> a -> m a
iterateM' 0 _ x = return $!! x
iterateM' n f x = (f $!! x) >>= iterateM' (n-1) f 

-- Deeply stict function application.
($!!) :: (NFData a) => (a -> b) -> a -> b
f $!! x = x `deepseq` f x

它肯定比懒惰的成分更好。不幸的是，这还不够。

-- main seems to run in O(size*iters^2) time...
main :: IO ()
main = do
  (size:iters:_) <- liftM (map read) getArgs
  let start = take size $ repeat 0
  rnd <- getStdGen
  let end = flip evalState rnd $ iterateM' iters (mapM randStep) start
  putStr . unlines $ histogram "%.2g" end 13

当我测量完成该程序所需的时间时，看起来它相对于迭代次数类似于O（N ^ 2）（内存分配似乎是可接受的）。对于线性渐近，该轮廓应该是平坦且恒定的：

quadratic time per update http://i29.tinypic.com/i59blv.png

这就是堆配置文件的外观：

heap profile with -hc http://i30.tinypic.com/124a8fc.png

我认为这样的程序应该以非常适度的内存要求运行，并且它应该花费与迭代次数成比例的时间。我怎样才能在Haskell中实现这一目标？

示例的完整可运行源是here。

Answer 1

需要考虑的一些事项：

• 使用mersenne-random生成器，它通常比StdGen快100倍

对于原始的全部性能，编写一个自定义状态monad，如下所示：

import System.Random.Mersenne.Pure64

data R a = R !a {-# UNPACK #-}!PureMT

-- | The RMonad is just a specific instance of the State monad where the
--   state is just the PureMT PRNG state.
--
-- * Specialized to a known state type
--
newtype RMonad a = S { runState :: PureMT -> R a }

instance Monad RMonad where
    {-# INLINE return #-}
    return a = S $ \s -> R a s

    {-# INLINE (>>=) #-}
    m >>= k  = S $ \s -> case runState m s of
                                R a s' -> runState (k a) s'

    {-# INLINE (>>) #-}
    m >>  k  = S $ \s -> case runState m s of
                                R _ s' -> runState k s'

-- | Run function for the Rmonad.
runRmonad :: RMonad a -> PureMT -> R a
runRmonad (S m) s = m s

evalRmonad :: RMonad a -> PureMT -> a
evalRmonad r s = case runRmonad r s of R x _ -> x

-- An example of random iteration step: one-dimensional random walk.
randStep :: (Num a) => a -> RMonad a
randStep x = S $ \s -> case randomInt s of
                    (n, s') | n < 0     -> R (x+1) s'
                            | otherwise -> R (x-1) s'

像这样：http://hpaste.org/fastcgi/hpaste.fcgi/view?id=27414#a27414

以恒定的空间运行（以你构建的[Double]为模），比你原来的快8倍。

使用具有局部定义的专用状态monad也明显优于Control.Monad.Strict。

以下是堆的样子，与您的相同参数：

请注意，速度提高约10倍，并使用1/5的空间。最重要的是你分配的双打名单。

---

受您的问题的启发，我在新的软件包中捕获了PureMT模式：monad-mersenne-random，现在您的程序变为：

• Using monad-mersenne-random

我做的另一个改变是worker / wrapper转换iterateM，使其内联：

 {-# INLINE iterateM #-}
 iterateM n f x = go n x
     where
         go 0 !x = return x
         go n !x = f x >>= go (n-1)

总的来说，这会带来你的代码，K = 500，N = 30k

• 原文：62.0s
• 新：0.28s

那就是，快220倍。

堆也好一点，现在iterateM取消装箱。

Answer 2

导入Control.Monad.State.Strict而不是Control.Monad.State会显着提高性能。不确定你在渐近线上寻找什么，但这可能会让你在那里。

此外，您通过交换iterateM和mapM来提高性能，这样您就不会继续遍历列表，您不必保持列表的头部，而您不需要deepseq通过列表，但只是强制个别结果。即：

let end = flip evalState rnd $ mapM (iterateM iters randStep) start

如果您这样做，那么您可以将iterateM更改为更加惯用：

iterateM 0 _ x = return x
iterateM n f !x = f x >>= iterateM (n-1) f

这当然需要爆炸模式语言扩展。

Answer 3

与其他答案相比，这可能是一个小点，但你的（$ !!）函数是否正确？

您定义

($!!) :: (NFData a) => (a -> b) -> a -> b
f $!! x = x `deepseq` f x

这将完全评估参数，但函数结果根本不会被评估。如果您希望$!!运算符应用该函数并完全评估结果，我认为它应该是：

($!!) :: (NFData b) => (a -> b) -> a -> b
f $!! x = let y = f x in y `deepseq` y