[Haskell-cafe] Multiple State Monads

Phil pbeadling at mail2web.com
Mon Jan 12 20:34:57 EST 2009


Thanks Minh - I've updated my code as you suggested.  This looks better than
my first attempt!

Is it possible to clean this up any more?  I find:

( (), (Double, Word64) )

a bit odd syntactically, although I understand this is just to fit the type
to the State c'tor so that we don't have to write our own Monad longhand.  I
guess given that (), as I understand, is just like 'void' in C, it should
not affect program performance, and the fact that I'm using replicateM_
means that the result is being ignored for all but my last iteration.

As an exercise I assume I could have approached the problem using the StateT
transformer, although for the purposes below carrying two states in a tuple
is probably clearer and more performant?

Thanks again,

Phil.

mcSimulate :: Double -> Double -> Word64 -> [Double]
mcSimulate startStock endTime seedForSeed = fst expiryStock : mcSimulate
startStock endTime newSeedForSeed
  where
    expiryStock =  execState ( do replicateM_ (truncate(endTime/timeStep)-1)
getEvolution; getEvolution )
                   $ (startStock,ranq1Init seedForSeed)
    newSeedForSeed = seedForSeed + 246524


-- Monad Implementation

evolveUnderlying :: (Double, Word64) -> ( (), (Double, Word64) )
evolveUnderlying (stock, state) = ( (), ( newStock, newState ) )
  where
    newState = ranq1Increment state
    newStock = stock * exp ( ( ir - (0.5*(vol*vol)) )*timeStep + (
vol*sqrt(timeStep)*normalFromRngState(state) ) )

getEvolution :: State (Double, Word64) ()
getEvolution = State evolveUnderlying


On 12/01/2009 20:49, "minh thu" <noteed at gmail.com> wrote:

> 2009/1/12 Phil <pbeadling at mail2web.com>:
>> Hi,
>> 
>> I've been reading the Monads aren't evil posts with interest ­ I'm a 2nd
>> week Haskell newbie and I'm doing my best to use them where (I hope) it is
>> appropriate.  Typically I'm writing my code out without using Monads
>> (normally using list recursion), and then when I get them working, I delve
>> into the Monad world.... This has been going well so far with a bit of help
>> from you guys, but I've hit a snag.
>> 
>> In the code below I'm using a state Monad (getEvolution), but unlike simpler
>> cases I'm passing around two items of state, and one of these states is also
>> ultimately a result ­ although I don't care about the result until I reach
>> an end state.  My implementation is a bit ugly to say the least and clearly
>> I'm forcing round pegs into square holes here ­ reading a bit online I get
>> the impression that I can solve the two-state issue using Monad
>> Transformers, by  wrapping a StateT around a regular State object (or even
>> two StateT Monads around an Identity Monad??).  I think I understand the
>> theory here, but any attempt to implement it leads to a horrible mess that
>> typically doesn't compile.  The other problem of having a state that is also
>> a result, I'm sure what to do about this.
>> 
>> Was wondering if anyone could give me a push in the right direction ­ how
>> can I rework my state monad so that it looks less wildly.
>> 
>> Many thanks,
>> 
>> Phil.
>> 
>> mcSimulate :: Double -> Double -> Word64 -> [Double]
>> mcSimulate startStock endTime seedForSeed = expiryStock : mcSimulate
>> startStock endTime newSeedForSeed
>>   where
>>     expiryStock =  evalState ( do replicateM_ (truncate(endTime/timeStep)-1)
>> getEvolution; getEvolution )
>>                    $ (startStock,ranq1Init seedForSeed)
>>     newSeedForSeed = seedForSeed + 246524
>> 
>> discount :: Double -> Double -> Double -> Double
>> discount stock r t = stock * exp (-r)*t
>> 
>> payOff :: Double -> Double -> Double
>> payOff strike stock | (stock - strike) > 0 = stock - strike
>>                     | otherwise = 0
>> 
>> -- Monad Implementation
>> 
>> -- Yuk!
>> evolveUnderlying :: (Double, Word64) -> ( Double, (Double, Word64) )
>> evolveUnderlying (stock, state) = ( newStock, ( newStock, newState ) )
>>   where
>>     newState = ranq1Increment state
>>     newStock = stock * exp ( ( ir - (0.5*(vol*vol)) )*timeStep + (
>> vol*sqrt(timeStep)*normalFromRngState(state) ) )
>> 
>> getEvolution :: State (Double, Word64) Double
>> getEvolution = State evolveUnderlying
> 
> Hi,
> 
> the evolveUnderlying can simply manipulate the state, so you can
> 
> do evolveUnderlying -- state (not your state, but the tuple) changes here
>    r <- gets fst -- query the state for the first element of the tuple
>    return r -- simply return what you want
> 
> Note that if you want to combine your state and the stock, you simply end
> with a new kind of state : the tuple (thus, no need to compose two State)
> 
> Note also, since evolveUnderlying only manipulates the internal state of the
> State monad, it returns ().
> 
> Depending on how you want to structure your code, you can also use execState
> instead of evalState : it returns the state on which you can use fst.
> 
> hope it helps,
> Thu



More information about the Haskell-Cafe mailing list