[Haskell-cafe] Multiple State Monads

Phil pbeadling at mail2web.com
Tue Jan 13 19:45:58 EST 2009


Ahh, I see ­ so using the State monad is arguably overcomplicating this.
This is very helpful.

The use of Œkeyword¹ was just an unfortunate use of terminology ­ my bad.

Very useful explanation about the laziness resulting in stack overflows too
­ when I crank up the numbers I have been seeing this, I had been
temporarily ignoring the issue and just increasing the stack size at
runtime, but I suspected something was awry.

One last question on this function:

In the definition:

mcSimulate :: Double -> Double -> Word64 -> [Double]
mcSimulate startStock endTime seedForSeed = fst expiryStock : mcSimulate
startStock endTime newSeedForSeed

It is abundantly clear that the startStock and endTime are just being passed
around from call to call unchanged ­ that is their value is constant
throughout the the simulation.  For the purposes here when I¹m only passing
2 Œconstants¹ around it doesn¹t strike me as too odd, but my list of
Œconstants¹ is likely to grow as I bolt more functionality onto this.  For
readability, I understand that I can create new types to encapsulate complex
data types into a single type , but I can¹t help thinking that passing say 9
or 10 Œconstants¹ around and around like this Œfeels wrong¹.  If I sit back
and think about it, it doesn¹t strike me as implausible that the compiler
will recognize what I¹m doing and optimize this out for me, and what I¹m
doing is thinking about the whole think like a C++ programmer (which I
traditionally am) would.

However before I allayed my own concerns I wanted to check that in the
Haskell world passing around lots of parameters isn¹t a bad thing ­ that is,
I¹m not missing a trick here to make my code more readable or more
importantly more performant.

Thanks again,

Phil.

On 13/01/2009 23:24, "Luke Palmer" <lrpalmer at gmail.com> wrote:

> On Tue, Jan 13, 2009 at 3:29 PM, Phil <pbeadling at mail2web.com> wrote:
>> My only concern with using this method is - Will 'iterate' not create a full
>> list of type [Double] and then take the final position once the list has
>> been fully realized?  For my application this would be undesirable as the
>> list may be millions of items long, and you only ever care about the last
>> iteration (It's a crude Monte Carlo simulator to give it some context).  If
>> Haskell is smart enough to look ahead and see as we only need the last
>> element as it is creating the list, therefore garbage collecting earlier
>> items then this would work fine - by I'm guessing that is a step to far for
>> the compiler?
> 
> No, doing this type of thing is very typical Haskell, and the garbage
> collector will incrementally throw away early elements of the list.
> 
>> 
>> I had originally implemented this similar to the above (although I didn't
>> know about the 'iterate' keyword
> 
> FWIW, iterate is just a function, not a keyword.  Could just be terminology
> mismatch.
>  
> So, while the garbage collector will do the right thing, for a list millions
> of elements long, I suspect you will get stack overflows and/or bad memory
> performance because the computation is too lazy.  One solution is to use a
> stricter version of !!, which evaluates elements of the list as it whizzes by
> them.  Because the function you're iterating is strict to begin with, you do
> not lose performance by doing this:
> 
> strictIdx :: Int -> [a] -> a
> strictIdx _ []     = error "empty list"
> strictIdx 0 (x:xs) = x
> strictIdx n (x:xs) = x `seq` strictIdx (n-1) xs
> 
> (Note that I flipped the arguments, to an order that is nicer for currying)
> 
> The reason is that iterate f x0 constructs a list like this:
> 
> [ x0, f x0, f (f x0), f (f (f x0)), ... ]
> 
> But shares the intermediate elements, so if we were to evaluate the first f x0
> to, say, 42, then the thunks are overwritten and become:
> 
> [ x0, 42, f 42, f (f 42), ... ]
> 
> So iterate f x0 !! 1000000 is f (f (f (f ( ... a million times ... f x0)))),
> which will be a stack overflow because of each of the calls.  What strictIdx
> does is to evaluate each element as it traverses it, so that each call is only
> one function deep, then we move on to the next one.
> 
> This is the laziness abstraction leaking.  Intuition about it develops with
> time and experience.  It would be great if this leak could be patched by some
> brilliant theorist somewhere.
> 
> Luke
> 
>>  - which makes things tidier - a useful
>> tip!), I moved to using the state monad and replicateM_ for the first
>> truncate(endTime/timeStep)-1 elements so that everything but the last result
>> is thrown away, and a final bind to getEvolution would return the result.
>> 
>> Now that the code has been modified so that no result is passed back, using
>> modify and execState, this can be simplified to "replicateM_
>> truncate(endTime/timeStep)" with no final bind needed.  I've tried this and
>> it works fine.
>> 
>> The key reason for using the Monad was to tell Haskell to discard all but
>> the current state.  If I'm wrong about please let me know, as I don't want
>> to be guilty of overcomplicating my algorithm, and more importantly it means
>> I'm not yet totally grasping the power of Haskell!
>> 
>> Thanks again,
>> 
>> Phil.
>> 
>> 
>> 
>> 
>> On 13/01/2009 03:13, "David Menendez" <dave at zednenem.com> wrote:
>> 
>>> > On Mon, Jan 12, 2009 at 8:34 PM, Phil <pbeadling at mail2web.com> wrote:
>>>> >> 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.
>>> >
>>> > If you have a function which transforms the state, you can lift it
>>> > into the state monad using "modify".
>>> >
>>>> >> 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 = modify evolveUnderlying
>>> >
>>> > Now, I don't know the full context of what you're doing, but the
>>> > example you posted isn't really gaining anything from the state monad.
>>> > Specifically,
>>> >
>>> >   execState (replicateM_ n (modify f))
>>> > = execState (modify f >> modify f >> ... >> modify f)
>>> > = execState (modify (f . f . ... . f))
>>> > = f . f . ... . f
>>> >
>>> > So you could just write something along these lines,
>>> >
>>>> >> mcSimulate :: Double -> Double -> Word64 -> [Double]
>>>> >> mcSimulate startStock endTime seedForSeed = fst expiryStock : mcSimulate
>>>> >> startStock endTime newSeedForSeed
>>>> >>  where
>>>> >>    expiryStock = iterate evolveUnderlying (startStock, ranq1Init
>>>> seedForSeed)
>>>> >> !! truncate (endTime/timeStep)
>>>> >>    newSeedForSeed = seedForSeed + 246524
>>> >
>>> >
>>> > Coming back to your original question, it is possible to work with
>>> > nested state monad transformers. The trick is to use "lift" to make
>>> > sure you are working with the appropriate state.
>>> >
>>> > get :: StateT s1 (State s2) s1
>>> > put :: s1 -> StateT s1 (State s2) ()
>>> >
>>> > lift get :: StateT s1 (State s2) s2
>>> > lift put :: s2 -> StateT s1 (State s2) ()
>>> >
>>> > A more general piece of advice is to try breaking things into smaller
>>> > pieces. For example:
>>> >
>>> > getRanq1 :: MonadState Word64 m => m Word64
>>> > getRanq1 = do
>>> >     seed <- get
>>> >     put (ranq1Increment seed)
>>> >     return seed
>>> >
>>> > getEvolution :: StateT Double (State Word64) ()
>>> > getEvolution = do
>>> >     seed <- lift getRanq1
>>> >     modify $ \stock -> stock * exp ( ( ir - (0.5*(vol*vol)) )*timeStep
>>> > + ( vol*sqrt(timeStep)*normalFromRngState(seed) ) )
>>> >
>> 
>> _______________________________________________
>> Haskell-Cafe mailing list
>> Haskell-Cafe at haskell.org
>> http://www.haskell.org/mailman/listinfo/haskell-cafe
>> 
>> 

-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/haskell-cafe/attachments/20090114/899b5784/attachment.htm


More information about the Haskell-Cafe mailing list