CMPUT 325 Schedule and Outcomes
12. Week 10 - Mar 17

## 12.1 Topics

• Solutions to Midterm 2.

• The trees question is an example of how to use a functor, that is an operation that passes through the wall of a container to operate on its contents.

• We will will use the chain example to resume and motivate our discussion of the notion of a monad (functional programming).

• Assignment 3. TBA

• NOTE: `undefined` is the value of any type, so you can have a function to any.

## 12.2 Solutions to Midterm 2

You may have observed by now that the solutions are usually short. That is because the problems we are posing are particularly suited to the functional programming style. The difficulty is not so much in the coding, but in understanding the formulation of the problem and the functions that have already been specified.

This time we also provided sample test cases and outputs that illustrated what kinds of outputs to expect from the functions.

## 12.3 Question 2 - trees

Two themes runs through the tree question: traversal of the data structure, and functorial manipulation. Traversals extract data form the structure and then perform an operation on the resulting data. For example,
`sum (dfslr tree)`
sums up the values of the leaves in the tree.

Functorial operations perform operations on the contents of the tree, leaving the shape of the structure intact (for some value of intact in the case of recursive structures).

code/Week10/functor.hs

 `    ``data Box v = Boxed v | Undefined` `    ``    deriving (Eq, Show)` `    `` ` `    ``instance Functor Box where` `    ``    fmap f (Boxed v) = Boxed (f v)` `    ``    fmap f Undefined = Undefined` `    `` ` `    ``{-` `    ``    Functors move operations over the boundaries of containers onto the contained` `    ``    entities.` `    `` ` `    ``    Instances of 'Functor' should satisfy the following laws:` `    `` ` `    ``        fmap id  ==  id` `    ``        fmap (f . g)  ==  fmap f . fmap g` `    `` ` `    ``    Examples:` `    `` ` `    ``    > fmap (+ 1) (Boxed 10)` `    ``    Boxed 11` `    `` ` `    ``    > fmap (+ 1) Undefined` `    ``    Undefined` `    `` ` `    ``    > map (fmap (+1)) [(Boxed 1), Undefined, (Boxed 2)]` `    ``    [Boxed 2, Undefined, Boxed 3]` `    `` ` `    ``-}` `    `` `

Smaple answers Note how short the answers to the questions are!

code/Week10/trees-question-ans.hs

 `    ``import GHC.Exts` `    ``{-` `    ``    A ManyTree over type a, is a tree that consists of leaves with values` `    ``    of type a, and internal vertices which consist of lists of 0 or more` `    ``    ManyTree subtrees.` `    `` ` `    ``    Note: by having Internal nodes that have a list of subtrees, we can` `    ``    exploit map on that list to recurse down the tree.` `    ``-}` `    `` ` `    ``data ManyTree a = Leaf a | Internal [ ManyTree a ]` `    ``    deriving (Eq, Show)` `    `` ` `    ``-- deconstructors, sometimes easier than using a pattern match` `    ``getLeaf (Leaf x) = x` `    ``getSubtrees (Internal subtrees) = subtrees` `    `` ` `    ``-- example trees` `    ``t1 :: ManyTree Int` `    ``t1 = Internal [ Leaf 1, Leaf 2, Leaf 3]` `    `` ` `    ``l2 :: [Int]` `    ``l2 = (map getLeaf (getSubtrees t1))` `    ``t2 = Internal (map (\x -> Leaf (x *10))  l2)` `    `` ` `    ``-- since trees are functional, you can have the same sub tree appearing` `    ``-- in multiple places` `    ``t3 = Internal [t1, t2]` `    ``t4 = Internal [t1, t2, Leaf 42, Internal [t1, t2]]` `    ``t5 = Internal [Leaf 42, Internal [Leaf 1, Leaf 2, Internal [] ] ]` `    ``t6 = Internal [Internal [Internal [], Internal [] ], Internal [] ] ` `    `` ` `    ``-- do a depth first left to right traversal of tree t` `    ``dfslr :: ManyTree a -> [a]` `    ``dfslr (Leaf x) = [x]` `    ``dfslr (Internal subtrees) = foldl (++) [] (map dfslr subtrees)` `    `` ` `    ``{- Examples:` `    ``    *Main> dfslr t1` `    ``    [1,2,3]` `    ``    *Main> dfslr t2` `    ``    [10,20,30]` `    ``    *Main> dfslr t3` `    ``    [1,2,3,10,20,30]` `    ``-}` `    `` ` `    ``-- transforms on trees` `    `` ` `    ``-- apply a transform f to each leaf returning a tree of a possibly a` `    ``-- different type` `    ``mapLeaf :: (a->b) -> (ManyTree a) -> (ManyTree b)` `    ``mapLeaf f (Leaf x) = Leaf (f x)` `    ``mapLeaf f (Internal subtrees) = Internal ( map (mapLeaf f) subtrees )` `    `` ` `    ``{- Examples:` `    ``    *Main> mapLeaf (\x -> x * 10 ) t2` `    ``    Internal [Leaf 100,Leaf 200,Leaf 300]` `    `` ` `    ``    *Main> mapLeaf (* 10 ) t2` `    ``    Internal [Leaf 100,Leaf 200,Leaf 300]` `    `` ` `    ``    *Main> mapLeaf (\x -> (show x)++"x" ) t2` `    ``    Internal [Leaf "10x",Leaf "20x",Leaf "30x"]` `    ``    *Main> mapLeaf (\x -> (show x)++"x" ) t4` `    ``    Internal [Internal [Leaf "1x",Leaf "2x",Leaf "3x"],` `    ``        Internal [Leaf "10x",Leaf "20x",Leaf "30x"],` `    ``        Leaf "42x",Internal [Internal [Leaf "1x",Leaf "2x",Leaf "3x"],` `    ``        Internal [Leaf "10x",Leaf "20x",Leaf "30x"]]]` `    ``-}` `    `` ` `    ``-- apply a transform to each internal vertex, preserve the tree type` `    ``mapInternal :: ([ManyTree a] -> [ManyTree a]) -> ManyTree a -> ManyTree a` `    ``mapInternal f (Leaf x) = Leaf x` `    ``mapInternal f (Internal subtrees) = ` `    ``    Internal (f (map (mapInternal f) subtrees))` `    `` ` `    ``{- Examples:` `    `` ` `    ``    *Main> mapInternal (\st -> drop 1 st) t3` `    ``    Internal [Internal [Leaf 20,Leaf 30]]` `    `` ` `    ``    *Main> mapInternal (drop 1) t3` `    ``    Internal [Internal [Leaf 20,Leaf 30]]` `    `` ` `    ``    *Main> mapInternal (drop 1) t4` `    ``    Internal [Internal [Leaf 20,Leaf 30],Leaf 42,` `    ``            Internal [Internal [Leaf 20,Leaf 30]]]` `    ``-}` `    `` ` `    ``-- YOUR ANSWERS SHOULD GO BELOW THIS LINE --` `    `` ` `    ``{-` `    ``    Name:` `    ``    StudentID:` `    ``-}` `    `` ` `    `` ` `    ``{- QUESTION 2.1 write the function numLeaves where` `    ``        numLeaves tree` `    ``    returns the number of Leaf elements in the tree.` `    `` ` `    ``-}` `    `` ` `    ``numLeaves :: ManyTree a -> Int` `    ``numLeaves (Leaf _) = 1` `    ``numLeaves (Internal subtrees) = foldl (+) 0 (map numLeaves subtrees)` `    `` ` `    ``-- an even terser solution, probably not better since it constructs a list` `    ``-- numLeaves = length dfslr` `    `` ` `    ``{- QUESTION 2.2 write the function fringeSize where` `    ``        fringeSize tree` `    ``    returns a tuple (nleaves, nempty) where ` `    ``    nleaves - is the number of leaves in tree` `    ``    nempty - is the number of empty sub trees in tree, i.e. Internal [] ` `    `` ` `    ``-}` `    `` ` `    `` ` `    ``fringeSize :: ManyTree a -> (Int, Int)` `    ``fringeSize (Leaf _) = (1, 0)` `    ``fringeSize (Internal []) = (0, 1)` `    ``fringeSize (Internal subtrees) = foldl pairAdd (0,0) (map fringeSize subtrees)` `    ``    where` `    ``        -- define a pair add function instead of using this lambda in the fold` `    ``        --    (\(nl1, ne1) (nl2, ne2) -> (nl1+nl2, ne1+ne2)) ` `    ``        pairAdd (x0, y0) (x1, y1) = (x0+x1, y0+y1)` `    `` ` `    ``{- QUESTION 2.3 write the function cutEmptySubtrees where` `    ``        cutEmptySubtrees tree` `    ``    returns tree but with all subtrees consisting of only empty sub trees` `    ``    removed.` `    `` ` `    ``    Hint: use mapInternal, filter with a isNotEmpty predicate` `    `` ` `    ``-}` `    `` ` `    ``isEmpty (Internal []) = True` `    ``isEmpty _ = False` `    ``isNotEmpty tree = not \$ isEmpty tree` `    `` ` `    ``cutEmptySubtrees :: ManyTree a -> ManyTree a` `    `` ` `    ``{- the "natural" implementation ` `    ``cutEmptySubtrees (Leaf x) = Leaf x` `    ``cutEmptySubtrees (Internal subtrees) =` `    ``    Internal (filter isNotEmpty (map cutEmptySubtrees subtrees))` `    ``-}` `    `` ` `    ``-- which leads to this purer version` `    ``cutEmptySubtrees = mapInternal (filter isNotEmpty)` `    `` ` `    ``{- QUESTION 2.4 what does this expression on tree return?` `    ``    mapInternal (sortWith numLeaves) tree` `    ``-}` `    `` ` `    ``{- ANSWER - it produces a new tree which is the original tree but the` `    ``    the subtrees of each Internal node of the tree are reordered ` `    ``    by increasing numbers of leaves.` `    `` ` `    ``-}` `    `` ` `    ``{- Expanded discussion ...` `    ``    reorderByNumLeaves :: ManyTree a -> ManyTree a` `    `` ` `    ``could have one implementation:` `    ``    reorderByNumLeaves (Leaf x) = (Leaf x)` `    ``    reorderByNumLeaves (Internal subtrees) = ` `    ``        Internal ( sortWith numLeaves (map reorderByNumLeaves subtrees))` `    `` ` `    ``but when you inspect this you see that it is doing exctly what the mapInternal` `    ``combinator is designed for, i.e. apply a transformation to each Internal node ` `    ``of the tree.  Thus you get this:` `    `` ` `    ``    reorderByNumLeaves = mapInternal (sortWith numLeaves)` `    `` ` `    ``-}` `    `` ` `    ``-- TESTS - add you own additional ones` `    ``showTest expr = putStr \$ (show expr) ++ "\n"` `    ``showNL = putStr "\n"` `    `` ` `    ``runTests = do` `    ``    putStr "** Test Trees\n"` `    ``    showTest t1` `    ``    showTest t2` `    ``    showTest t3` `    ``    showTest t4` `    ``    showTest t5` `    ``    showTest (t6 :: ManyTree Int)` `    ``    showNL` `    `` ` `    ``    putStr "** Test numLeaves and fringeSize\n"` `    ``    showTest (numLeaves t4)` `    ``    showTest (fringeSize t4)` `    ``    showTest (numLeaves t5)` `    ``    showTest (fringeSize t5)` `    ``    showNL` `    `` ` `    ``    putStr "** Test cutEmptySubtrees\n"` `    ``    showTest (cutEmptySubtrees t1)` `    ``    showTest (cutEmptySubtrees t2)` `    ``    showTest (cutEmptySubtrees t3)` `    ``    showNL` `    ``    showTest (cutEmptySubtrees t4)` `    ``    showTest (cutEmptySubtrees t5)` `    ``    showTest (cutEmptySubtrees t6 :: ManyTree Int)` `    ``    showNL` `    `` ` `    ``    putStr "** Test mapInternal expression\n"` `    ``    showTest (mapInternal (sortWith numLeaves) t5)`

## 12.4 Question 1 - chained actions

The theme of the chain question was to think like a state machine, where sequences of actions (transitions) are chained together to make a computation. The extra feature of our chaining was that the computation could fail, and would stop at the first failure. Pictorially, this is what we are doing:

Because chaining with `thenWe` is a functional composition, we can create actions that consist of sequences of other actions.
code/Week10/chain-question-ans.hs

 `    ``{- ` `    ``    A way of chaining a sequence of actions such that if one fails, ` `    ``    all the the remaining ones fail.` `    `` ` `    ``    The state of a computation action is either OK s, in which case the ` `    ``    resulting next state s is passed on, or the action fails and Failure ` `    ``    is passed on.  States are over some type a, thus State a` `    `` ` `    ``    An action f is a function from state to state.  The states can be` `    ``    of different types (see below).` `    ``        f :: State a -> State b` `    `` ` `    ``    Actions with compatible input and output states can be chained together ` `    ``    using the thenWe function, normally in its infix form `thenWe`` `    ``-}` `    `` ` `    ``data State a = OK a | Failure` `    ``    deriving (Show, Eq)` `    `` ` `    ``-- examples of actions that process an integer-like state ` `    ``myAction :: (Integral a, Eq a) => State a -> State a` `    ``myAction (OK 0) = Failure` `    ``myAction (OK x) = OK (x - 1)` `    ``myAction _ = Failure` `    `` ` `    ``myAction2 :: (Integral a, Eq a) => State a -> State (a, String)` `    ``myAction2 (OK 0) = Failure` `    ``myAction2 (OK x) = case x `mod` 2 of` `    ``    0 -> OK (x, "Even")` `    ``    1 -> OK (x, "Odd")` `    ``myAction2 _ = Failure` `    `` ` `    `` ` `    ``-- we chain actions together using thenWe, which has infix form `thenWe`` `    `` ` `    ``thenWe :: State a -> (State a -> State b) -> State b` `    ``thenWe (OK x) f = f (OK x)` `    ``thenWe Failure _ = Failure` `    `` ` `    ``{- Example:` `    ``-- try testIt 3 and testIt 0 and testIt 1` `    ``-}` `    `` ` `    ``testIt i = ` `    ``    -- we need to start an action with an initial state` `    ``    OK i `thenWe` ` `    ``    myAction `thenWe` ` `    ``    myAction2` `    `` ` `    ``{-` `    ``    compose a function n >= 0 times with itself, where` `    ``        composeN n f` `    ``    is f . f . f . ... . f  with f appearing n times.` `    ``-}` `    `` ` `    ``composeN :: Int -> (a -> a) -> (a -> a)` `    ``composeN 0 f = id` `    ``composeN n f = f . (composeN (n-1) f)` `    `` ` `    `` ` `    ``actUntilFound :: (State a -> Bool) -> (State a -> State a) -> State a -> State a` `    ``actUntilFound pred f curState = case curState of` `    ``    Failure -> Failure` `    ``    _ -> case pred curState of` `    ``        True -> curState` `    ``        False -> actUntilFound pred f (f curState)` `    `` ` `    ``{- Example` `    ``    *Main> actUntilFound (\s -> (s == (OK 4) || s == (OK 0) )) myAction (OK 10)` `    ``    OK 4` `    ``    *Main> actUntilFound (\s -> (s == (OK 4) || s == (OK 0) )) myAction (OK 3)` `    ``    OK 0` `    ``-}` `    `` ` `    ``{-` `    ``    Given a predicate pred, action f , and initial state curState, perform ` `    ``    the action over and over again until the predicate is False, then return ` `    ``    the state just before the failure of the predicate, or Failure if any of ` `    ``    the actions failed.` `    `` ` `    ``    Same idea as actUntilFound, but we want a state that we can resume on, so` `    ``    the second last state is more useful.` `    ``-}` `    `` ` `    ``actUntilFail :: (State a -> Bool) -> (State a -> State a) -> State a -> State a` `    ``actUntilFail pred f curState = actUntilFail' pred f Failure curState` `    `` ` `    ``{- Example` `    ``    *Main> actUntilFail (/= (OK 4))  myAction (OK 20) ` `    ``    OK 5` `    ``    *Main> actUntilFail (/= (OK 4))  myAction (OK 20) `thenWe` myAction` `    ``    OK 4` `    `` ` `    ``    *Main> actUntilFail (/= (OK 4))  myAction (OK (2))` `    ``    OK 0` `    ``    *Main> actUntilFail (/= (OK 4))  myAction (OK (2)) `thenWe` myAction` `    ``    Failure` `    ``-}` `    `` ` `    ``-- recursor helper that has a previous state in addition to the current` `    ``-- state so that the predicate can fail on the current state.` `    `` ` `    ``actUntilFail' :: (State a -> Bool) -> (State a -> State a) -> ` `    ``    State a -> State a -> State a` `    `` ` `    ``actUntilFail' pred f prevState curState = case curState of` `    ``    Failure -> prevState` `    ``    _ -> case pred curState of` `    ``        -- move to next state and recurse` `    ``        True -> actUntilFail' pred f curState (f curState)` `    ``        -- we failed, return the previous successful state` `    ``        False -> prevState` `    `` ` `    ``-- a version that has the helper defined inside, and thus does not need` `    ``-- to propagate pred or f into the helper through paramaters` `    `` ` `    ``actUntilFail2 pred f curState = actUntilFail2' Failure curState` `    ``    where` `    ``        actUntilFail2' prevState curState = case curState of` `    ``            Failure -> prevState` `    ``            _ -> case pred curState of` `    ``                -- move to next state and recurse` `    ``                True -> actUntilFail2' curState (f curState)` `    ``                -- we failed, return the previous successful state` `    ``                False -> prevState` `    `` ` `    ``-- YOUR ANSWERS SHOULD GO BELOW THIS LINE --` `    `` ` `    ``{-` `    ``    Name:` `    ``    StudentID:` `    ``-}` `    `` ` `    ``{- QUESTION 1.1  extend the composeN function so that its value is id for n < 0` `    ``    Call this new function composeN'` `    ``-}` `    ``composeN' :: Int -> (a -> a) -> (a -> a)` `    ``composeN' n f = if n <= 0 ` `    ``    then id` `    ``    else f . (composeN' (n-1) f)` `    `` ` `    ``{- QUESTION 1.2 define the function actNTimes where` `    ``        actNTimes n f` `    ``    creates a new action consisting of performing action f` `    ``    n times in sequence.  I.e chains n actions of f.` `    `` ` `    ``    NOTE: answer in the study questions!` `    ``-}` `    `` ` `    ``actNTimes :: Int -> (State a -> State a) -> (State a -> State a)` `    ``actNTimes n f = composeN n (`thenWe` f)` `    `` ` `    ``testIt' :: Integral a => a -> State (a, String)` `    ``testIt' x = ` `    ``    (OK x) `thenWe`` `    ``    (actNTimes 7 myAction) `thenWe` ` `    ``    myAction2` `    `` ` `    ``{- QUESTION 1.3 define the function actUntilFailCount where` `    ``        actUntilFailCount pred f curState` `    ``    and given a predicate pred on states, an action f, and initial state ` `    ``    curState, does exactly the same as actUntilFail, but also counts the` `    ``    number of actions performed, and returns a tuple` `    ``        (count, prevState)` `    ``    where count is the number of actions performed, and prevState is what` `    ``    actUntilFail would return.` `    ``-}` `    `` ` `    ``actUntilFailCount :: Num n =>` `    ``     (State a -> Bool) -> (State a -> State a) -> State a -> (n, State a)` `    `` ` `    ``actUntilFailCount pred f curState = actUntilFailCount' Failure 0 curState` `    ``    where ` `    ``        actUntilFailCount' prevState count curState = case curState of` `    ``            -- failed, so stop` `    ``            Failure -> (count, prevState)` `    `` ` `    ``            -- is it safe to act?` `    ``            _ -> case pred curState of` `    ``                -- move to next state and continue` `    ``                True -> actUntilFailCount' curState (1+count) (f curState)` `    ``                -- we failed, return the previous successful state` `    ``                False -> (count, prevState)` `    `` ` `    ``{- QUESTION 1.4 implment a variant of thenWe, called thenSeq, which remembers` `    ``   all the previous states that the actions generated.  It is used like` `    ``        history `thenSeq` f` `    ``    where ` `    ``        history is a stack of previous states (a list with most recent ` `    ``        state at the beginning` `    `` ` `    ``        f is an action` `    ``    and the result depends on the history ` `    ``        if the head of the history is Failure, then no further actions are taken` `    ``        otherwise the new state is added to the head of the lists of states` `    `` ` `    ``    See the tests below.` `    ``    ` `    ``-}` `    ``-- solution 1, uses the @ operator to name the whole pattern` `    ``thenSeq :: Eq(a) => [State a] -> (State a -> State a) -> [State a]` `    ``-- no further actions, keep existing history` `    ``thenSeq h@(Failure:history) f = h` `    ``-- latest state is non-failure, so act and push onto history` `    ``thenSeq h@(s:history) f = (s `thenWe` f) : h` `    `` ` `    ``{- or` `    ``-- solution 2` `    ``thenSeq :: Eq(a) => [State a] -> (State a -> State a) -> [State a]` `    ``thenSeq (Failure:history) f = Failure : history` `    ``thenSeq (s:history) f = (s `thenWe` f) : s : history` `    `` ` `    ``or` `    ``-- solution 3` `    ``thenSeq :: Eq(a) => [State a] -> (State a -> State a) -> [State a]` `    ``thenSeq h case h of` `    ``    (Failure:history) = h` `    ``    (s:history) = (s `thenWe` f) : h` `    `` ` `    ``-}` `    `` ` `    `` ` `    ``-- testing thenSeq with the gcd algorithm, see tests below` `    ``myAction3 :: Integral a => State (a,a) -> State (a, a)` `    ``myAction3 ( OK (x, 0) ) = Failure` `    ``myAction3 ( OK (x, 1) ) = OK (x, 1)` `    ``myAction3 ( OK (x, y) ) = OK (y, x `mod` y)` `    `` ` `    ``-- the initial state will be a list of the initial state` `    ``myGcd ::Integral a => a -> a -> [ State (a, a) ]` `    ``myGcd x y = [ OK (x, y) ]` `    `` ` `    `` ` `    ``    ` `    ``-- TESTS - add you own additional ones` `    ``showTest expr = putStr \$ (show expr) ++ "\n"` `    ``showNL = putStr "\n"` `    `` ` `    ``runTests = do` `    ``    putStr "** myAction `thenWe` myAction2\n"` `    ``    putStr "** testIt 3\n"` `    ``    showTest (testIt 3)` `    ``    putStr "** testIt 0\n"` `    ``    showTest (testIt 0)` `    ``    putStr "** testIt 1\n"` `    ``    showTest (testIt 1)` `    ``    showNL` `    `` ` `    ``    putStr "** actNTimes\n"` `    ``    showTest (testIt' 10)` `    ``    showTest (testIt' 9)` `    ``    showTest (testIt' 8)` `    ``    showTest (testIt' 7)` `    ``    showTest (testIt' 0)` `    ``    showNL` `    `` ` `    ``    putStr "** actUntilFound\n"` `    ``    showTest \$ ` `    ``        actUntilFound (\s -> (s == (OK 4) || s == (OK 0) )) myAction (OK 10)` `    ``    showTest \$ ` `    ``        actUntilFound (\s -> (s == (OK 4) || s == (OK 0) )) myAction (OK 3)` `    ``    showNL` `    `` ` `    ``    putStr "** actUntilFail\n"` `    ``    showTest \$ actUntilFail (/= (OK 4))  myAction (OK 20) ` `    ``    showTest \$ actUntilFail (/= (OK 4))  myAction (OK 20) `thenWe` myAction` `    ``    showNL` `    `` ` `    ``    showTest \$ actUntilFail (/= (OK 4))  myAction (OK (2))` `    ``    showTest \$ actUntilFail (/= (OK 4))  myAction (OK (2)) `thenWe` myAction` `    ``    showNL` `    `` ` `    ``    putStr "** actUntilFailCount\n"` `    ``    showTest \$ actUntilFailCount (/= (OK 4))  myAction (OK 20) ` `    ``    showNL` `    `` ` `    ``    showTest \$ actUntilFailCount (/= (OK 4))  myAction (OK (2))` `    ``    showNL` `    `` ` `    ``    putStr "** thenSeq\n"` `    ``    showTest \$ [ (OK 10) ] `thenSeq` myAction `thenSeq` myAction` `    ``    -- 3 actions, but Failure occurs early` `    ``    showTest \$ ` `    ``        [ (OK 0) ] `thenSeq` myAction `thenSeq` myAction `thenSeq` myAction` `    ``    showTest \$ composeN 5 (`thenSeq` myAction3) (myGcd 92 17)`

## 12.5 A Little More on Chaining Actions

In the above we introduced an action chaining operator `thenWe` that let us combine a sequence of actions, with the ability to abort the sequence is we encountered failure.

If we wanted to, we could have made the actions dependent on a parameter. For example `action` could have take a parameter that says how much to subtract.

We could then make a future action depend on the result of a past action. But to do that we need to extract out information from the action and keep it around to inject into the future action. The obvious way to do this is to introduce a new variable, bind that variable to the result we want to use later, and then feed it in to the future actions. But feeding into the future, means making the future a function applied to the variable we introduced - ugly, but doable.

Using our chain example, it would look something like this:

code/Week10/chains.hs

 `    ``{- ` `    ``    A way of chaining a sequence of actions such that if one fails, ` `    ``    all the the remaining ones fail.` `    `` ` `    ``    The state of a computation action is either OK s, in which case the ` `    ``    resulting next state s is passed on, or the action fails and Failure ` `    ``    is passed on.  States are over some type a, thus State a` `    `` ` `    ``    An action f is a function from state to state.  The states can be` `    ``    of different types (see below).` `    ``        f :: State a -> State b` `    `` ` `    ``    Actions with compatible input and output states can be chained together ` `    ``    using the thenWe function, normally in its infix form `thenWe`` `    ``-}` `    `` ` `    ``data State a = OK a | Failure` `    ``    deriving (Show, Eq)` `    `` ` `    ``-- we chain actions together using thenWe, which has infix form `thenWe`` `    `` ` `    ``thenWe :: State a -> (State a -> State b) -> State b` `    ``thenWe (OK x) f = f (OK x)` `    ``thenWe Failure _ = Failure` `    `` ` `    ``-- TESTS - add you own additional ones` `    ``showTest expr = putStr \$ (show expr) ++ "\n"` `    ``showNL = putStr "\n"` `    `` ` `    ``-- now suppose our actions have parameters that affect the action` `    `` ` `    ``action :: (Num a, Eq a) => a -> State a -> State a` `    ``action _ (OK 0) = Failure` `    ``action y (OK x) = OK (x - y)` `    ``action _ _ = Failure` `    `` ` `    ``run1 =` `    ``    OK 10 `thenWe` (action 2) `thenWe` (action 4)` `    `` ` `    ``run2 i = do` `    ``    OK i` `    ``    `thenWe`` `    ``    action 4` `    ``    `thenWe`` `    ``    action 1` `    ``    `thenWe`` `    ``    action (-1)` `    ``    `thenWe`` `    ``    action 2` `    ``    `thenWe`` `    ``    action 1` `    `` ` `    `` ` `    ``-- what if we want to keep results from previous actions to inject into future` `    ``-- actions?  Then we need to pull the result, bind to a variable, then feed in later.` `    ``-- while still chaining the actions.  Let's do this in a number of stages.` `    `` ` `    `` ` `    ``run3 i = ` `    ``    -- we need to start an action with an initial state` `    ``    OK i `thenWe`` `    `` ` `    ``    -- but before we do the next action we want to save the value of i, so we need` `    ``    -- something that looks like an action, but also binds data to a variable.` `    `` ` `    ``    -- this is the identity action` `    ``    (\s_in ->` `    ``        -- grab the state but just pass it on, but it is exposed to us at this point.` `    ``        -- but not to the following actions.` `    ``        s_in )` `    `` ` `    ``    `thenWe`` `    ``    action 3` `    `` ` `    `` ` `    ``run4 i = ` `    ``    OK i `thenWe`` `    ``    -- we can move the chained actions inside, since chaining is associative` `    ``    -- and thus expose them to a previous state` `    ``    (\s_in ->` `    ``        -- grab the state and then pass it on to the future actions` `    ``        s_in ` `    ``        `thenWe`` `    ``        action 3` `    ``        )` `    `` ` `    ``getState (OK x) = x` `    ``run5 i = ` `    ``    OK i `thenWe`` `    ``    (\s_in ->` `    ``        s_in ` `    ``        `thenWe`` `    ``        -- now we can modify the actions` `    ``        action ((getState s_in)-1)` `    ``        )` `    `` ` `    ``run6 i = ` `    ``    OK i `thenWe`` `    ``    (\s_in ->` `    ``        -- grab the state and then pass it on to the future actions` `    ``        -- but instead of using getState to extract the state explicitly, we can ` `    ``        -- introduce variable v, for later binding to the state` `    ``        (\v ->` `    ``            s_in ` `    ``            `thenWe`` `    ``            action (v-1)` `    ``        ) (getState s_in)   -- the binding to v happens here` `    ``        )` `    `` ` `    ``{-` `    ``    this passing on of current state, along with selective extraction of parts` `    ``    for future use is so common that it has been systematized in Haskell in a ` `    ``    structure called a monad.` `    ``-}`

This passing on of current state, along with selective extraction of parts for future use is so common that it has been systematized in Haskell in a structure called a monad.

## 12.6 Monad Basics

 `    ``{-  ` `    `` ` `    ``Note: the lower the number the lower the operator priority, so >>, >>= is` `    ``the last to be evaluated.  You can see infix priority with` `    ``:i (>>)` `    `` ` `    ``The Monad typeclass has this interface:` `    `` ` `    ``m is the monad name, it tags all the wrapped up values` `    ``>>= is the bind operator, and it is used to pull a value out of the monad ` `    ``and bind it to a variable for use in subsequent operations.` `    `` ` `    ``infixl 1  >>, >>=` `    ``class  Monad m  where` `    ``    (>>=)            :: m a -> (a -> m b) -> m b` `    ``    (>>)             :: m a -> m b -> m b` `    ``    return           :: a -> m a` `    ``    fail             :: String -> m a` `    `` ` `    ``    m >> k           =  m >>= \_ -> k` `    `` ` `    ``The laws which govern >>= and return for` `    ``    value a` `    ``    monad m` `    ``    continuation k, h` `    ``    function f` `    ``are:` `    `` ` `    ``    return a >>= k  =   k a` `    ``    m >>= return    =   m` `    ``    xs >>= return . f   =   fmap f xs` `    ``    m >>= (\x -> k x >>= h) =   (m >>= k) >>= h` `    `` ` `    ``Instances of both 'Monad' and 'Functor' should additionally satisfy the law:` `    `` ` `    ``    fmap f xs  ==  xs >>= return . f` `    `` ` `    ``The minimal complete definition of a monad needs: '>>=' and 'return'.  That ` `    ``is, how to chain operations using >>=, and how to start a chain by injecting a ` `    ``value into the monad with return.` `    `` ` `    ``-}`

The Maybe monad: Can be used for the state transition chains we did. code/Week10/monad-2.hs

 `    ``import Data.Maybe` `    `` ` `    ``{- Maybe monad is defined as follows:` `    `` ` `    ``    data  Maybe a  =  Nothing | Just a` `    ``      deriving (Eq, Ord)` `    `` ` `    ``    instance  Functor Maybe  where` `    ``        fmap _ Nothing       = Nothing` `    ``        fmap f (Just a)      = Just (f a)` `    `` ` `    ``    instance  Monad Maybe  where` `    ``        (Just x) >>= k      = k x` `    ``        Nothing  >>= _      = Nothing` `    `` ` `    ``        (Just _) >>  k      = k` `    ``        Nothing  >>  _      = Nothing` `    `` ` `    ``        return              = Just` `    ``        fail _              = Nothing` `    ``-}` `    `` ` `    ``test1 :: Maybe Int` `    ``test1 = ` `    ``    Just 0 ` `    ``    >>=` `    ``    (\x -> Just (x + 1) >>=` `    ``        (\y -> Just (x + y + 1))` `    ``    )` `    `` ` `    ``test1' :: Maybe Int` `    ``test1' = ` `    ``    -- inject 0 into the monad` `    ``    return 0 ` `    ``    >>=` `    ``    (\x -> Just (x + 1) >>=` `    ``        (\y -> Just (x + y + 1))` `    ``    )` `    `` `

Do Notation syntactic sugar eliminates the lambda and bind to make for more readable code. code/Week10/monad-3.hs

 `    ``{-` `    ``    The do notation lets you eliminate the lambdas and bind` `    `` ` `    ``  do e1 ; e2      =        e1 >> e2` `    ``  do p <- e1; e2  =        e1 >>= \p -> e2` `    ``-}` `    `` ` `    `` ` `    ``test2 :: Maybe Int` `    ``test2 = do` `    ``    x <- Just 0` `    ``    y <- Just (x + 1)` `    ``    Just (x + y + 1)` `    `` ` `    ``-- pattern matches in the lambdas let you do weird things` `    ``-- try test3 1 and test3 2` `    ``test3 :: Int -> Maybe Int` `    ``test3 i = do` `    ``    x@1 <- return i` `    ``    ` `    ``    return (x+x)` `    ``     `

## 12.7 State Transitions via Monads

Now, let's revisit the action chains we did above.
 12. Week 10 - Mar 17 CMPUT 325 Schedule / Version 2.31 2014-04-04