Iterazione di un algoritmo randomizzato in spazio fisso e tempo lineare

Question

Ho usato per chiedere una domanda simile once. Ora sarò più specifico. Lo scopo è quello di apprendere un idioma Haskell per scrivere algoritmi iterativi con risultati monadici. In particolare, questo potrebbe essere utile per implementare tutti i tipi di algoritmi randomizzati, come algoritmi genetici e simili.

Ho scritto un programma di esempio che manifesta il mio problema con tali algoritmi in Haskell. La sua fonte completa è hpaste.

Il punto chiave è aggiornare un elemento casuale (quindi il risultato è in State StdGen o qualche altra monade):

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) 

E poi uno deve aggiornare molti elementi, e ripetere il processo, molte volte . E qui c'è un problema. Poiché ogni passo è un'azione di monade (:: a -> m a), ripetuta molte volte, è importante comporre tali azioni in modo efficace (dimenticando rapidamente il passaggio precedente). Da quanto ho appreso dalla mia precedente domanda, (Composing monad actions with folds), seq e deepseq, ho aiutato molto a comporre azioni monadiche. Così faccio:

-- 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 

È sicuramente meglio della composizione pigra. Sfortunatamente, non è abbastanza.

-- 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 

Quando ho misurato il tempo richiesto per completare questo programma, sembra, che è simile a O (N^2) rispetto al numero di iterazioni (allocazione di memoria sembra essere accettabile). Questo profilo dovrebbe essere piatta e costante per asintotica lineari:

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

E questo è come un profilo mucchio sembra:

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

presumo che un tale programma deve essere eseguito con la memoria molto modesto requisiti, e dovrebbe richiedere tempo proporzionale al numero di iterazioni. Come posso ottenerlo in Haskell?

La sorgente eseguibile completa dell'esempio è here.

Answer 1

alcune cose da considerare:

• utilizzare il generatore mersenne-random, spesso è> 100 volte più veloce di StdGen

Per prime prestazioni a tutto campo, scrivere una monade Stato personalizzato, in questo modo:

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' 

Come così: http://hpaste.org/fastcgi/hpaste.fcgi/view?id=27414#a27414

Che gira nello spazio costante (modulo lo [Double] che si crea) ed è circa 8 volte più veloce dell'originale.

L'utilizzo di una monade di stato specializzata con definizione locale sovraperforma significativamente anche Control.Monad.Strict.

Ecco ciò che il mucchio sembra, con gli stessi paramters come lei:

Si noti che è circa 10 volte più veloce, e utilizza 1/5 ° lo spazio. La grande cosa rossa è la tua lista di doppi assegnati.

---

Ispirato dalla tua domanda, ho catturato il modello PureMT in un nuovo pacchetto: monad-mersenne-random, e ora il tuo programma diventa questo:

• Using monad-mersenne-random

L'altro cambiamento che ho fatto è stato a worker/wrapper trasforma iterateM, abilitandolo in linea:

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

Nel complesso, questo porta il codice da, con K = 500, N = 30k

• originale: 62.0s
• Nuovo: 0.28s

in modo che sia, 220x più veloce.

Anche l'heap è un po 'migliore, ora che iterateM unboxes.

Answer 2

L'importazione di Control.Monad.State.Strict anziché di Control.Monad.State produce un miglioramento significativo delle prestazioni. Non sei sicuro di cosa stai cercando in termini di asintoti, ma questo potrebbe farti arrivare lì.

Inoltre, si ottiene un aumento delle prestazioni scambiando l'iterateM e la mappaM in modo da non continuare a scorrere l'elenco, non è necessario rimanere in testa all'elenco e non è necessario per approfondire l'elenco, ma solo forzare i singoli risultati. Cioè .:

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

Se non è così, allora si può cambiare iterateM di essere molto più idiomatico così:

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

Questo, naturalmente, occorre estendere il linguaggio modelli Bang.

Answer 3

Questo è probabilmente un piccolo punto rispetto alle altre risposte, ma la funzione ($ !!) è corretta?

si definisce

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

Questo valuterà completamente l'argomento, tuttavia il risultato funzione non sarà necessariamente valutata a tutti. Se si desidera che l'operatore $!! per applicare la funzione e pienamente valutare il risultato, penso che dovrebbe essere:

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