Personal tools

Compose

From HaskellWiki

(Difference between revisions)
Jump to: navigation, search
(cont section, references, execWriter)
(composeReader' = foldr local id)
 
(9 intermediate revisions by 6 users not shown)
Line 1: Line 1:
 
<hask>Compose</hask> is a nice little module which shows off some of the features of the various monads around.
 
<hask>Compose</hask> is a nice little module which shows off some of the features of the various monads around.
   
The task is to write a function <hask>compose :: [(a -> a)] -> (a -> a)</hask>, which should take a list of functions and chain them together: a value would be fed into the first, which then produces a new value, which is fed into the third, and so on. I.e. <hask>compose [(*2), (+1)] 3 = 8</hask>.
+
The task is to write a function <hask>compose :: [a -> a] -> (a -> a)</hask>, which should take a list of functions and chain them together: a value would be fed into the first, which then produces a new value, which is fed into the second, and so on. I.e. <hask>compose [(*2), (+1)] 3 = 7</hask>.
   
 
This page illustrates the solution in different monads. Most are a bit of a joke; you'd probably only ever use the first solution presented, but nevertheless the nice features of the various monads are demonstrated.
 
This page illustrates the solution in different monads. Most are a bit of a joke; you'd probably only ever use the first solution presented, but nevertheless the nice features of the various monads are demonstrated.
   
== The Sane Solution ==
+
== The sane solution ==
 
<haskell>
 
<haskell>
compose :: [(a -> a)] -> a -> a
+
compose :: [a -> a] -> a -> a
 
compose fs v = foldl (flip (.)) id fs $ v
 
compose fs v = foldl (flip (.)) id fs $ v
 
</haskell>
 
</haskell>
   
This one's easy. We fold over the list using composition as our combinator to join items. We flip it, though, because we want a value to be fed into the first function in the list first, but <hask>f . g</hask> applies <hask>g</hask> before <hask>f</hask>.
+
This one's easy. We fold over the list using [[Function composition|composition]] as our combinator to join items. We flip it, though, because we want a value to be fed into the first function in the list first, but <hask>f . g</hask> applies <hask>g</hask> before <hask>f</hask>.
   
 
We use <hask>id</hask> as the starting value, as <hask>id</hask> is an identity for composition.
 
We use <hask>id</hask> as the starting value, as <hask>id</hask> is an identity for composition.
Line 17: Line 17:
 
== Using <hask>State</hask> ==
 
== Using <hask>State</hask> ==
 
<haskell>
 
<haskell>
composeState :: [(a -> a)] -> a -> a
+
composeState :: [a -> a] -> a -> a
 
composeState = execState . mapM modify
 
composeState = execState . mapM modify
 
</haskell>
 
</haskell>
Line 41: Line 41:
 
== Using <hask>Reader</hask> ==
 
== Using <hask>Reader</hask> ==
 
<haskell>
 
<haskell>
composeReader :: [(a -> a)] -> a -> a
+
composeReader :: [a -> a] -> a -> a
 
composeReader fs v = runReader (compose' fs) v
 
composeReader fs v = runReader (compose' fs) v
 
where compose' [] = ask
 
where compose' [] = ask
 
compose' (f:fs) = local f (compose' fs)
 
compose' (f:fs) = local f (compose' fs)
  +
-- compose' = foldr local ask
  +
  +
-- alternative: no runReader or ask required
  +
-- TODO: explain why this works
  +
composeReader' :: [a -> a] -> a -> a
  +
composeReader' = foldr local id
 
</haskell>
 
</haskell>
   
Line 67: Line 73:
 
== Using <hask>Writer</hask> ==
 
== Using <hask>Writer</hask> ==
 
<haskell>
 
<haskell>
composeWriter :: [(a -> a)] -> a -> a
+
composeWriter :: [a -> a] -> a -> a
 
composeWriter fs v = (execWriter $ compose' fs) v
 
composeWriter fs v = (execWriter $ compose' fs) v
 
where compose' [] = return id
 
where compose' [] = return id
 
compose' (f:fs) = censor (. f) (compose' fs)
 
compose' (f:fs) = censor (. f) (compose' fs)
  +
-- compose' = foldr (censor . flip (.)) (return id)
 
</haskell>
 
</haskell>
   
Line 77: Line 84:
 
Our tactic here is really rather similar to that of the <hask>Reader</hask> example. We build up a computation which is the result of modifying the environment (or, actually, as we're working in <hask>Writer</hask>, we modify the output). <hask>censor</hask>, to quote All About Monad, "...takes a function and a <hask>Writer</hask> and produces a new <hask>Writer</hask> whose output is the same but whose log entry has been modified by the function.". So, we compose each function in turn onto the "log output" (which is actually a chain of composed functions).
 
Our tactic here is really rather similar to that of the <hask>Reader</hask> example. We build up a computation which is the result of modifying the environment (or, actually, as we're working in <hask>Writer</hask>, we modify the output). <hask>censor</hask>, to quote All About Monad, "...takes a function and a <hask>Writer</hask> and produces a new <hask>Writer</hask> whose output is the same but whose log entry has been modified by the function.". So, we compose each function in turn onto the "log output" (which is actually a chain of composed functions).
   
Once this computation has been build up, we extract this long composition chain, and apply it to our starting value.
+
Once this computation has been built up, we extract this long composition chain, and apply it to our starting value.
  +
  +
Also interesting to note is that this method is really equivalent to the "Sane method" described above. We just iterate along the list, accumulating a composition chain. The only difference here is that we're using some of <hask>Writer</hask>'s plumbing to make it more subtle.
   
 
== Using <hask>Cont</hask> ==
 
== Using <hask>Cont</hask> ==
I'm pretty sure this could be done, but I don't have a clue how! If you know <hask>Cont</hask>, please write this section!
+
The <hask>Cont</hask> example is so complicated it needs its own helper functions!
  +
  +
<haskell>
  +
getCC :: MonadCont m => m (m a)
  +
getCC = callCC (\c -> let x = c x in return x)
  +
getCC' :: MonadCont m => a -> m (a, a -> m b)
  +
getCC' x0 = callCC (\c -> let f x = c (x, f) in return (x0, f)
  +
</haskell>
  +
  +
These are rather complex if you don't know CPS and the <hask>Cont</hask> monad well already, but essentially they create a GOTO-style checkpoint. You can use a do-block something along these lines:
  +
  +
<haskell>
  +
do stuff;
  +
boing <- getCC
  +
moreStuff;
  +
boing;
  +
</haskell>
  +
  +
And you'll pop back up to <hask>boing</hask>. <hask>getCC'</hask> is similar, but it lets you use a parameter. Again, to exemplify:
  +
  +
<haskell>
  +
x `modulo` m = (`runContT` return) $ do (u, jump) <- getCC' x
  +
lift $ print u
  +
case u of
  +
_ | u < 0 -> jump (u + m)
  +
| u >= m -> jump (u - m)
  +
| otherwise -> return u
  +
</haskell>
  +
  +
This takes <hask>m</hask>-sized chunks off of <hask>u</hask> (which starts off being <hask>x</hask>) until <hask>u</hask> is in range. Right, on to the actual <hask>compose</hask> itself:
  +
  +
<haskell>
  +
composeCont :: [a -> a] -> a -> a
  +
composeCont fs = runCont compose' id
  +
where compose' = do ((gs,f), jump) <- getCC' (fs,id)
  +
case gs of
  +
[] -> return f
  +
(g:gs') -> jump (gs', g . f)
  +
</haskell>
  +
  +
This is similar to the <hask>modulo</hask> loop above, but uses a pair as the passed parameter. It walks down the list, accumulating the composition chain. Instead of building a composition chain, it is possible to act on the value directly, a bit like with the <hask>State</hask> example:
  +
  +
<haskell>
  +
composeCont :: [a -> a] -> a -> a
  +
composeCont fs x = runCont compose' id
  +
where compose' = do ((gs,y), jump) <- getCC' (fs,x)
  +
case gs of
  +
[] -> return y
  +
(g:gs') -> jump (gs', g y)
  +
</haskell>
  +
  +
Thanks to Cale Gibbard for providing this example.
   
 
== References ==
 
== References ==
Line 96: Line 103:
 
import Control.Monad.Reader
 
import Control.Monad.Reader
 
import Control.Monad.State
 
import Control.Monad.State
  +
import Control.Monad.Cont
   
compose :: [(a -> a)] -> a -> a
+
compose :: [a -> a] -> a -> a
 
compose fs v = foldl (flip (.)) id fs $ v
 
compose fs v = foldl (flip (.)) id fs $ v
   
composeState :: [(a -> a)] -> a -> a
+
composeState :: [a -> a] -> a -> a
 
composeState = execState . mapM modify
 
composeState = execState . mapM modify
   
composeReader :: [(a -> a)] -> a -> a
+
composeReader :: [a -> a] -> a -> a
 
composeReader fs v = runReader (compose' fs) v
 
composeReader fs v = runReader (compose' fs) v
 
where compose' [] = ask
 
where compose' [] = ask
 
compose' (f:fs) = local f (compose' fs)
 
compose' (f:fs) = local f (compose' fs)
   
composeWriter :: [(a -> a)] -> a -> a
+
composeWriter :: [a -> a] -> a -> a
 
composeWriter fs v = (execWriter $ compose' fs) v
 
composeWriter fs v = (execWriter $ compose' fs) v
 
where compose' [] = return id
 
where compose' [] = return id
 
compose' (f:fs) = censor (. f) (compose' fs)
 
compose' (f:fs) = censor (. f) (compose' fs)
  +
  +
getCC :: MonadCont m => m (m a)
  +
getCC = callCC (\c -> let x = c x in return x)
  +
getCC' :: MonadCont m => a -> m (a, a -> m b)
  +
getCC' x0 = callCC (\c -> let f x = c (x, f) in return (x0, f))
  +
  +
composeCont :: [a -> a] -> a -> a
  +
composeCont fs = runCont compose' id
  +
where compose' = do ((gs,f), jump) <- getCC' (fs,id)
  +
case gs of
  +
[] -> return f
  +
(g:gs') -> jump (gs',g . f)
   
 
main = do let fs = [(+1), (*2), \n -> (n - 5) * 4]
 
main = do let fs = [(+1), (*2), \n -> (n - 5) * 4]
Line 119: Line 139:
 
putStrLn $ "composeReader: " ++ (show $ composeReader fs v)
 
putStrLn $ "composeReader: " ++ (show $ composeReader fs v)
 
putStrLn $ "composeWriter: " ++ (show $ composeWriter fs v)
 
putStrLn $ "composeWriter: " ++ (show $ composeWriter fs v)
  +
putStrLn $ "composeCont: " ++ (show $ composeCont fs v)
   
 
{-
 
{-
Line 126: Line 147:
 
composeReader: 12
 
composeReader: 12
 
composeWriter: 12
 
composeWriter: 12
  +
composeCont: 12
 
-}
 
-}
 
</haskell>
 
</haskell>
  +
  +
[[Category:Idioms]]

Latest revision as of 06:26, 18 September 2008

Compose
is a nice little module which shows off some of the features of the various monads around. The task is to write a function
compose :: [a -> a] -> (a -> a)
, which should take a list of functions and chain them together: a value would be fed into the first, which then produces a new value, which is fed into the second, and so on. I.e.
compose [(*2), (+1)] 3 = 7
.

This page illustrates the solution in different monads. Most are a bit of a joke; you'd probably only ever use the first solution presented, but nevertheless the nice features of the various monads are demonstrated.

Contents

[edit] 1 The sane solution

compose :: [a -> a] -> a -> a
compose fs v = foldl (flip (.)) id fs $ v
This one's easy. We fold over the list using composition as our combinator to join items. We flip it, though, because we want a value to be fed into the first function in the list first, but
f . g
applies
g
before
f
. We use
id
as the starting value, as
id
is an identity for composition.

[edit] 2 Using
State

composeState :: [a -> a] -> a -> a
composeState = execState . mapM modify
Here we use but a single feature of the very powerful
State
monad. To understand how this code works, consider it in the less eta-reduced form:
composeState fs v = execState (mapM modify fs) v
mapM
iterates over the list of functions, applying
modify
to each one. If we were to expand a list after it had been mapped over in this way,
fs = mapM modify [(*2), (+1), \n -> (n - 5) * 4]
-- fs is entirely equivalent to the following do-block:
fs' = do modify (*2)
         modify (+1)
         modify (\n -> (n - 5) * 4)

In other words, we obtain a stateful computation that modifies the state with the first function in the list, then the second, and so on.

[edit] 3 Using
Reader

composeReader :: [a -> a] -> a -> a
composeReader fs v = runReader (compose' fs) v
   where compose' []     = ask
         compose' (f:fs) = local f (compose' fs)
-- compose' = foldr local ask
 
-- alternative: no runReader or ask required
-- TODO: explain why this works
composeReader' :: [a -> a] -> a -> a
composeReader' = foldr local id
The
Reader
monad is a bit like
State
, but not as general. It doesn't allow you to permanently change the environment, so that spoils our previous approach of chaining
modify
calls together in a do-block. However, there is a useful little function
local
which allows us to temporarily modify the environment for a given computation. We can use this to recurse on our list: we modify the environment by the first function in the list for the computation
compose' fs
, which is the recursion on the rest of the list. Again, we could expand out:
fs = compose' [(*2), (+1), \n -> (n - 5) * 4]
-- again, this is entirely equivalent to the following:
fs' = local (*2) $
          local (+1) $
              local (\n -> (n - 5) * 4) ask
ask
is a simple function that just returns the current environment. Our tactic in words here is to create a computation (the result of the
compose'
call) which modifies the environment for another computation which further modifies the environment for another computation which modifies the environment yet further... until finally we hit the end of our list and we just return the environment, which has had all the functions in our list applied to it.

Once this composition has been built up, we run it, starting off with an environment of the starting value.

[edit] 4 Using
Writer

composeWriter :: [a -> a] -> a -> a
composeWriter fs v = (execWriter $ compose' fs) v 
    where compose' []     = return id
          compose' (f:fs) = censor (. f) (compose' fs)
-- compose' = foldr (censor . flip (.)) (return id)
This example comes with a disclaimer. You should never use
Writer
in this way. This example was really just an experimentation to see if
Writer
could be twisted in this way! Our tactic here is really rather similar to that of the
Reader
example. We build up a computation which is the result of modifying the environment (or, actually, as we're working in
Writer
, we modify the output).
censor
, to quote All About Monad, "...takes a function and a
Writer
and produces a new
Writer
whose output is the same but whose log entry has been modified by the function.". So, we compose each function in turn onto the "log output" (which is actually a chain of composed functions).

Once this computation has been built up, we extract this long composition chain, and apply it to our starting value.

Also interesting to note is that this method is really equivalent to the "Sane method" described above. We just iterate along the list, accumulating a composition chain. The only difference here is that we're using some of
Writer
's plumbing to make it more subtle.

[edit] 5 Using
Cont

The
Cont
example is so complicated it needs its own helper functions!
getCC :: MonadCont m => m (m a)
getCC = callCC (\c -> let x = c x in return x)
getCC' :: MonadCont m => a -> m (a, a -> m b)
getCC' x0 = callCC (\c -> let f x = c (x, f) in return (x0, f)
These are rather complex if you don't know CPS and the
Cont
monad well already, but essentially they create a GOTO-style checkpoint. You can use a do-block something along these lines:
do stuff;
   boing <- getCC
   moreStuff;
   boing;
And you'll pop back up to
boing
.
getCC'
is similar, but it lets you use a parameter. Again, to exemplify:
x `modulo` m = (`runContT` return) $ do (u, jump) <- getCC' x
                                        lift $ print u
                                        case u of
                                        _ | u < 0     -> jump (u + m)
                                          | u >= m    -> jump (u - m)
                                          | otherwise -> return u
This takes
m
-sized chunks off of
u
(which starts off being
x
) until
u
is in range. Right, on to the actual
compose
itself:
composeCont :: [a -> a] -> a -> a
composeCont fs = runCont compose' id
    where compose' = do ((gs,f), jump) <- getCC' (fs,id)
                        case gs of
                          []      -> return f
                          (g:gs') -> jump (gs', g . f)
This is similar to the
modulo
loop above, but uses a pair as the passed parameter. It walks down the list, accumulating the composition chain. Instead of building a composition chain, it is possible to act on the value directly, a bit like with the
State
example:
composeCont :: [a -> a] -> a -> a
composeCont fs x = runCont compose' id
   where compose' = do ((gs,y), jump) <- getCC' (fs,x)
                       case gs of
                         []      -> return y
                         (g:gs') -> jump (gs', g y)

Thanks to Cale Gibbard for providing this example.

[edit] 6 References

Mainly see All About Monads, specifically chapter two, which has overviews and examples for all the major monads.

[edit] 7 The whole code

In case you wish to run this code, here it is in its entirety:

-- Thread a value through a list of function applications
 
module Compose where
 
import Control.Monad.Writer
import Control.Monad.Reader
import Control.Monad.State
import Control.Monad.Cont
 
compose :: [a -> a] -> a -> a
compose fs v = foldl (flip (.)) id fs $ v
 
composeState :: [a -> a] -> a -> a
composeState = execState . mapM modify
 
composeReader :: [a -> a] -> a -> a
composeReader fs v = runReader (compose' fs) v
   where compose' []     = ask
         compose' (f:fs) = local f (compose' fs)
 
composeWriter :: [a -> a] -> a -> a
composeWriter fs v = (execWriter $ compose' fs) v 
    where compose' []     = return id
          compose' (f:fs) = censor (. f) (compose' fs)
 
getCC :: MonadCont m => m (m a)
getCC = callCC (\c -> let x = c x in return x)
getCC' :: MonadCont m => a -> m (a, a -> m b)
getCC' x0 = callCC (\c -> let f x = c (x, f) in return (x0, f))
 
composeCont :: [a -> a] -> a -> a
composeCont fs = runCont compose' id
    where compose' = do ((gs,f), jump) <- getCC' (fs,id)
                        case gs of
                          []      -> return f
                          (g:gs') -> jump (gs',g . f)
 
main = do let fs = [(+1), (*2), \n -> (n - 5) * 4]
              v  = 3
          putStrLn $ "compose: "       ++ (show $ compose       fs v)
          putStrLn $ "compostState: "  ++ (show $ composeState  fs v)
          putStrLn $ "composeReader: " ++ (show $ composeReader fs v)
          putStrLn $ "composeWriter: " ++ (show $ composeWriter fs v)
          putStrLn $ "composeCont: "   ++ (show $ composeCont   fs v)
 
{-
*Compose> main
compose: 12
compostState: 12
composeReader: 12
composeWriter: 12
composeCont: 12
-}