CMPUT 325 Schedule and Outcomes
13. Week 11 - Mar 24

13.1 Topics

13.2 Monads Sugared and Not

Syntactic sugar is good for you. Compare these examples of the sugared and sugra-free forms of stack and random number generator taken from Learn You a Haskell for Great Good!

Here are side-by-side comparisions of the two styles


    -- MonadicStack.hs (Learn You a Haskell for Great Good!)      | -- DesugaredMonadicStack.hs (Learn You a Haskell for Great Go
    import Control.Monad.State                                      import Control.Monad.State  
    type Stack = [Int]                                              type Stack = [Int]
    pop :: State Stack Int                                        | pop :: State Stack Int  
    -- The following line was wrong in the book:                  | pop = 
    -- pop = State $ \(x:xs) -> (x,xs)                            |  get >>=
    pop = do                                                      |  \(x:xs) -> put xs >>
     x:xs <- get                                                  <
     put xs                                                       <
     return x                                                        return x
    push :: Int -> State Stack ()                                 | push :: Int -> State Stack ()
    -- The following line was wrong in the book:                  | push a =
    -- push a = State $ \xs -> ((),a:xs)                          |  get >>=
    push a = do                                                   |  \xs -> put (a:xs) >>
     xs <- get                                                    <
     put (a:xs)                                                   <
     return ()                                                       return ()
    pop1 = runState pop [1..5]                                      pop1 = runState pop [1..5]
    push1 = runState (push 1) [2..5]                                push1 = runState (push 1) [2..5]
    stackManip :: State Stack Int                                   stackManip :: State Stack Int  
    stackManip = do                                               | stackManip =
     push 3                                                       |  push 3 >>
     a <- pop                                                     |  pop >>=
     pop                                                          |  \a -> pop
    stackManip1 = runState stackManip [5,8,2,1]                     stackManip1 = runState stackManip [5,8,2,1]  
    stackManip2 = runState stackManip [1,2,3,4]                     stackManip2 = runState stackManip [1,2,3,4]  
    stackStuff :: State Stack ()                                    stackStuff :: State Stack ()  
    stackStuff = do                                               | stackStuff =
     a <- pop                                                     |  pop >>=
     if a == 5                                                    |  \a -> 
      then push 5                                                 |   if a == 5 then
      else do                                                     |    push 5
       push 3                                                     |   else
       push 8                                                     |    push 3 >>
                                                                  >    push 8
    stackStuff1 = runState stackStuff [9,0,2,1,0]                   stackStuff1 = runState stackStuff [9,0,2,1,0]  
    stackStuff2 = runState stackStuff [5,4,3,2,1]                   stackStuff2 = runState stackStuff [5,4,3,2,1]
    moreStack :: State Stack ()                                     moreStack :: State Stack ()  
    moreStack = do                                                | moreStack =
     a <- stackManip                                              |  stackManip >>=
     if a == 100                                                  |  \a ->
      then stackStuff                                             |   if a == 100 then
      else return ()                                              |    stackStuff
                                                                  >   else
                                                                  >    return ()
    moreStack1 = runState moreStack [100,9,0,2,1,0]                 moreStack1 = runState moreStack [100,9,0,2,1,0]
    moreStack2 = runState moreStack [9,0,2,1,0]                     moreStack2 = runState moreStack [9,0,2,1,0]
                                                                  > moreStack3 = runState moreStack [100,5,4,3,2,1]
    stackyStack :: State Stack ()                                   stackyStack :: State Stack ()  
    stackyStack = do                                              | stackyStack =
     stackNow <- get                                              |  get >>=
     if stackNow == [1,2,3]                                       |  \stackNow ->
      then put [8,3,1]                                            |   if stackNow == [1,2,3] then
      else put [9,2,1]                                            |    put [8,3,1]
                                                                  >   else
                                                                  >    put [9,2,1]
    stackyStack1 = runState stackyStack [1,2,3]                     stackyStack1 = runState stackyStack [1,2,3]
    stackyStack2 = runState stackyStack [10,20,30,40]             | stackyStack2 = runState stackyStack [10,20,30,40] 


    -- MonadicRandomGenerator.hs (Learn You a Haskell for Great G | -- DesugaredMonadicRandomGenerator.hs (Learn You a Haskell fo
    import System.Random                                            import System.Random  
    import Control.Monad.State                                      import Control.Monad.State  
    randomSt :: (RandomGen g, Random a) => State g a                randomSt :: (RandomGen g, Random a) => State g a  
    -- The following line was wrong in the book:                  | randomSt =
    -- randomSt = State random                                    |  get >>=
    randomSt = do                                                 |  \gen -> 
     gen <- get                                                   |   let (value,nextGen) = random gen
     let (value,nextGen) = random gen                             |   in
     put nextGen                                                  |    put nextGen >>
     return value                                                 |    return value
    randomSt1 = (runState randomSt (mkStdGen 1)) :: (Int,StdGen)    randomSt1 = (runState randomSt (mkStdGen 1)) :: (Int,StdGen)
    randomSt2 = (runState randomSt (mkStdGen 2)) :: (Float,StdGen   randomSt2 = (runState randomSt (mkStdGen 2)) :: (Float,StdGen
    threeCoins :: State StdGen (Bool,Bool,Bool)                   | threeCoins :: State StdGen (Bool,Bool,Bool)
    threeCoins = do                                               | threeCoins =
     a <- randomSt                                                |  randomSt >>=
     b <- randomSt                                                |  \a -> randomSt >>=
     c <- randomSt                                                |  \b -> randomSt >>=
     return (a,b,c)                                               |  \c -> return (a,b,c)
    threeCoins1 = runState threeCoins (mkStdGen 33)                 threeCoins1 = runState threeCoins (mkStdGen 33)
    threeCoins2 = runState threeCoins (mkStdGen 2)                  threeCoins2 = runState threeCoins (mkStdGen 2)
    -- rollDie and rollNDice are not explained in the book LYAHFG   -- rollDie and rollNDice are not explained in the book LYAHFG
    -- But these functions are interesting and complementary:       -- But these functions are interesting and complementary:
    rollDie :: State StdGen Int                                     rollDie :: State StdGen Int
    rollDie = do                                                  | rollDie =
     generator <- get                                             |  get >>=
     let (value, newGenerator) = randomR (1,6) generator          |  \generator -> 
     put newGenerator                                             |   let (value, newGenerator) = randomR (1,6) generator
     return value                                                 |   in
                                                                  >    put newGenerator >>
                                                                  >    return value
    rollDie1 = runState rollDie (mkStdGen 1)                        rollDie1 = runState rollDie (mkStdGen 1)
    rollDie2 = runState rollDie (mkStdGen 2)                        rollDie2 = runState rollDie (mkStdGen 2)
    rollNDice :: Int -> State StdGen [Int]                          rollNDice :: Int -> State StdGen [Int]
    rollNDice 0 = do                                              | rollNDice 0 = return []
     return []                                                    | rollNDice n =
    rollNDice n = do                                              |  rollDie >>=
     value <- rollDie                                             |  \value -> rollNDice (n-1) >>=
     list <- rollNDice (n-1)                                      |  \list -> return (value:list)
     return (value:list)                                          <
    rollNDice1 = runState (rollNDice 10) (mkStdGen 1)               rollNDice1 = runState (rollNDice 10) (mkStdGen 1)
    rollNDice2 = runState (rollNDice 20) (mkStdGen 2)             | rollNDice2 = runState (rollNDice 20) (mkStdGen 2) 

13.3 Constraint Solver


    {- Constraint satisfaction solving
    Modifed from
    Background modules:

    Here is a interesting example of combining the StateT monad with the List
    monad to produce a monad for stateful nondeterministic computations.
    We will apply this powerful monad combination to the task of solving constraint
    satisfaction problems (in this case, a logic problem). The idea behind it is to
    have a number of variables that can take on different values and a number of
    predicates involving those variables that must be satisfied. The current
    variable assignments and the predicates make up the state of the computation,
    and the non-deterministic nature of the List monad allows us to easily test all
    combinations of variable assignments.
    We start by laying the groundwork we will need to represent the logic problem,
    a simple predicate language:
    import Data.Maybe
    import Control.Monad
    import Control.Monad.State
        A language to express logic problems
        Var are variables, named with strings
        Value are values of variables, values are strings
        Predicates are functions with values are true or false
    type Var   = String
    type Value = String
    data Predicate = 
                 Is    Var Value            -- var has specific value
               | Equal Var Var              -- vars have same (unspecified) value
               | And   Predicate Predicate  -- both are true
               | Or    Predicate Predicate  -- at least one is true
               | Not   Predicate            -- it is not true
      deriving (Eq, Show)
    type Variables = [(Var,Value)]
    -- derived predicates
    -- test for a variable NOT equaling a value
    isNot :: Var -> Value -> Predicate
    isNot var value = Not (Is var value)
    -- if a is true, then b must also be true
    implies :: Predicate -> Predicate -> Predicate
    implies a b = Not (a `And` (Not b))
    -- exclusive or
    orElse :: Predicate -> Predicate -> Predicate
    orElse a b = (a `And` (Not b)) `Or` ((Not a) `And` b)
    -- Check a predicate with the given variable bindings.
    -- An unbound variable causes a Nothing return value.
    -- otherwise you get Just True or Just False.
    check :: Predicate -> Variables -> Maybe Bool
    check (Is var value) vars = do val <- lookup var vars
                                   return (val == value)
    check (Equal v1 v2)  vars = do val1 <- lookup v1 vars
                                   val2 <- lookup v2 vars
                                   return (val1 == val2)
        lifting takes a function (a1 -> r) and turns it into a function
        on monads (m a1 -> m r)
        liftM :: Monad m => (a1 -> r) -> m a1 -> m r
        liftM2 :: Monad m => (a1 -> a2 -> r) -> m a1 -> m a2 -> m rSource
    Promote a function to a monad, scanning the monadic arguments from left 
    to right. For example, 
        liftM2 (+) [0,1] [0,2] = [0,2,1,3]
        liftM2 (+) (Just 1) Nothing = Nothing
    check (And p1 p2)    vars = liftM2 (&&) (check p1 vars) (check p2 vars)
    check (Or  p1 p2)    vars = liftM2 (||) (check p1 vars) (check p2 vars)
    check (Not p)        vars = liftM (not) (check p vars)
        Machinery for representing and solving constraint satisfaction problems. 
        This is where we will define our combined monad.
        ProblemState is the type of our logic problem.  Note the use of named 
        fields where:
            vars is the environment, binding variables to values.   
            constraints are a collection of predicates that must be satisfied
                in order for an environment to be a solution. 
    data ProblemState = PS {vars::Variables, constraints::[Predicate]}
    -- this is our monad type for non-determinstic computations with state
    -- StateT is a ???
    type NDS a = StateT ProblemState [] a
    -- lookup a variable in the environment.
    getVar :: Var -> NDS (Maybe Value)
    getVar v = do vs <- gets vars
                  return $ lookup v vs
    -- set a variable in the environment.
    setVar :: Var -> Value -> NDS ()
    setVar v x = do st <- get
                    vs' <- return $ filter ((v/=).fst) (vars st)
                    put $ st {vars=(v,x):vs'}
    Check if the variable assignments satisfy all of the predicates.
    The partial argument determines the value used when a predicate returns
    Nothing because some variable it uses is not set.  Setting this to True
    allows us to accept partial solutions, then we can use a value of
    False at the end to signify that all solutions should be complete.
    isConsistent :: Bool -> NDS Bool
    isConsistent partial = do cs <- gets constraints
                              vs <- gets vars
                              let results = map (\p->check p vs) cs
                              return $ and (map (maybe partial id) results)
    -- Return only the variable bindings that are complete consistent solutions.
    getFinalVars :: NDS Variables
    getFinalVars = do c <- isConsistent False
                      guard c
                      gets vars
    Get the first solution to the problem, by evaluating the solver computation
    with an initial problem state and then returning the first solution in the
    result list, or Nothing if there was no solution.
    getSolution :: NDS a -> ProblemState -> Maybe a
    getSolution c i = listToMaybe (evalStateT c i)
    -- Get a list of all possible solutions to the problem by evaluating the solver
    -- computation with an initial problem state.
    getAllSolutions :: NDS a -> ProblemState -> [a]
    getAllSolutions c i = evalStateT c i
    We are ready to apply the predicate language and stateful nondeterministic
    monad to solving a logic problem. For this example, we will use the well-known
    Kalotan puzzle which appeared in ''Mathematical Brain-Teasers'', Dover
    Publications (1976), by J. A. H. Hunter.  It has been modified to talk about
    knights and knaves.
    The Kalotans are a tribe with a peculiar quirk: their knights always tell the
    truth. Their knaves never make two consecutive true statements, or two
    consecutive untrue statements. 
    An anthropologist (let's call him Worf) has begun to study them. Worf does not
    yet know the Kalotan language. One day, he meets a Kalotan (heterogeneous)
    couple and their child Kibi. 
    Worf asks Kibi: ``Are you a knight?'' The kid answers in Kalotan, which of
    course Worf doesn't understand. 
    Worf turns to the parents (who know English) for explanation. 
    Parent 1 says: "Kibi said: `I am a knight.'"
    Parent 2 adds: "Kibi is a knave. Kibi lied"
    Solve for the type of Kibi and the type of each parent. 
    We will need some additional predicates specific to this puzzle, and to define
    the universe of allowed variables values:
    -- if a knight says something, it must be true
    said :: Var -> Predicate -> Predicate
    said v p = (v `Is` "knight") `implies` p
    -- if a knight says two things, they must be true
    -- if a knave says two things, one must be true and one must be false
    saidBoth :: Var -> Predicate -> Predicate -> Predicate
    saidBoth v p1 p2 = And ((v `Is` "knight") `implies` (p1 `And` p2))
                           ((v `Is` "knave") `implies` (p1 `orElse` p2))
    -- lying is saying something is true when it isn't or saying something isn't
    -- true when it is
    lied :: Var -> Predicate -> Predicate
    lied v p = ((v `said` p) `And` (Not p)) `orElse` ((v `said` (Not p)) `And` p)
    -- Test consistency over all allowed settings of the variable.
    tryAllValues :: Var -> NDS ()
    tryAllValues var = do (setVar var "knight") `mplus` (setVar var "knave")
                          c <- isConsistent True
                          guard c
    All that remains to be done is to define the puzzle in the predicate language
    and get a solution that satisfies all of the predicates:
    -- Define the problem, try all of the variable assignments and print a solution.
    version1 = [ 
        "parent1" `said` ("child" `Is` "knight"),
        "parent1" `Is` "knight" 
    version2 = [ 
        Not (Equal "parent1" "parent2"),
        "parent1" `said` ("child" `said` ("child" `Is` "knave")),
        saidBoth "parent2" ("child" `Is` "knave")
        ("child" `lied` ("child" `Is` "knave")) 
        solve takes a set of constraints and returns a list of all the variable
        assignments that satisfy the constraints.
    Each call to tryAllValues will fork the solution space, assigning the named
    variable to be "knight" in one fork and "knave" in the other. The forks which
    produce inconsistent variable assignments are eliminated (using the guard
    function). The call to getFinalVars applies guard again to eliminate
    inconsistent variable assignments and returns the remaining assignments as the
    value of the computation.  
    if only asking for a few solutions, lazyness should stop further search
    solve :: [Predicate] -> [Variables]
    solve constraints = do 
                let variables   = []
                    problem     = PS variables constraints
                           tryAllValues "parent1"
                           tryAllValues "parent2"
                           tryAllValues "child"
    main :: IO ()
    main = print $ solve version1

13.4 Knights, Knaves, and Normals

In the sample solver, there are only two types of people, so if you are not a knight, then you must be a knave. This makes the logic simple. When you add a third type, you need to adjust the defintion of what it means to say something: So we need to take all three cases into account. Note the use of implies here. It is used exactly the same way that guards are in case anaylsys.
said :: Var -> Predicate -> Predicate
said v p = ((v `Is` "knight") `implies` p) `And`
           ((v `Is` "knave") `implies` (Not p)) `And`
           ((v `Is` "normal") `implies` (p `Or` (Not p)))

Lying The definition of lying in the solver below is that lying is saying something is true when it isn't or saying something isn't true when it is.
lied :: Var -> Predicate -> Predicate
lied v p = ((v `said` p) `And` (Not p)) `orElse` ((v `said` (Not p)) `And` p)
Note: Normals can both lie and tell the truth at the same time. So this has to be taken into account.

v S p v S !p p (v S p) & !p orElse (v S !p) & p

This seems a bit complicated, so can it be simplified? If we agree that every predicate must either be true or false, it cannot be meaningless, then when a person says something they are either saying it or its negation. So then lying can be cast in this way:
lied :: Var -> Predicate -> Predicate
lied v p = ((v `said` p) `implies` (Not p))
Except there is one problem, if v doesn't say p, then the antecedent of the lied predicate is true, and the lied predicate is true (lying by omission?) So we need to verify that it was actually said,
lied :: Var -> Predicate -> Predicate
lied v p = ((v `said` p) `implies` (Not p)) `And` (v `said` p)
Which, remembering from CMPUT 272 that
(a implies b) = (not a) or b
this simplifies to
lied :: Var -> Predicate -> Predicate
lied v p = (v `said` p) `And` (Not p)

Telling Truth When logically modelling the world, it is helpful to model things in a number of different ways, and see if they are consistent. That helps us gain confidence that our modelling is correct.

What does it mean "to tell the truth"? It's conditional on saying something, and if you say it, it must be true. If you didn't say it, then you are still telling the truth. So the following seems like a reasonable definition:
toldTruth :: Var -> Predicate -> Predicate
toldTruth v p = (v `said` p) `implies` p
Note: Here is a case where the definition of implies gives us the right answer in the case that v does not say anything.

As a final check, is lying the opposite of telling the truth? Yes because these are all equivalent:
Not (v `toldTruth` p) ==
Not ( (v `said` p) `implies` p ) ==
Not ( (Not (v `said` p)) `Or` p ) ==
(v `said` p) `And` (Not p) ==
v `lied` p

13.5 Some Problems

So, let's replace the definition of said and lied, and add the definition of toldTruth to the solver. We also remove the defintion of saidBoth since that is a different model of knave behaviour. Finally, you need to make sure that tryAllValues also handles normals.
A says "I am a Knight"
B says "I am not a Normal"
C says "I am a Knave"

A says "I am a Knight"
B says "I am a Knave"
C says "B is not a Knight"

A says "I am a Knight"
B says "I am a Knave"
C says "B is a Knight"

A says "I am a Knight"
B says "A is a Knight"
C says "If you asked me, I would say that A is the Normal"

A says "I am a Knight"
B says "C is a Knight"
C says "If you asked me, I would say that A is the Normal"

A says: "B is a knight"
B says: "A is not a knight"
Prove that at least one of them is telling the truth, but is not a knight.

You encounter two people, and ask one of them "Is either of you a knight?" From their response you knew the answer to your question. Is the person you asked your question of a knight or a knave, and what type is the other person?

13.6 Assignment 3

These questions concern the constraint solving framework described below.

Question 1 [10 marks]: Write a function called solutionPrint that pretty prints the solutions generated by solve. Something like this is considered pretty:
PerA PerB PerC
knight knight normal
knave knight normal
normal knight normal
knight normal normal
knave normal normal
normal normal normal
Note: look at the module Text.Printf.

Question 2 [40 marks]: The logician Raymond Smulyan has a famous book called What is the name of this book? that contains many logical puzzles. One group in particular involves the island of knights and knaves.

In the world of Knights and Knaves there are three types of people:
Knights always tell the truth
Knaves always lie
Normals can lie or tell the truth
Here are some knights and knaves puzzles. Your task is to code up the following three puzzles using our solver framework and solve them.

You will need to modify the framework to handle normals. Note, the solver only talks about knights and knaves, so you will have to adjust the definition of said v p to cover all three possible cases of the type of person v is. For example, if a knave said a predicate P, then we know that P must be false.

Also, the definition of lied v p can be simplified. Is telling the truth the logical opposite of lying?

Suppose that you have three people, A, B, and C.

For Puzzle 1 and Puzzle 2, you know that they are unique types: one of them is a knight, one a knave, and one a normal. But you don't know which is which. However, they all know each other's identities.

Puzzle 1:
A says: I am a knight
B says: That is true.
C says: I am normal.
Puzzle 2:
A says: B is the normal.
B says: No, C is the normal.
C says: No, B is definitely the normal.
Puzzle 3:
You are on a walk and come to a fork in the road. One way leads to a cliff where you will meet a horrible end, the other to your desired destination. At the fork there are two people, of unknown, and possibly different types. Determine a minumum set of questions needed to decide on the proper fork to take. Note: you may have to assume that there are no normals, or that the number of normals is less than some fraction of the number of non-normals. In the latter case, you obviously have to increase the number of people at the fork.
Low value bonus questions for 10 marks total:

Bonus 1. Find the module where runState, evalState and execState are actually defined!

Bonus 2. Explain the use of the monads in the solver.

13.7 Stack and Random Generator Code


    -- MonadicStack.hs (Learn You a Haskell for Great Good!)
    import Control.Monad.State  
    type Stack = [Int]
    pop :: State Stack Int
    -- The following line was wrong in the book:
    -- pop = State $ \(x:xs) -> (x,xs)  
    pop = do
     x:xs <- get
     put xs
     return x
    push :: Int -> State Stack ()  
    -- The following line was wrong in the book:
    -- push a = State $ \xs -> ((),a:xs)
    push a = do
     xs <- get
     put (a:xs)
     return ()
    pop1 = runState pop [1..5]
    push1 = runState (push 1) [2..5]
    stackManip :: State Stack Int  
    stackManip = do  
     push 3  
     a <- pop  
    stackManip1 = runState stackManip [5,8,2,1]  
    stackManip2 = runState stackManip [1,2,3,4]  
    stackStuff :: State Stack ()  
    stackStuff = do  
     a <- pop  
     if a == 5  
      then push 5  
      else do  
       push 3  
       push 8  
    stackStuff1 = runState stackStuff [9,0,2,1,0]  
    stackStuff2 = runState stackStuff [5,4,3,2,1]
    moreStack :: State Stack ()  
    moreStack = do  
     a <- stackManip  
     if a == 100  
      then stackStuff  
      else return ()  
    moreStack1 = runState moreStack [100,9,0,2,1,0]
    moreStack2 = runState moreStack [9,0,2,1,0]
    stackyStack :: State Stack ()  
    stackyStack = do  
     stackNow <- get  
     if stackNow == [1,2,3]  
      then put [8,3,1]  
      else put [9,2,1]  
    stackyStack1 = runState stackyStack [1,2,3]
    stackyStack2 = runState stackyStack [10,20,30,40]
    import Control.Monad.State  
    type Stack a = [a]
    pop :: State (Stack a) a
    pop = state $ \(a:as) -> (a, as)
    push :: a -> State (Stack a) ()  
    push a = modify (a:)


    -- DesugaredMonadicStack.hs (Learn You a Haskell for Great Good!)
    import Control.Monad.State  
    type Stack = [Int]
    pop :: State Stack Int  
    pop = 
     get >>=
     \(x:xs) -> put xs >>
     return x
    push :: Int -> State Stack ()
    push a =
     get >>=
     \xs -> put (a:xs) >>
     return ()
    pop1 = runState pop [1..5]
    push1 = runState (push 1) [2..5]
    stackManip :: State Stack Int  
    stackManip =
     push 3 >>
     pop >>=
     \a -> pop
    stackManip1 = runState stackManip [5,8,2,1]  
    stackManip2 = runState stackManip [1,2,3,4]  
    stackStuff :: State Stack ()  
    stackStuff =
     pop >>=
     \a -> 
      if a == 5 then
       push 5
       push 3 >>
       push 8
    stackStuff1 = runState stackStuff [9,0,2,1,0]  
    stackStuff2 = runState stackStuff [5,4,3,2,1]
    moreStack :: State Stack ()  
    moreStack =
     stackManip >>=
     \a ->
      if a == 100 then
       return ()
    moreStack1 = runState moreStack [100,9,0,2,1,0]
    moreStack2 = runState moreStack [9,0,2,1,0]
    moreStack3 = runState moreStack [100,5,4,3,2,1]
    stackyStack :: State Stack ()  
    stackyStack =
     get >>=
     \stackNow ->
      if stackNow == [1,2,3] then
       put [8,3,1]
       put [9,2,1]
    stackyStack1 = runState stackyStack [1,2,3]
    stackyStack2 = runState stackyStack [10,20,30,40] 


    -- MonadicRandomGenerator.hs (Learn You a Haskell for Great Good!)
    import System.Random  
    import Control.Monad.State  
    randomSt :: (RandomGen g, Random a) => State g a  
    -- The following line was wrong in the book:
    -- randomSt = State random
    randomSt = do
     gen <- get
     let (value,nextGen) = random gen
     put nextGen
     return value
    randomSt1 = (runState randomSt (mkStdGen 1)) :: (Int,StdGen)
    randomSt2 = (runState randomSt (mkStdGen 2)) :: (Float,StdGen)
    threeCoins :: State StdGen (Bool,Bool,Bool)  
    threeCoins = do  
     a <- randomSt  
     b <- randomSt  
     c <- randomSt  
     return (a,b,c)  
    threeCoins1 = runState threeCoins (mkStdGen 33)
    threeCoins2 = runState threeCoins (mkStdGen 2)
    -- rollDie and rollNDice are not explained in the book LYAHFGG. 
    -- But these functions are interesting and complementary:
    rollDie :: State StdGen Int
    rollDie = do 
     generator <- get
     let (value, newGenerator) = randomR (1,6) generator
     put newGenerator
     return value
    rollDie1 = runState rollDie (mkStdGen 1)
    rollDie2 = runState rollDie (mkStdGen 2)
    rollNDice :: Int -> State StdGen [Int]
    rollNDice 0 = do
     return []
    rollNDice n = do
     value <- rollDie
     list <- rollNDice (n-1)
     return (value:list)
    rollNDice1 = runState (rollNDice 10) (mkStdGen 1)
    rollNDice2 = runState (rollNDice 20) (mkStdGen 2)


    -- DesugaredMonadicRandomGenerator.hs (Learn You a Haskell for Great Good!)
    import System.Random  
    import Control.Monad.State  
    randomSt :: (RandomGen g, Random a) => State g a  
    randomSt =
     get >>=
     \gen -> 
      let (value,nextGen) = random gen
       put nextGen >>
       return value
    randomSt1 = (runState randomSt (mkStdGen 1)) :: (Int,StdGen)
    randomSt2 = (runState randomSt (mkStdGen 2)) :: (Float,StdGen)
    threeCoins :: State StdGen (Bool,Bool,Bool)
    threeCoins =
     randomSt >>=
     \a -> randomSt >>=
     \b -> randomSt >>=
     \c -> return (a,b,c)
    threeCoins1 = runState threeCoins (mkStdGen 33)
    threeCoins2 = runState threeCoins (mkStdGen 2)
    -- rollDie and rollNDice are not explained in the book LYAHFGG. 
    -- But these functions are interesting and complementary:
    rollDie :: State StdGen Int
    rollDie =
     get >>=
     \generator -> 
      let (value, newGenerator) = randomR (1,6) generator
       put newGenerator >>
       return value
    rollDie1 = runState rollDie (mkStdGen 1)
    rollDie2 = runState rollDie (mkStdGen 2)
    rollNDice :: Int -> State StdGen [Int]
    rollNDice 0 = return []
    rollNDice n =
     rollDie >>=
     \value -> rollNDice (n-1) >>=
     \list -> return (value:list)
    rollNDice1 = runState (rollNDice 10) (mkStdGen 1)
    rollNDice2 = runState (rollNDice 20) (mkStdGen 2) 

13. Week 11 - Mar 24
CMPUT 325 Schedule / Version 2.31 2014-04-04