Multiple functions applied to a single value
Graham Klyne
gk at ninebynine.org
Fri Nov 28 11:40:19 EST 2003
At 21:03 27/11/03 -0500, Derek Elkins wrote:
>On Thu, 27 Nov 2003 14:56:03 +0000
>Graham Klyne <gk at ninebynine.org> wrote:
>
>(perhaps a more serious and to the point reply later)
>
> > But not all cases I encounter involve lists or monads. A different
> > case might look like this:
>
>Are you sure this doesn't involve monads?
No, I'm not, and yours is very much the kind of response I was hoping to
elicit... but I think I may need a little more help to properly "get it".
I'm looking at:
[1] http://www.haskell.org/hawiki/MonadReader
[2] http://www.haskell.org/ghc/docs/latest/html/base/Control.Monad.Reader.html
[3] http://www.nomaware.com/monads/html/readermonad.html
You say of my examples "(these work fine with a Monad instance ((->) r)
which is a Reader monad)". If I get this correctly, (->) used here is a
type constructor for a function type [ah yes... p42 of the Haskell report,
but not in the index].
In [2] I see ((->) r) as an instance of MonadReader r, which you also
say. I think this means that a function from r to something is an instance
MonadReader r. So in my definition of eval:
eval f g1 g2 a = f (g1 a) (g2 a)
g1 and g2 are instances of MonadReader a. Which I can see means that eval
is liftM2 as you say: it takes a 2-argument function f and 'lifts' it to
operate on the monads g1 and g2.
So far, so good, but what are the implications of g1 and g2 being monads?
From [2], we have:
class (Monad m) => MonadReader r m | m -> r where
MonadReader r ((->) r)
So ((->) r) must be a Monad.
How are the standard monad operators implemented for ((->) r)? Maybe:
instance Monad ((->) r) where
return a = const a -- is this right? As I understand,
-- return binds some value into a monad.
-- (>>=) :: m a -> (a -> m b) -> m b
g1 >>= f = \e -> f (g1 e) e
<aside>
so, if f is \a -> g2, we get:
g1 >>= f = \e -> (\a -> g2) (g1 e) e
= \e -> g2 e
= g2
</aside>
Hmmm... this seems plausible, but I'm not clear-sighted enough to see if I
have the ((->) r) monad right. [Later: though it seems to work as intended.]
Looking at [3], I get a little more insight. It seems that ((->) r) is a
function with a type of "Computations which read values from a shared
environment", where r is the type of the shared environment. Monadic
sequencing (>>=) passes the result from one monad/function to the
next. The monad is used by applying it to an instance of the shared
environment.
So, returning to my example, it would appear that the idiom I seek is:
liftM2 f g1 g2
or:
liftM3 f g1 g2 g3
etc.
Provided that ((->) r) is appropriately declared as an instance of
Monad. Does this work with the above declaration?
liftM2 f g1 g2
= do { g1' <- g1 ; g2' <- g2 ; return (f g1' g2') } [from
Monad]
= g1 >>= \g1' -> g2 >>= \g2' -> return (f g1'
g2') [do-notation]
= \e1 -> (\g1' -> g2 >>= \g2' -> return (f g1' g2')) (g1 e1) e1
[above: g1 >>= f = (\e -> f
(g1 e) e)]
= \e1 -> (\g1' -> \e2 -> (\g2' -> return (f g1' g2')) (g2 e2) e2)
(g1 e1) e1
[again]
= \e1 -> (\e2 -> (return (f (g1 e1) (g2 e2))) e2) e1
[apply fns: g1' = g1 e1,g2'
= g2 e2]
= \e1 -> (return (f (g1 e1) (g2 e1))) e1
[apply fn: e2 = e1]
= \e1 -> (return (f (g1 e1) (g2 e1))) e1
[apply fn: e2 = e1]
= \e1 -> (const (f (g1 e1) (g2 e1))) e1
[above: return = const]
= \e1 -> (f (g1 e1) (g2 e1)))
[apply const]
Which is the desired result (!)
>(these work fine with a Monad instance ((->) r) which is a Reader monad)
Hmmm... is it true that ((->) r) *is* a reader monad? It seems to me that
it is a Monad which can be used to build a reader monad.
...
The more I do with Haskell the more impressed I am by the folks who figured
out this Monad wizardry.
A question I find myself asking at the end: why isn't ((->) r) declared as
a Monad instance in the standard prelude? If I'm following all this
correctly, it seems like a natural to include there.
Thanks for pointing me in this direction. I hope my ramblings are
on-track, and not too tedious to wade through.
#g
--
> > > eval :: (b->c->d) -> (a->b) -> (a->c) -> (a->d)
> > > eval f g1 g2 a = f (g1 a) (g2 a)
>
>eval :: Monad m => (b -> c -> d) -> m b -> m c -> m d
>eval = liftM2
>
> > So, for example, a function to test of the two elements of a pair are
> > the same might be:
> >
> > > pairSame = eval (==) fst snd
> >
> > giving:
> >
> > > pairSame (1,2) -- false
> > > pairSame (3,3) -- true
> >
> >
> > Or a function to subtract the second and subsequent elements of a list
> > from the first:
> >
> > > firstDiffRest = eval (-) head (sum . tail)
> >
> > > firstDiffRest [10,4,3,2,1] -- 0
------------
Graham Klyne
For email:
http://www.ninebynine.org/#Contact
More information about the Haskell-Cafe
mailing list