[Haskell-cafe] Stacking State on State.....
Daniel Fischer
daniel.is.fischer at web.de
Sun Mar 1 18:56:07 EST 2009
Am Sonntag, 1. März 2009 23:18 schrieb Phil:
> Thanks very much for your patient explanations - this has really helped
> again!
>
> A few final questions in-line.....
>
> On 01/03/2009 21:46, "Daniel Fischer" <daniel.is.fischer at web.de> wrote:
> > One thing that helps much is to use
> >
> > import Control.Monad.State.Strict
> >
> > Using the default lazy State monad, you build enormous thunks in the
> > states, which harms the triple stack even more than the double stack.
> > With the strict State monad (and a strict left fold instead of foldr in
> > the double stack), I get
>
> Ahhh, I see. Just to make sure I understand this the Strict version will
> evaluate each state as an atomic number. The standard lazy version will
> create each state as an expression of past states... Consequentially these
> will grow and grow as state is incremented?
No, it's not that strict. If it were, we wouldn't need the bang on newStockSum
(but lots of applications needing some laziness would break).
The Monad instance in Control.Monad.State.Strict is
instance (Monad m) => Monad (StateT s m) where
return a = StateT $ \s -> return (a, s)
m >>= k = StateT $ \s -> do
(a, s') <- runStateT m s
runStateT (k a) s'
fail str = StateT $ \_ -> fail str
(In the lazy instance, the second line of the >>= implementation is
~(a,s') <- runStateT m s)
The state will only be evaluated if "runStateT m" resp. "runStateT (k a)"
require it. However, it is truly separated from the return value a, which is
not the case in the lazy implementation.
The state is an expression of past states in both implementations, the
expression is just much more complicated for the lazy.
>
> >> 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)
> >
> > Don't use a new let on each line, have it all in one let-block.
> > And, please, force the evaluation of newStockSum:
>
> I had looked at making this strict (along with the values in the reflect
> function too), it was making a little bit of difference, but not much. I
> reckon this is because the improvement was being masked by the lazy state
> monad. Now that this is corrected, I can see it makes a big difference.
Yes, the bang doesn't do anything until the state is inspected. In the lazy
state monad, the lazy (~) patterns delay that until the very end, when it has
to be evaluated anyway.
>
> One question here tho - if we have made our State strict, will this not
> result in newStockSum being atomically evaluated when we set the new state?
No, see above, it's not that strict. But as state and return value are now
properly separated, we can effectively say "evaluate now".
>
> Also on the use of multiple 'let' statements - this has obviously
> completely passed me by so far! I'm assuming that under one let we only
> actually create the newStockSum, but with 3 let statements, each is created
> as a separate entity?
I think both forms are equivalent, I just find it easier to parse with one
'let'.
>
> > w00t!
>
> You're not joking - this is a textbook example of performance enhancement!
> It's clearly something I have to keep more in mind.
>
> >> ***************** 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
> >
> > Same here, but important for performance is to replace the foldr with
> > foldl'.
>
> Again I understand that foldl' is the strict version of foldl, and as we
> are summing elements we can use either foldl or foldr.
Since addition of floating point numbers is neither associative nor
commutative, they can lead to different results, so it might also matter for
the result and not only the performance, which you use. But using foldr with
a strict combination function on a long list always gives poor performance,
you build a thunk of the form
a1 + (a2 + (a3 + ........ (an + b) ........))
and before any evaluation can be done, the whole list has to be traversed,
requiring O(n) space (beware of stack overflows).
If you use foldl, you build a thunk of the form
((...(b + a1) + ...) + an), again requiring O(n) space, unless the compiler
sees the value is needed and transforms it into foldl' itself.
> I'm assuming this
> is another thunk optimisation. Does foldl not actually calculate the sum,
> but moreover it creates an expression of the form a+b+c+d+e+.... Where
> foldl' will actually evaluate the expression to an atomic number?
What foldl does depends on what the compiler sees. It may build a thunk or it
may evaluate it at each step (when summing Ints and compiling with
optimisations, chances are good). If you use foldl', at each step the
accumulator is evaluated to weak head normal form, for types like Int or
Double, that is complete evaluation, but for lists, evaluation goes only so
far to determine whether it's [] or (_:_).
To get complete evaluation at each step,
import Control.Parallel.Strategies
result = foldl' f' z xs
where
f' y x = (f y x) `using` rnf
comes in handy.
>
> > Cheers,
> > Daniel
More information about the Haskell-Cafe
mailing list