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

Question

我曾经问一个类似的问题一次.现在我会更具体.目的是学习一个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 action(:: a -> m a),重复多次,因此有效地组合这些动作很重要(快速忘记上一步).从我之前的问题中学到的东西(用折叠构成monad动作), seq并deepseq帮助组成monadic动作.所以我这样做:

-- 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)(内存分配似乎是可以接受的).对于线性渐近,该轮廓应该是平坦且恒定的:

每次更新的二次时间http://i29.tinypic.com/i59blv.png

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

堆配置文件与-hc http://i30.tinypic.com/124a8fc.png

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

该示例的完整可运行源是在这里.

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,现在你的程序变为:

• 使用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可以提高性能,这样您就不会继续遍历列表,也不必保持列表的头部,并且您不需要深入查看列表,但只是强制个别结果.即:

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

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