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