[Haskell] Monad transformer question
Cyril Schmidt
cschmidt at deds.nl
Wed Oct 25 08:49:06 EDT 2006
Working on a Monte-Carlo simulation where I have to
calculate the values of a certain function on the given set of inputs,
I noticed that some of the input variables change for every iteration,
while others do not.
To give a simple example, let's suppose I have a function
f a1 a2 p = a1*a2 + p
and I have to get its values for
[ (a1,a2,p) | a1 <- [0.1,0.2], a2 <- [0.1,0.2], p <- [0..9] ]
For efficiency, I want to pre-calculate (a1*a2) for each pair of a1 and a2,
and then calculate f for each p.
(The real function is far more complicated, but the idea is the same:
pre-calculate all that depends on seldom-changing variables, and then run
the rest of the iterations using the pre-calculated value).
I built my function f as a Reader monad because my real f has many
input parameters, so it is handy to have them packed in the Reader's
environment.
There are two Readers, in fact: the first environment contains the seldom-
-changing variables, the second contains the variable that changes often.
My code looked as follows.
>{-# OPTIONS -fno-monomorphism-restriction #-}
>module Main where
>import Control.Monad.Reader
The variable that changes most often:
>data Inner = Inner { p1 :: Double }
The variables that change seldom
>data Outer = Outer { a1 :: Double,
> a2 :: Double }
Function precalc pre-calculates (a1*a2)
>precalc = do
> a1 <- asks a1
> a2 <- asks a2
> let r = {-# SCC "r" #-} a1*a2
> return r
Function f in monadic form:
>f :: Reader Outer (Reader Inner Double)
>f = do
> r <- precalc
> return $ do { p1 <- asks p1
> ; let s = {-# SCC "s" #-} r+p1
> ; return s }
Function runf runs f over all values of p:
>runf (a1,a2) = do
> let reader = runReader f $ Outer a1 a2
> results = map (runReader reader) [ Inner { p1 = x } | x <- [0..9] ]
> putStrLn $ "a1 = "++show a1++", a2= "++show a2++", results = "
> ++show results
The main function
>main = mapM_ runf [(a1,a2) | a1 <- [0.1,0.2], a2 <- [0.1,0.2]]
This all works fine; the profiler shows that the (a1*a2) calculation is
performed
exactly 4 times, while addition, just as expected, 40 times.
I noticed that f
f :: Reader Outer (Reader Inner Double)
can be implemented using monad transformer:
f' :: ReaderT Outer (Reader Inner) Double
The only difference in the implementation is that f' uses lift instead of
return:
>f' :: ReaderT Outer (Reader Inner) Double
>f' = do
> r <- precalc
> lift $ do { p1 <- asks p1
> ; let s = {-# SCC "s" #-} r+p1
> ; return s }
>
>runf' (a1,a2) = do
> let reader = runReaderT f' $ Outer a1 a2
> results = map (runReader reader) [ Inner { p1 = x } | x <- [0..9] ]
> putStrLn $ "a1 = "++show a1++", a2= "++show a2++", results = "
> ++show results
However similar they look, f and f' have very different behaviour (their
results are the same, of course).
When I use runf' instead of runf, the profiler shows that precalc is
invoked 40 times,
which means that all the benefits of pre-calculating (a1*a2) are gone. (In
the real application, I pre-calculate a much more complicated and
expensive expression, that's why it matters).
I am curious why this happens. As far as I can see, the lift function of
ReaderT is the same as return of Reader, and the >>= in Reader and ReaderT
are pretty similar to each other, so why is the behaviour different?
This is a question of a purely theoretical significance for me; it does
not hinder my work in any way. Still, I would greatly appreciate any
ideas.
By the way, I am using GHC 6.4.2 on Windows.
Kind regards,
Cyril
More information about the Haskell
mailing list