Section 3.1

August 25th 2008

I have skipped two sections on data-directed programming and generic operations. I have read through most of the texts, but I did not do any exercises for them, it seems boring enough that when I have more time in the future (or when I need the knowledge), I will come back and do the exercises.

I hope I will not skip anymore sections in the future.

Here are my solutions to section 3.1:

Exercise 3.1

This exercise should be quite simple as long as you understands the examples outlined before.

;; 3.1
(define (make-accumulator init)
  (lambda (x)
    (set! init (+ init x))
    init))
"3.1"
(define A (make-accumulator 5))
(A 10)
(A 10)

Exercise 3.2

This exercise is basically a modification to 3.1 with care and attention to the return value of the function.

;; 3.2
(define (make-monitored fun)
  (define calls 0)
  (lambda (x)
    (if (equal? x 'how-many-calls?)
        calls
        (begin
          (set! calls (+ calls 1))
          (fun x)))))
"3.2"
(define s (make-monitored sqrt))
(s 100)
(s 'how-many-calls?)

Exercise 3.3

Some thought (or not) should tell you that only dispatch needs modification, and that is the bottleneck in which all of the request are directed, so as to remove the need to modify every transaction function. One note, I made the wrong-pass function take in one parameter because of a need to return a function that takes in one parameter. Since error cannot be used because there could be more actions with the correct password following it, this is the minimal change action.

(define (make-account balance password)
  (define (withdraw amount)
    (if (>= balance amount)
        (begin (set! balance (- balance amount))
               balance)
        "Insufficient funds"))
  (define (deposit amount)
    (set! balance (+ balance amount))
    balance)
  (define (wrong-pass any)
    "Incorrect Password")
  (define (dispatch pass m)
    (if (eq? pass password)
        (cond ((eq? m 'withdraw) withdraw)
              ((eq? m 'deposit) deposit)
              (else (error "Unknown request -- MAKE-ACCOUNT" m)))
        wrong-pass))
  dispatch)
 
"3.3"
(define acc (make-account 100 'secret-password))
((acc 'secret-password 'withdraw) 40)
((acc 'some-other-password 'deposit) 50)

Exercise 3.4

This exercise is a simple change to 3.3, same rationale for call-the-cops function taking in one parameter.

;; 3.4
(define (make-account balance password)
  (define cop-counter 0)
  (define (withdraw amount)
    (if (>= balance amount)
        (begin (set! balance (- balance amount))
               balance)
        "Insufficient funds"))
  (define (deposit amount)
    (set! balance (+ balance amount))
    balance)
  (define (wrong-pass any)
    "Incorrect Password")
  (define (call-the-cops any)
  "calling cops")
  (define (dispatch pass m)
    (cond 
      [(eq? pass password)
       (set! cop-counter 0)
       (cond ((eq? m 'withdraw) withdraw)
             ((eq? m 'deposit) deposit)
             (else (error "Unknown request -- MAKE-ACCOUNT" m)))]
      [else 
       (set! cop-counter (+ cop-counter 1))
       (if (>= cop-counter 7)
           call-the-cops
           wrong-pass)]))
  dispatch)
"3.4"
(define acc (make-account 100 'secret-password))
((acc 'secret-password 'withdraw) 40)
((acc 'some-other-password 'deposit) 50)
((acc 'some-other-password 'deposit) 50)
((acc 'some-other-password 'deposit) 50)
((acc 'some-other-password 'deposit) 50)
((acc 'some-other-password 'deposit) 50)
((acc 'some-other-password 'deposit) 50)
((acc 'some-other-password 'deposit) 50)

Exercise 3.5

I took Eli’s advice and changed the random-in-range function so it accepts in-exact numbers. Mainly due to plt-scheme’s insistence on being precise whenever possible, such as using fractions when I want decimals.

;; 3.5
(define (random-in-range low high)
  (let ([range (- high low)])
    (+ low (* (random) range))))
 
(define (monte-carlo trials experiment)
  (define (iter trials-remaining trials-passed)
    (cond ((= trials-remaining 0)
           (/ trials-passed trials))
          ((experiment)
           (iter (- trials-remaining 1) (+ trials-passed 1)))
          (else
           (iter (- trials-remaining 1) trials-passed))))
  (iter trials 0))
 
(define (estimate-integral p x1 x2 y1 y2)
  (define (ei)
    (p (random-in-range x1 x2) (random-in-range y1 y2)))
  (let* ([trials 1000000]
         [success (monte-carlo trials ei)])
    (* (- x2 x1) (- y2 y1) success)))
 
(define (unit-circle x y)
  (<= (+ (* x x) (* y y)) 1))
 
"3.5"
(estimate-integral unit-circle -1.0 1.0 -1.0 1.0)

Exercise 3.6

This question is simple if you look through the scheme documentation and find random-seed. random-seed basically seeds the random generator with the value specified.

;; 3.6
(define (rand symb)
  (cond
    [(eq? symb 'generate) (random)]
    [(eq? symb 'reset) random-seed]))
"3.6"
(rand 'generate)
((rand 'reset) 0)
(rand 'generate)
(rand 'generate)
((rand 'reset) 0)
(rand 'generate)
(rand 'generate)

Exercise 3.7

For this exercise, it could be simple if it does not have the requirement that make-joint should fail when the second argument is not the correct password. If it does not have that requirement, then there is no need to modify the make-account function at all. Since it has that, I added a way to check the account password into the make-account from 3.3.

;; 3.7
(define (make-account balance password)
  (define (withdraw amount)
    (if (>= balance amount)
        (begin (set! balance (- balance amount))
               balance)
        "Insufficient funds"))
  (define (deposit amount)
    (set! balance (+ balance amount))
    balance)
  (define (wrong-pass any)
    "Incorrect Password")
  (define (check-pass pass)
    (eq? pass password))
  (define (dispatch pass m)
    (if (eq? m 'check-pass)
        check-pass
        (if (eq? pass password)
            (cond ((eq? m 'withdraw) withdraw)
                  ((eq? m 'deposit) deposit)
                  (else (error "Unknown request -- MAKE-ACCOUNT" m)))
            wrong-pass)))
    dispatch)
 
(define (make-joint acc orig-pass new-pass)
  (define (wrong-pass any)
    "Incorrect Password")
  (if ((acc orig-pass 'check-pass) orig-pass)
      (lambda (pass m)
        (if (eq? pass new-pass)
            (acc orig-pass m)
            wrong-pass))
      wrong-pass))
 
"3.7"
(define peter-acc (make-account 100 'open-sesame))
((peter-acc 'open-sesame 'withdraw) 40)
(define paul-acc
  (make-joint peter-acc 'open-seasame 'rosebud))
((paul-acc 'rosebud 'withdraw) 40)

Exercise 3.8

This question took me a while to get simple enough. Basically, the question asks you to flip a switch on the first pass and return 0 on the second pass, thus yield the result. For example, if evaulated from right to left, question asks (+ (f 0) (f 1)) to return 1. From my understanding, it is asking for a function f that when it pass over (f 1), it sets a state variable to 1, and then when it pass over (f 0), it returns 0. Same logic goes for the other way. Another note is how to test the program, we can force the excution one way or another by seperating out the function calls. If we want to evalulate (f 1) first, we just put it before (f 0).

;; 3.8
(define f
  (let ([state -1])
    (lambda (x)
      (cond
        [(= state -1) (set! state x) x]
        [else 0]))))
"3.8"
(f 1)
(f 0)

Posted by admin under Uncategorized | No Comments »

SICP 2.3

August 21st 2008

This will be the first section that I will post as I work through it. My hope from this point on is to complete one section per two day, see how that works out.

Skipped: 2.65, 2.71, 2.72

Without further ado, here is the first question:

Exercise 2.53:

For this exercise, just need to plug the expressions into a scheme interpreter and see what is the result.

Exercise 2.54:

This exercise is simple in that the book gave the algorithm to the reader already and all that is left to do is to implement the algorithm.

;; 2.54
(define (my-equal? obj1 obj2)
  (cond
    [(and (not (pair? obj1)) (not (pair? obj2)))
     (eq? obj1 obj2)]
    [(and (pair? obj1) (pair? obj2))
     (and (my-equal? (car obj1) (car obj2))
          (my-equal? (cdr obj1) (cdr obj2)))]
    [else #f]))
"2.54 - my-equal?"
(my-equal? '(this is a list) '(this is a list))
(my-equal? '(this is a list) '(this (is a) list))

Exercise 2.54:

This one is slightly more tricky, due to the fact that I do not think that the book explained how quoting worked exactly in the implementation. It only shows the ‘(elements…) syntax, but in fact it is just syntactical sugar for a more basic syntax (quote elements…). After realizing that, it is a simple matter of expanding the given expression: (car ”abracadabra) -> (car (quote ‘abracadabra)) -> (car (quote (quote abracadabra))) -> (car ‘(quote abracadabra)) -> ‘quote

Symbolic Differentiation

Now we get into a meaty project in the book. By the end of the next 3 exercises, you will have implemented a reasonable symbolic differentiator.

The following is the code given in the book right before the first exercise, for each exercise, I will use these pre-existing code as a base and redefining functions as needed.

;; Symbolic Differentiation
(define (variable? x) (symbol? x))
 
(define (same-variable? v1 v2)
  (and (variable? v1) (variable? v2) (eq? v1 v2)))
 
(define (sum? x)
  (and (pair? x) (eq? (car x) '+)))
 
(define (addend s) (cadr s))
 
(define (augend s) (caddr s))
 
(define (product? x)
  (and (pair? x) (eq? (car x) '*)))
 
(define (multiplier p) (cadr p))
 
(define (multiplicand p) (caddr p))
 
(define (=number? exp num)
  (and (number? exp) (= exp num)))
 
(define (make-sum a1 a2)
  (cond ((=number? a1 0) a2)
        ((=number? a2 0) a1)
        ((and (number? a1) (number? a2)) (+ a1 a2))
        (else (list '+ a1 a2))))
 
(define (make-product m1 m2)
  (cond ((or (=number? m1 0) (=number? m2 0)) 0)
        ((=number? m1 1) m2)
        ((=number? m2 1) m1)
        ((and (number? m1) (number? m2)) (* m1 m2))
        (else (list '* m1 m2))))
 
(define (deriv exp var)
  (cond [(number? exp) 0]
        [(variable? exp)
         (if (same-variable? exp var) 1 0)]
        [(sum? exp)
         (make-sum (deriv (addend exp) var)
                   (deriv (augend exp) var))]
        [(product? exp)
         (make-sum
          (make-product (multiplier exp)
                        (deriv (multiplicand exp) var))
          (make-product (deriv (multiplier exp) var)
                        (multiplicand exp)))]
        [else
         (error "unknown expression type -- DERIV" exp)]))
"SD - Example"
(deriv '(+ x 3) 'x)
(deriv '(* x y) 'x)
(deriv '(* (* x y) (+ x 3)) 'x)

Exercise 2.56:

This exercise tests the reader’s understanding of the code given and his ability to extend the code. It is quite simple as long as you understand how each component fits together. Also you have to understand the purpose of the helper functions and learn to compose your own as needs arise. One extra function I have defined other than those specified in the problem description is make-subtraction. Since you need to do subtraction in the result as a general function.

;; 2.56
(define (exponentiation? x)
  (and (pair? x) (eq? (car x) '**)))
 
(define (make-exponentiation b e)
  (cond
    [(=number? e 0) 1]
    [(=number? e 1) b]
    [(and (number? b) (number? e)) (expt b e)]
    [else (list '** b e)]))
 
(define (base x)
  (cadr x))
 
(define (exponent x)
  (caddr x))
 
(define (make-subtraction x y)
  (cond
    [(=number? y 0) x]
    [(and (number? x) (number? y)) (- x y)]
    [else (list '- x y)]))
 
(define (deriv exp var)
  (cond [(number? exp) 0]
        [(variable? exp)
         (if (same-variable? exp var) 1 0)]
        [(sum? exp)
         (make-sum (deriv (addend exp) var)
                   (deriv (augend exp) var))]
        [(product? exp)
         (make-sum
          (make-product (multiplier exp)
                        (deriv (multiplicand exp) var))
          (make-product (deriv (multiplier exp) var)
                        (multiplicand exp)))]
        [(exponentiation? exp)
         (make-product
          (make-product
           (exponent exp)
           (make-exponentiation (base exp)
                                (make-subtraction (exponent exp) 1)))
          (deriv (base exp) var))]
        [else
         (error "unknown expression type -- DERIV" exp)]))
"2.56"
(deriv '(** x 6) 'x)

2.57

At this point, the author is trying to show the power of abstraction, by making modification to helper functions, we can keep the core of the program (deriv function) unchanged. This point is driven further in the subsequent exercise.

;; 2.57
(define (augend x)
  (if (null? (cdddr x))
      (caddr x)
      (cons '+ (cddr x))))
 
(define (multiplicand x)
  (if (null? (cdddr x))
      (caddr x)
      (cons '* (cddr x))))
"2.57"
(deriv '(* x y (+ x 3)) 'x)

Exercise 2.58 a

This exercise is quite easy when you think about it. The simplicity arise from the restriction that the input is always fully parenthesized. We pretty much just have to change the first selector as illustrated in the following example: in the prefix syntax, we have (+ x y), to handle infix form, we switch the places of the + and the x, to (x + y), so we just need to switch the corresponding functions which are sum?, product? ….. addend, multiplier…. To be consistent (and making sure that the output from this modification will feed into the input of the same deriv function), we also change all the make-* functions to reflect the infix form.

;; 2.58
(define (addend s) (car s))
 
(define (multiplier p) (car p))
 
(define (sum? x)
  (and (pair? x) (eq? (cadr x) '+)))
 
(define (product? x)
  (and (pair? x) (eq? (cadr x) '*)))
 
(define (exponentiation? x)
  (and (pair? x) (eq? (cadr x) '**)))
 
(define (base x)
  (car x))
 
(define (make-exponentiation b e)
  (cond
    [(=number? e 0) 1]
    [(=number? e 1) b]
    [(and (number? b) (number? e)) (expt b e)]
    [else (list b '** e)]))
 
(define (make-sum a1 a2)
  (cond ((=number? a1 0) a2)
        ((=number? a2 0) a1)
        ((and (number? a1) (number? a2)) (+ a1 a2))
        (else (list a1 '+ a2))))
 
(define (make-product m1 m2)
  (cond ((or (=number? m1 0) (=number? m2 0)) 0)
        ((=number? m1 1) m2)
        ((=number? m2 1) m1)
        ((and (number? m1) (number? m2)) (* m1 m2))
        (else (list m1 '* m2))))
 
(define (make-subtraction x y)
  (cond
    [(=number? y 0) x]
    [(and (number? x) (number? y)) (- x y)]
    [else (list x '- y)]))
"2.58 a"
(deriv '(x * (y * (x + 3))) 'x)

Exercise 2.58 b

???

Representing Sets

Exercise 2.59

This exercise is a simple exercise making sure you are familiar with the inner workings of the list set representation. Note, I have taken the liberty to change false -> #f and true -> #t, to better suit my scheme environment.

;; 2.59
(define (element-of-set? x set)
  (cond ((null? set) #f)
        ((equal? x (car set)) #t)
        (else (element-of-set? x (cdr set)))))
 
(define (union-set set1 set2)
  (cond
    [(null? set1) set2]
    [(null? set2) set1]
    [(element-of-set? (car set1) set2) (union-set (cdr set1) set2)]
    [else (cons (car set1) (union-set (cdr set1) set2))]))
 
"2.59"
(union-set '(1 2 3 4 5) '(4 5 6 7 8))

Exercise 2.60

The implementation for element-of-set? and intersection-set did not change, they are just there for the purpose of completeness. However, both adjoin-set and union-set have been changed to one line and correspondingly much faster than previous. The down side is that due to duplicates, the worst case performance could be much worse than the non-duplicates version for the functions element-of-set? and intersection-set. Since the required element to find for element-of-set? could be located after a lot of duplicated entries.

;; 2.60
(define (element-of-set? x set)
  (cond ((null? set) #f)
        ((equal? x (car set)) #t)
        (else (element-of-set? x (cdr set)))))
 
(define (adjoin-set x set)
  (cons x set))
 
(define (union-set set1 set2)
  (append set1 set2))
 
(define (intersection-set set1 set2)
  (cond ((or (null? set1) (null? set2)) '())
        ((element-of-set? (car set1) set2)
         (cons (car set1)
               (intersection-set (cdr set1) set2)))
        (else (intersection-set (cdr set1) set2))))
 
"2.60"
(element-of-set? 1 '(2 3 2 1 3 2 2))
(adjoin-set 3 '(2 3 2 1 3 2 2))
(union-set '(2 3 2 1 3 2 2) '(4 3 2 1 3 2 2))
(intersection-set '(2 3 2 1 3 2 2) '(4 3 4 1 3 4 4))

Exercise 2.61

This exercise should be very simple if you understand the implementation for element-of-set?

;; 2.61
(define (adjoin-set x set)
  (cond
    [(null? set) (list x)]
    [(= x (car set)) set]
    [(&lt; x (car set)) (cons x set)]
    [else (cons (car set) (adjoin-set x (cdr set)))]))
"2.61"
(adjoin-set 5 '(1 3 6 7))

Exercise 2.62

This exercise basically implements the merge part of mergesort, with one notable difference that there is no duplicates in this version.

;; 2.62
(define (union-set set1 set2)
  (cond
    [(null? set1) set2]
    [(null? set2) set1]
    [(&lt; (car set1) (car set2)) (cons (car set1) (union-set (cdr set1) set2))]
    [(= (car set1) (car set2)) (cons (car set1) (union-set (cdr set1) (cdr set2)))]
    [else (cons (car set2) (union-set set1 (cdr set2)))]))
"2.62"
(union-set '(1 3 5 7 9) '(2 3 4 5 6 7 8 9 10))

Exercise 2.63

Tracing through a recursive function is a pain to do if you are not used to it. Especially when tracing through a function you have not wrote yourself. Fortunately, there are libraries available hopefully for your scheme implementation to make this task easier. However, for the purpose of this exercise, its best if you can come up with an explanation of how it works just by looking at it. Here is my version for the two functions, I will show the trace for one example after each explanation, and later explain how the trace came about.
tree->list-1: This one is simpler than the version 2 to trace through, simply because this is a straight recursive function, and by now, you should be very comfortable working with this kinds of function. What this function does is it converts the right branch first into a list, cons the current node onto the front and then append (O(n) time) the left branch onto the front. You may think this is just a straight translation of the code into English, but it is, there is no easy way to explain a recursive function by just thinking about it and remembering the recursive case and the base case. I can also mention the order in which it will convert the tree, it will convert from right to left, from bottom to top. So the rightmost and bottommost element will be the last element of the list, then comes the parent node, then the left child of the parent node. So on and so fourth.
Here is a trace for the second tree in Figure 2.16:

|(tree->list-1 (3 (1 () ()) (7 (5 () ()) (9 () (11 () ())))))
| (tree->list-1 (1 () ()))
| |(tree->list-1 ())
| |()
| |(tree->list-1 ())
| |()
| (1)
| (tree->list-1 (7 (5 () ()) (9 () (11 () ()))))
| |(tree->list-1 (5 () ()))
| | (tree->list-1 ())
| | ()
| | (tree->list-1 ())
| | ()
| |(5)
| |(tree->list-1 (9 () (11 () ())))
| | (tree->list-1 ())
| | ()
| | (tree->list-1 (11 () ()))
| | |(tree->list-1 ())
| | |()
| | |(tree->list-1 ())
| | |()
| | (11)
| |(9 11)
| (5 7 9 11)
|(1 3 5 7 9 11)

tree->list-2: This function is (at least for me) much harder to comprehend. It turns out, this function converts the tree in exactly the same order as the first function, but does it much faster. The reason behind most of the difficulties for me is that this function is tail recursive, and I do not have as much experience working with them than purely recursive functions, but in general replacing append with their tail-recursive equivalents will yield better performance. What it does is very similar to the first version, but it does not spawn a separate recursive call to tree->list-2, and append the result. It carries the result of all the computation it did with it as a second argument to copy-to-list. As the function moves through the tree, consing the individual elements it meets into the result and carry that forward. Therefore it will move through the whole tree only once and will not need to repeat calculation as it did for tree-list-1.
Here is a trace for copy-to-list for the same figure as above trace:

|(copy-to-list (3 (1 () ()) (7 (5 () ()) (9 () (11 () ())))) ())
| (copy-to-list (7 (5 () ()) (9 () (11 () ()))) ())
| |(copy-to-list (9 () (11 () ())) ())
| | (copy-to-list (11 () ()) ())
| | |(copy-to-list () ())
| | |()
| | (copy-to-list () (11))
| | (11)
| |(copy-to-list () (9 11))
| |(9 11)
| (copy-to-list (5 () ()) (7 9 11))
| |(copy-to-list () (7 9 11))
| |(7 9 11)
| (copy-to-list () (5 7 9 11))
| (5 7 9 11)
|(copy-to-list (1 () ()) (3 5 7 9 11))
| (copy-to-list () (3 5 7 9 11))
| (3 5 7 9 11)
|(copy-to-list () (1 3 5 7 9 11))
|(1 3 5 7 9 11)

Here is how I did the tracing in Dr Scheme 372:
One thing you need to be careful when doing trace, it appears to not recognize functions defined in another function, so to trace copy-to-list, you need to take it out and make it a separate function.

;; load the trace library
(require (lib "trace.ss"))
;; tag the functions you would like to trace
(trace tree->list-1 copy-to-list)
;; now run the functions
(define tree (make-tree 3 
           (make-tree 1 '() '())
           (make-tree 7 (make-tree 5 '() '())
                      (make-tree 9 '() (make-tree 11 '() '())))))
(tree->list-1 tree)
(copy-to-list tree '())

Exercise 2.64

The first thing you should notice about this partial-tree function is that it has a lot of “let”. The reason upon closer inspection and perhaps some experimenting will revel that you cannot use the variable previously defined in the same let. For example, the following code is not allowed:

 (let* ((left-size (quotient (- n 1) 2))
         (left-result (partial-tree elts left-size)))
...)

Since left-size has been defined in the same let, to use left-size, we have to introduce another nested let as shown in the book. By looking in the right place, we can eliminate most of the redundancy, the magical word is let*, an improved let which is defined basically with nested “let”s.
We can therefore simplify the code to as follows:

(define (partial-tree elts n)
  (if (= n 0)
      (cons '() elts)
      (let* ((left-size (quotient (- n 1) 2))
             (left-result (partial-tree elts left-size))
             (left-tree (car left-result))
             (non-left-elts (cdr left-result))
             (right-size (- n (+ left-size 1)))
             (this-entry (car non-left-elts))
             (right-result (partial-tree (cdr non-left-elts) right-size))
             (right-tree (car right-result))
             (remaining-elts (cdr right-result)))
        (cons (make-tree this-entry left-tree right-tree)
              remaining-elts))))

That’s much easier to read :)
The keyword to remember when reading through this function is the input must be an ordered list. With the benefit of an ordered list, its an easy algorithm to implement. Basically we would just take the middle element (or roughly the middle element when the number of elements in the list is even), and make that the root of the tree. Make all of the element before the root element in the list to be left tree, and all the element after the root element in the list to be right tree, then recurse on these two sublists. Finally combining the left and right subtree into a whole tree with “make-tree”. With some thought, it should become clear that this is in fact what this function does.
The running time should be O(n) due to it running through the list of elements only once.

Exercise 2.65

Exercise 2.66

For 2.66, a slight modification on element-of-set? would suffice, and adding a new structure to hold two element is in order.

;; 2.66
(define (make-record key val)
  (cons key val))
(define (key record)
  (car record))
(define (val record)
  (cdr record))
 
(define (lookup given-key set)
  (cond ((null? set) #f)
        ((= given-key (key (entry set))) (entry set))
        ((< given-key (key (entry set)))
         (lookup given-key (left-branch set)))
        ((> given-key (key (entry set)))
         (lookup given-key (right-branch set)))))

Huffman Encoding Trees

Exercise 2.67

Just follow the algorithm outlined before, we then have: ‘(A D A B B C A)

Exercise 2.68

encode-symbol is quite simple to write, just follow the rough outline at the introduction to Huffman Encoding Trees. The first part of my code is to copy and paste all of the tree manipulation code from the book into the header.

;; 2.68
(define (make-code-tree left right)
  (list left
        right
        (append (symbols left