Our biggest mistake: using the scary term “monad” rather than “warm fuzzy thing”.
Please complete the problems below. When you are finished, place all of your
code in a file named
a12.scm and submit it to Oncourse.
There are an abundance of lecture notes you could use for this assignment.
In order to receive credit:
do, etc.) are in your submission.
set!or any another Scheme procedures that perform side effects.
doto write any program below.
(define-syntax do (syntax-rules (<-) ((_ bind e) e) ((_ bind (v <- e) e* e** ...) (bind e (lambda (v) (do bind e* e** ...)))) ((_ bind e e* e** ...) (bind e (lambda (_) (do bind e* e** ...))))))
Recall the definition of the
maybe monad presented in lecture.
(define return-maybe (lambda (a) `(Just ,a))) (define bind-maybe (lambda (ma f) (cond [(eq? (car ma) 'Just) (f (cadr ma))] [(eq? (car ma) 'Nothing) '(Nothing)]))) (define fail (lambda () '(Nothing)))
1. The function
assv takes an association list and a value to look up. In our implementation, we will either return a value if one is found or
(Nothing) if no match is found in the list.
(test "assv-1" (assv 'c '((a . 1) (b . 2) (c . 3))) '(Just 3)) (test "assv-2" (assv 'd '((a . 1) (b . 2) (c . 3))) '(Nothing))
writer monad provides a mechanism to write data separately from the actual return value. If we use a list to represent these writes, we can use this monad to implement some rather useful functions.
(define return-writer (lambda (a) `(,a . ()))) (define bind-writer (lambda (ma f) (let ([mb (f (car ma))]) `(,(car mb) . ,(append (cdr ma) (cdr mb)))))) (define tell-writer (lambda (msg) `(_ . (,msg))))
2. The function
partition takes a list and a predicate, returning a dotted pair with the values that do not pass the predicate in the first position and the values that do in the second position. Implement this using the
writer monad. Do not use
do syntax for this problem.
(test "partition-1" (partition even? '(1 2 3 4 5 6 7 8 9 10)) '((1 3 5 7 9) . (2 4 6 8 10))) (test "partition-2" (partition odd? '(1 2 3 4 5 6 7 8 9 10)) '((2 4 6 8 10) . (1 3 5 7 9)))
3. Exponentiation by squaring is a method for quickly raising
numbers to integer powers. Here is the definition of
function that raises a base
x to a power
n using this
(define power (lambda (x n) (cond [(zero? n) 1] [(= n 1) x] [(odd? n) (* x (power x (sub1 n)))] [(even? n) (let ((nhalf (/ n 2))) (let ((y (power x nhalf))) (* y y)))])))
Using the writer monad, implement the
which also takes a base and an exponent. It should return the
answer as a natural value, along with each partial result computed along the way.
(test "powerXpartials-1" (powerXpartials 2 6) '(64 . (2 4 8))) (test "powerXpartials-2" (powerXpartials 3 5) '(243 . (3 9 81))) (test "powerXpartials-3" (powerXpartials 5 7) '(78125 . (5 25 125 15625)))
Recall from lecture that the
state monad uses a state and works with
(define return-state (lambda (a) (lambda (s) `(,a . ,s)))) (define bind-state (lambda (ma f) (lambda (s) (let ([vs^ (ma s)]) (let ([v (car vs^)] [s^ (cdr vs^)]) ((f v) s^)))))) (define get-state (lambda (s) `(,s . ,s))) (define put-state (lambda (new-s) (lambda (s) `(_ . ,new-s))))
abc game is a game in which a list is read and a score is computed. For each
a seen, the score is
score + 1. For each
b seen, the score is
score - 1. For each
c seen, the score is unchanged. Implement
abc-game, using the
state of the state monad to keep score.
(test "abc-game-1" ((abc-game '(a b c c b a)) 0) '(_ . 0)) (test "abc-game-2" ((abc-game '(a b c c b a a)) 0) '(_ . 1)) (test "abc-game-3" ((abc-game '(a a a)) 0) '(_ . 3))
One of the neat things about monadic code is that it can reveal the underlying structure in the code that uses them. This enables you to parameterize your code over the monad. You can then drop in a different monad and monadic operation, and get different behavior as a result. We'll do that here.
You'll use the following
traverse in the next three problems.
(define traverse (lambda (return bind f) (letrec ((trav (lambda (tree) (cond [(pair? tree) (do bind (a <- (trav (car tree))) (d <- (trav (cdr tree))) (return (cons a d)))] [else (f tree)])))) trav)))
5. The reciprocal of a number
n is computed by
(/ 1 n). Note that
0 has no reciprocal. Implement
reciprocal using the
maybe monad, returning any value computed and
0 is provided.
(test "reciprocal-1" (reciprocal 0) '(Nothing)) (test "reciprocal-2" (reciprocal 2) '(Just 1/2))
Using this, we can return a tree of reciprocals, and instead signal
failure if the tree contains a
(define traverse-reciprocal (traverse return-maybe bind-maybe reciprocal)) (test "traverse-reciprocal-1" (traverse-reciprocal '((1 . 2) . (3 . (4 . 5)))) '(Just ((1 . 1/2) . (1/3 . (1/4 . 1/5))))) (test "traverse-reciprocal-2" (traverse-reciprocal '((1 . 2) . (0 . (4 . 5)))) '(Nothing))
6. Halve. Implement the function
halve that, given a number, either will return in the monad half the number, or, if the number is not divisible by two, will instead leave the original number in place, and also log that number (using the writer monad).
(test "halve 1" (halve 6) '(3 . ())) (test "halve 2" (halve 5) '(5 . (5)))
Using this, we can return a tree in which the even numbers have been halved, the odds remain in place, and in which we've logged the odd numbers (which are not cleanly divisible by 2).
(define traverse-halve (traverse return-writer bind-writer halve)) (test "traverse-halve" (traverse-halve '((1 . 2) . (3 . (4 . 5)))) '(((1 . 1) . (3 . (2 . 5))) . (1 3 5)))
7. State/sum. Implement a function
state/sum which will, when given a number, return the current state as the value, and add that number to the current state.
(test "state/sum 1" ((state/sum 5) 0) '(0 . 5)) (test "state/sum 2" ((state/sum 2) 0) '(0 . 2)) (test "state/sum 3" ((state/sum 2) 3) '(3 . 5))
Using this, we can return a tree consisting of partial sums of the elements, and in which the state contains the final sum of the tree.
(define traverse-state/sum (traverse return-state bind-state state/sum)) (test "traverse-state/sum" ((traverse-state/sum '((1 . 2) . (3 . (4 . 5)))) 0) '(((0 . 1) 3 6 . 10) . 15))
Here is the
Cont monad (short for continuation):
(define return-cont (lambda (a) (lambda (k) (k a)))) (define bind-cont (lambda (ma f) (lambda (k) (let ((k^ (lambda (a) (let ((mb (f a))) (mb k))))) (ma k^)))))
Cont monad, you can use
callcc, which behaves similarly to Scheme's
(define callcc (lambda (g) (lambda (k) (let ((k-as-proc (lambda (a) (lambda (k_ignored) (k a))))) (let ((ma (g k-as-proc))) (ma k))))))
For more examples using the
Cont monad, see pp. 16-18 of A Schemer's View of Monads.
The following interpreter is the direct style interpreter from Assignment 7: Continuations and Representation Independence:
(define value-of (lambda (expr env) (pmatch expr [,n (guard (or (number? n) (boolean? n))) n] [,x (guard (symbol? x)) (apply-env env x)] [(* ,x1 ,x2) (* (value-of x1 env) (value-of x2 env))] [(sub1 ,x) (sub1 (value-of x env))] [(zero? ,x) (zero? (value-of x env))] [(if ,test ,conseq ,alt) (if (value-of test env) (value-of conseq env) (value-of alt env))] [(capture ,k-id ,body) (call/cc (lambda (k) (value-of body (extend-env k-id k env))))] [(return ,v-exp ,k-exp) ((value-of k-exp env) (value-of v-exp env))] [(lambda (,id) ,body) (closure id body env)] [(,rator ,rand) (apply-proc (value-of rator env) (value-of rand env))])))
Cont monad to create a monadic
value-of, and call it
value-of-cps. Provide your own
apply-proc in representations of
your choice. The same helpers should work for both
value-of-cps. Here are some tests your interpreter should pass:
(load "test.scm") (define fact-5 '((lambda (f) ((f f) 5)) (lambda (f) (lambda (n) (if (zero? n) 1 (* n ((f f) (sub1 n)))))))) (test "fact-5" ((value-of-cps fact-5 (empty-env)) (lambda (v) v)) 120) (define capture-fun '(* 3 (capture q (* 2 (return 4 q))))) (test "capture" ((value-of-cps capture-fun (empty-env)) (lambda (v) v)) 12)
Like baking soda, the
traverse function above has many applications. Here's one more. We're going to use the
Cont monad to achieve a kind of trampolining or multitasking.
The fringe of a tree is the list of its leaves in left-to-right order. For example, the fringe of
(("Time" . "flies") . ("like" . ("an" . "arrow")))
is the list of strings
("Time" "flies" "like" "an" "arrow")
Given two trees, the
driver function compares their fringes while ignoring any differences in capitalization. If the two fringes are the same, then
driver returns the two trees (in a list) with their leaves swapped. If the two fringes have bigger differences than mere capitalization, then
For example, here are two tests:
(test "driver-1" (driver '(("Time" . "flies") . ("like" . ("an" . "arrow"))) '("time" . ("FLIES" . (("like" . "an") . "aRrOw")))) '((("time" . "FLIES") . ("like" . ("an" . "aRrOw"))) ("Time" . ("flies" . (("like" . "an") . "arrow"))))) (test "driver-2" (driver '(("Time" . "flies") . ("like" . ("arrow" . "an"))) '("time" . ("FLIES" . (("like" . "an") . "aRrOw")))) #f)
Below is most of the definition of
driver. Your mission is to complete the definition by defining
(define exchange (lambda ($1 $2) (pmatch `(,$1 ,$2) [`((stopped ,tree1) (stopped ,tree2)) `(,tree1 ,tree2)] [`((yielding ,x1 ,k1) (yielding ,x2 ,k2)) (guard (string-ci=? x1 x2)) (exchange (k1 x2) (k2 x1))] [else #f]))) (define tree->stream (lambda (tree) (((traverse return-cont bind-cont yield-cont) tree) (lambda (tree) `(stopped ,tree))))) (define driver (lambda (tree1 tree2) (exchange (tree->stream tree1) (tree->stream tree2))))