Итерация рандомизированного алгоритма в фиксированном пространстве и линейном времени - PullRequest
Новая
       14

Итерация рандомизированного алгоритма в фиксированном пространстве и линейном времени

12 голосов
/ 13 июля 2010

Я задавал похожий вопрос один раз .Теперь я буду более конкретным.Цель состоит в том, чтобы выучить идиому Haskell для написания итерационных алгоритмов с монадическими результатами.В частности, это может быть полезно для реализации всех видов рандомизированных алгоритмов, таких как генетические алгоритмы и т. П.

Я написал пример программы, которая демонстрирует мою проблему с такими алгоритмами в Haskell.Его полный источник - hpaste .

. Ключевым моментом является случайное обновление элемента (таким образом, результат находится в State StdGen или какой-либо другой монаде): 

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)

И тогда нужно обновить много элементов и повторить процесс много-много раз.И здесь есть проблема.Поскольку каждый шаг является действием монады (:: a -> m a), повторяющимся много раз, важно эффективно составлять такие действия (быстро забывая предыдущий шаг).Из того, что я узнал из моего предыдущего вопроса (Составление монадных действий со сгибами) , 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) по количеству итераций (выделение памяти).кажется приемлемым).Этот профиль должен быть плоским и постоянным для линейной асимптотики:

квадратичное время на обновление http://i29.tinypic.com/i59blv.png

И вот так выглядит профиль кучи:

профиль кучис -hc http://i30.tinypic.com/124a8fc.png

Я предполагаю, что такая программа должна работать с очень скромными требованиями к памяти, и это должно занять время, пропорциональное количеству итераций.Как я могу добиться этого в Haskell?

Полный работающий источник примера здесь .

Ответы [ 3 ]

23 голосов
/ 13 июля 2010

Некоторые вещи для рассмотрения:

  • Используйте генератор mersenne-random , он часто> в 100 раз быстрее, чем StdGen

Для всех необработанныхбез исполнения, напишите собственную монаду State, например: 

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 раз быстрее вашего оригинала.

Использование специализированной монады состояний с локальным определением также значительно превосходит Control.Monad.Strict.

Вот как выглядит куча, сте же параметры, что и у вас:

alt text

Обратите внимание, что он примерно в 10 раз быстрее и использует 1/5 пробела.Большая красная вещь - ваш список двойников.

Вдохновленный вашим вопросом, я запечатлел шаблон PureMT в новом пакете: monad-mersenne-random , и теперьваша программа выглядит так:

Другое изменение, которое я сделал, - преобразование работник / оболочка 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

То есть, 220x быстрее .

Куча тоже немного лучше, теперь, когда iterateM распаковывает.alt text

6 голосов
/ 13 июля 2010

Импорт 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

Это, конечно, требует расширения языка шаблонов взрыва.

0 голосов
/ 14 июля 2010

Это, вероятно, небольшая точка по сравнению с другими ответами, но правильна ли ваша ($ !!) функция?

Вы определяете 

($!!) :: (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
...