CMPUT 325 Schedule and Outcomes - 13. Week 11

CMPUT 325 Schedule and Outcomes

13. Week 11 - Mar 24

13.1 Topics

Assignment 3 is released, due March 31.
Last class of content, March 31.
Final exam in class, April 7.
Computing Science 50th birthday April 1, 2014. Party in CSC 2nd floor from 15:00 to 19:00
NOTE: undefined is exactly that. If you try to evaluate it you will get an error. It is an example of a bottom value, which inhabits every type. So the type of undefined :: a defaults to the most general type. This enables you to define a fuction whose return value matches any type. This is why with
:t error error :: [Char] -> a

f x 0 = error "div by zero" f x y = x / y g x y = if y == 0 then error "e" else x / y
the error function can appear on the right hand side of conditional expressions.
NOTE: () is called unit and has the definition data () = (). That is, the name of the type is () and it has exactly one value, also written (). It's common as the value component of a monadic type to indicate that that the operation is used for its effect, and the value delivered is uninteresting. For example putStr :: String -> IO () delivers a string to stdout and has no interesting returned value.
Another look at monads and and their syntactic sugar.
Using the State monad to build a constraint solver.
Looking at details of Assignment 3.

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

code/Week11/StackDiff.txt

-- 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]

code/Week11/RandomGeneratorDiff.txt

-- 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

code/Week11/solver.hs

{- Constraint satisfaction solving

Modifed from

from http://www.haskell.org/haskellwiki/All_About_Monads#StateT_with_List

Background modules:

http://www.haskell.org/haskellwiki/State_Monad

http://www.cis.upenn.edu/~bcpierce/courses/advprog/resources/base/Control.Monad.State.html

http://hackage.haskell.org/package/base-4.6.0.1/docs/Control-Monad.html

https://hackage.haskell.org/package/mtl-2.0.1.0/docs/Control-Monad-State.html

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

(getAllSolutions

(do

tryAllValues "parent1"

tryAllValues "parent2"

tryAllValues "child"

getFinalVars)

problem)

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:

if a knight says something, it must be true
if a knave says something, it must be false
if a normal says something, it can be false or true

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
F	F	F	F	F	F
F	F	T	F	F	F
T	F	F	T	T	F
T	F	T	F	F	F
F	T	F	F	F	F
F	T	T	F	T	T
T	T	F	T	T	F
T	T	T	F	T	T

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

code/Week11/MonadicStack.hs

-- 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

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:)

-}

code/Week11/DesugaredMonadicStack.hs

-- 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

else

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

stackStuff

else

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]

else

put [9,2,1]

stackyStack1 = runState stackyStack [1,2,3]

stackyStack2 = runState stackyStack [10,20,30,40]

code/Week11/MonadicRandomGenerator.hs

-- 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)

code/Week11/DesugaredMonadicRandomGenerator.hs

-- 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

in

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

in

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

PerA	PerB	PerC
knight	knight	normal
knave	knight	normal
normal	knight	normal
knight	normal	normal
knave	normal	normal
normal	normal	normal

13.1 Topics

13.2 Monads Sugared and Not

13.3 Constraint Solver

13.4 Knights, Knaves, and Normals

13.5 Some Problems

13.6 Assignment 3

13.7 Stack and Random Generator Code