[Haskell-cafe] Stacking State on State.....

[Phil]

Hi,

Thanks for the replies - I haven't had a chance to try out everything
suggested yet - but your explanations of transformers nailed it for me.

However, in terms of performance when stacking, I've come across something
I'm struggling to explain - I was wondering if anyone could offer up and
explanation.
I've rewritten my code twice - one with 3 stacked monads, and one with 2
stacked monads and a load of maps.  Heuristically I would have thought the 3
stacked monads would have performed as well, or even better than the 2
stacked solution, but the 2 stacked solution is MUCH faster and MUCH less
memory is used.  They are both using 90% of the same code and both chain
together the same number of computations using replicateM.  From profiling I
can see that the pure function 'reflect' takes up most of the umph in both
cases - which I'd expect.  But in the triple stacked version the garbage
collector is using up >90% of the time.

I've tried using BangPatterns to reduce memory usage in the Triple Stack
version - doing this I can half the time it takes, but it is still running
at over twice the time of the two stack version.  The BangPatterns were also
put in Common Code in the reflect function - so I'd expect both solutions to
need them?

Even though both pieces of code are a bit untidy, the triple stacked monad
'feels' nicer to me - everything is encapsulated away and one evaluation in
main yields the result.  From purely a design perspective I prefer it - but
obviously not if it runs like a dog!

Any ideas why the triple stack runs so slow?

Thanks again!

Phil

***************** Triple Stack Specific Impl:

type MonteCarloStateT = StateT Double

mc :: MonteCarloStateT BoxMullerQuasiState ()
mc = StateT $ \s -> do nextNormal <- generateNormal
                       let stochastic = 0.2*1*nextNormal
                       let drift = 0.05 - (0.5*(0.2*0.2))*1
                       let newStockSum = payOff 100 ( 100 * exp ( drift +
stochastic ) ) + s
                       return ((),newStockSum)

iterations = 1000000
main :: IO()
main = do let sumOfPayOffs = evalState ( evalStateT ( execStateT (do
replicateM_ iterations mc) $ 0 ) $ (Nothing,nextHalton) ) $ (1,[3,5])
          let averagePO = sumOfPayOffs / fromIntegral iterations
          let discountPO = averagePO * exp (-0.05)
          print discountPO


***************** Double Stack and Map Specific Impl:


iterations = 1000000
main :: IO()
main = do let normals = evalState ( evalStateT (do replicateM iterations
generateNormal) $ (Nothing,nextHalton) ) $ (1,[3,5])
          let stochastic = map (0.2*1*) normals
          let sde = map ((( 0.05 - (0.5*(0.2*0.2)) )*1)+) stochastic
          let expiryMult = map exp sde
          let expiry = map (100*) expiryMult
          let payoff = map (payOff 100) expiry
          let averagePO = (foldr (+) 0 payoff) / fromIntegral iterations
          let discountPO = averagePO * exp (-0.05)
          print discountPO


***************** Common Code Used By Both Methods:


import Control.Monad.State
import Debug.Trace

-- State Monad for QRNGs - stores current iteration and list of
-- bases to compute
type QuasiRandomState = State (Int,[Int])

nextHalton :: QuasiRandomState [Double]
nextHalton = do (n,bases) <- get
                let !nextN = n+1
            put (nextN,bases)
            return $ map (reflect (n,1,0)) bases

type ReflectionThreadState = (Int,Double,Double)

reflect :: ReflectionThreadState -> Int -> Double
reflect (k,f,h) base
  | k <= 0 = h
  | otherwise = reflect (newK,newF,newH) base
      where
        newK = k `div` base
        newF = f / fromIntegral base
        newH = h + fromIntegral(k `mod` base) * newF

-- So we are defining a state transform which has state of 'maybe double'
and an
-- operating function for the inner monad of type QuasiRandomMonad returning
a [Double]
-- We then say that it wraps an QuasiRandomMonad (State Monad) - it must of
course
-- if we pass it a function that operates on these Monads we must wrap the
same
-- type of Monad.  And finally it returns a double

type BoxMullerStateT = StateT (Maybe Double, QuasiRandomState [Double])
type BoxMullerQuasiState = BoxMullerStateT QuasiRandomState

generateNormal :: BoxMullerQuasiState Double
generateNormal = StateT $ \s -> case s of
                (Just d,qrnFunc) -> return (d,(Nothing,qrnFunc))
                (Nothing,qrnFunc) -> do qrnBaseList <- qrnFunc
                                    let (norm1,norm2) = boxMuller (head
qrnBaseList) (head $ tail qrnBaseList)
                                    return (norm1,(Just norm2,qrnFunc))

boxMuller :: Double -> Double -> (Double,Double)
-- boxMuller rn1 rn2 | trace ( "rn1 " ++ show rn1 ++ " rn2 " ++ show rn2 )
False=undefined 
boxMuller rn1 rn2 = (normal1,normal2)
  where
    r        = sqrt ( (-2)*log rn1)
    twoPiRn2 = 2 * pi * rn2
    normal1  = r * cos ( twoPiRn2 )
    normal2  = r * sin ( twoPiRn2 )



payOff :: Double -> Double -> Double
payOff strike stock | (stock - strike) > 0 = stock - strike
                    | otherwise = 0




 



On 28/02/2009 13:31, "Daniel Fischer" <daniel.is.fischer at web.de> wrote:

> Am Samstag, 28. Februar 2009 13:23 schrieb Phil:
>> Hi,
>> 
>> The problem is ­ HOW DO I WRAP ANOTHER INDEPENDENT STATE AROUND THIS?
>> 
>> After some googling it looked like the answer may be Monad Transformers.
>> Specifically we could add a StateT transform for our Box Muller state to
>> our VanDerCorput State Monad.
>> Google didn¹t yield a direct answer here ­ so I¹m not even sure if my
>> thinking is correct, people describe the process of using a transform as
>> Œwrapping one monad in another¹ or Œthreading one monad into another¹.
>> What we want to do is have some internal state controlled by an independent
>> outer state -  this sounds about right to me?
> 
> If you absolutely don't want to have a state describing both, yes.
> 
>> 

<SNIP>