Chris Pollett>Old Classes>PIC 15, Fall 1999>Hw1>HW1 Solution
;2.53
;What would the the interpreter print in response to evaluating each of
;the following expressions?
;(list 'a 'b 'c)
;Response: (a b c)
;(list (list 'george))
;Response: ((george))
;(cdr '((x1 x2) (y1 y2)))
;Response: ((y1 y2))
;(cadr '((x1 x2) (y1 y2))
;Response (y1 y2)
;(pair? (car '(a short list)))
;Response: () ;i.e.,False
;(memq 'red '((red shoes) (blue socks)))
;Response: ()
;(memq 'red '(red shoes blue socks))
;Response: (red shoes blue socks)
;2.63
;Here is the code from the book:
(define (entry tree) (car tree))
(define (left-branch tree) (cadr tree))
(define (right-branch tree) (caddr tree))
(define (make-tree entry left right)
(list entry left right)
)
(define (tree->list-1 tree)
(if (null? tree)
'()
(append (tree->list-1 (left-branch tree))
(cons (entry tree)
(tree->list-1 (right-branch tree))
)
)
)
)
(define (tree->list-2 tree)
(define (copy-to-list tree result-list)
(if (null? tree)
result-list
(copy-to-list (left-branch tree)
(cons (entry tree)
(copy-to-list (right-branch tree) result-list)
)
)
)
)
(copy-to-list tree '())
)
'fig2.16tree1
;First tree from figure 2.16 in the book
(define lltree1 (make-tree 1 '() '()))
(define lrtree1 (make-tree 5 '() '()))
(define ltree1 (make-tree 3 lltree1 lrtree1))
(define rrtree1 (make-tree 11 '() '()))
(define rtree1 (make-tree 9 '() rrtree1))
(define tree1 (make-tree 7 ltree1 rtree1))
(display tree1)
(newline)
(display "1st listing procedure: ")
(display (tree->list-1 tree1))
(newline)
(display "2nd listing procedure: ")
(display (tree->list-2 tree1))
(newline)
'fig2.16tree2
;Second tree from figure 2.16
(define rrrtree2 (make-tree 11 '() '()))
(define rrtree2 (make-tree 9 '() rrrtree2))
(define rltree2 (make-tree 5 '() '()))
(define rtree2 (make-tree 7 rltree2 rrtree2))
(define ltree2 (make-tree 1 '() '()))
(define tree2 (make-tree 3 ltree2 rtree2))
(display tree2)
(newline)
(display "1st listing procedure: ")
(display (tree->list-1 tree2))
(newline)
(display "2nd listing procedure: ")
(display (tree->list-2 tree2))
(newline)
'fig2.16tree3
;Third tree from figure 2.16
(define rrtree3 (make-tree 11 '() '()))
(define rltree3 (make-tree 7 '() '()))
(define rtree3 (make-tree 9 rltree3 rrtree3))
(define lltree3 (make-tree 1 '() '()))
(define ltree3 (make-tree 3 lltree3 '()))
(define tree3 (make-tree 5 ltree3 rtree3))
(display tree3)
(newline)
(display "1st listing procedure: ")
(display (tree->list-1 tree3))
(newline)
(display "2nd listing procedure: ")
(display (tree->list-2 tree3))
(newline)
; 2.63a
; The two procedures produce the same results on every tree.
; They both do what is called an InOrder tranversal. For a
; binary search tree this means the numbers will be output
; by increasing value. Running the above code will list the
; results for the trees in fig2.16 out of the book. Notice
; for each of the trees get same results.
; 2.63b
; Because the first procedure uses append it keeps having to
; search to the end of the list so far and thus will have \Theta(n^2)
; growth. The second procedure avoids this problem by accumulating
; the list from right to left and hence is jus \Theta(n) time.
;
;2.73
; We are given the following code:
;
(define (variable? x) (symbol? x))
(define (same-variable? v1 v2)
(and (variable? v1) (variable? v2) (eq? v1 v2))
)
(define (deriv exp var)
(cond ((number? exp) 0)
((variable? exp) (if (same-variable? exp var) 1 0))
(else
((get 'deriv (operator exp)) (operands exp) var)
)
)
)
(define (operator exp) (car exp))
(define (operands exp) (cdr exp))
;a) Then we're asked what was done. What we've done
; is replaced most of the cases of cond in the original
; derivative code by a lookup in a table to figure out
; what function performs the derivative of the given operation.
; We cannot subsume the number and variable
; cases into the dispatch on type since these do not
; have operands.
;d) Although the meaning of what is the type and what
;is the operator
; would be reversed, to implement this change we would
; just need
; to change the three lines:
; (put 'deriv '+ sum)
; (put 'deriv '* product)
; (put 'deriv '/ quotient)
;
; in (install-deriv-package) below to:
; (put '+ 'deriv sum)
; (put '* 'deriv product)
; (put '/ 'deriv quotient)
;
; We'd also need to change the one line in the
;(deriv exp var) function
; from (get 'deriv (operator exp)) to
;(get (operator exp) 'deriv)
;b and c are answered by the following code
; the additional rule I implemented was the quotient
; rule
;Name: install-deriv-package
;=====
;Purpose:
;========
; Installs the functions in symbol table needed to
; symbolically calculate derivatives in our data-directed set-up
;
; Ex: (install-deriv-package)
;
;Known Bugs:
;===========
;none
(define (install-deriv-package)
(define (addend s) (car s))
(define (augend s) (cadr s))
(define (multiplier p) (car p))
(define (multiplicand p) (cadr p))
(define (numerator p) (car p))
(define (denominator p) (cadr 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-difference 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-quotient q1 q2)
(cond ((=number? q2 0) 'div-by-zero)
((=number? q2 1) q1)
((and (number? q1) (number? q2)) (/ q1 q2))
(else (list '/ q1 q2))
)
)
(define (sum exp var)
(make-sum (deriv (addend exp) var)
(deriv (augend exp) var)))
(define (product exp var)
(make-sum
(make-product (multiplier exp)
(deriv (multiplicand exp) var))
(make-product (deriv (multiplier exp) var)
(multiplicand exp))))
(define (quotient exp var)
(make-quotient
(make-difference
(make-product (denominator exp)
(deriv (numerator exp) var))
(make-product (deriv (denominator exp) var)
(numerator exp))
)
(make-product (denominator exp)
(denominator exp))
)
)
(put 'deriv '+ sum)
(put 'deriv '* product)
(put 'deriv '/ quotient)
'done
)
;
; Code for tables from chapter 3
;
(define nil '())
(define false #f)
(define (assoc key records)
(cond ((null? records) false)
((equal? key (caar records)) (car records))
(else (assoc key (cdr records)))))
(define (make-table)
(let ((local-table (list '*table*)))
(define (lookup key-1 key-2)
(let ((subtable (assoc key-1 (cdr local-table))))
(if subtable
(let ((record (assoc key-2 (cdr subtable))))
(if record
(cdr record)
false))
false)))
(define (insert! key-1 key-2 value)
(let ((subtable (assoc key-1 (cdr local-table))))
(if subtable
(let ((record (assoc key-2 (cdr subtable))))
(if record
(set-cdr! record value)
(set-cdr! subtable
(cons (cons key-2 value)
(cdr subtable)))))
(set-cdr! local-table
(cons (list key-1
(cons key-2 value))
(cdr local-table)))))
'ok)
(define (dispatch m)
(cond ((eq? m 'lookup-proc) lookup)
((eq? m 'insert-proc!) insert!)
(else (error "Unknown operation -- TABLE" m))))
dispatch))
(define operation-table (make-table))
(define get (operation-table 'lookup-proc))
(define put (operation-table 'insert-proc!))
;
; code to test 2.73
;
(install-deriv-package)
(deriv '(/ x x) 'x)
;2.75
;Name: make-from-mag-ang
;=====
;Purpose:
;========
;
; Message passing style implementation of complex numbers
; here our constructor is given a magnitude and an angle in radians and
; uses this to build the complex number.
;
; Ex: (define m (make-from-mag-ang 2 3.14))
;
;Known Bugs:
;===========
;none
(define (make-from-mag-ang r theta)
(define (dispatch op)
(cond ((eq? op 'magnitude) r)
((eq? op 'angle) theta)
((eq? op 'real-part) (* r (cos theta)))
((eq? op 'imag-part) (* r (sin theta)))
(else
(error "unknown op -- make-from real-imag" op))
)
)
dispatch)
(define (apply-generic op arg) (arg op))
(define (real-part z) (apply-generic 'real-part z))
(define (imag-part z) (apply-generic 'imag-part z))
(define (magnitude z) (apply-generic 'magnitude z))
(define (angle z) (apply-generic 'angle z))
(define test-mag-ang (make-from-mag-ang 2 3.14))
;
; Here are some tests for the code:
;
(test-mag-ang 'angle)
(newline)
(display (angle test-mag-ang))
(newline)
(display (magnitude test-mag-ang))
(newline)
(display (real-part test-mag-ang))
(newline)
(display (imag-part test-mag-ang))
(newline)