
I know very little about profiling, but your comment about spending a lot of
time garbage collecting rang a bell with me - the example on RWH talks about
that exact issue. Thus, I would recommend walking through the profiling
techniques described on
http://book.realworldhaskell.org/read/profiling-and-optimization.html .
On Sun, Mar 1, 2009 at 3:03 PM, 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"
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>