1 (define (add-complex z1 z2)
2 (make-from-real-imag (+ (real-part z1) (real-part z2))
3 (+ (imag-part z1) (imag-part z2))))
4 (define (sub-complex z1 z2)
5 (make-from-real-imag (- (real-part z1) (real-part z2))
6 (- (imag-part z1) (imag-part z2))))
7 (define (mul-complex z1 z2)
8 (make-from-mag-ang (* (magnitude z1) (magnitude z2))
9 (+ (angle z1) (angle z2))))
10 (define (div-complex z1 z2)
11 (make-from-mag-ang (/ (magnitude z1) (magnitude z2))
12 (- (angle z1) (angle z2))))
14 (define (attach-tag type-tag contents)
15 (cons type-tag contents))
16 (define (type-tag datum)
19 (error "Bad tagged datum -- TYPE-TAG" datum)))
20 (define (contents datum)
23 (error "Bad tagged datum -- CONTENTS" datum)))
24 (define (rectangular? z)
25 (eq? (type-tag z) 'rectangular))
27 (eq? (type-tag z) 'polar))
29 (define (install-rectangular-package)
30 (define (real-part z) (car z))
31 (define (imag-part z) (cdr z))
32 (define (make-from-real-imag x y)
35 (sqrt (+ (square (real-part z))
36 (square (imag-part z)))))
38 (atan (imag-part z) (real-part z)))
39 (define (make-from-mag-ang r a)
40 (cons (* r (cos a)) (* r (sin a))))
41 (define (tag x) (attach-tag 'rectangular x))
42 (put 'real-part '(rectangular) real-part)
43 (put 'imag-part '(rectangular) imag-part)
44 (put 'magnitude '(rectangular) magnitude)
45 (put 'angle '(rectangular) angle)
46 (put 'make-from-real-imag 'rectangular
47 (lambda (x y) (tag (make-from-real-imag x y))))
48 (put 'make-from-mag-ang 'rectangular
49 (lambda (r a) (tag (make-from-mag-ang r a))))
52 (define (install-polar-package)
53 (define (magnitude z) (car z))
54 (define (angle z) (cdr z))
55 (define (make-from-mag-ang r a) (cons r a))
57 (* (magnitude z) (cos (angle z))))
59 (* (magnitude z) (sin (angle z))))
60 (define (make-from-real-imag x y)
61 (cons (sqrt (+ (square x) (square y)))
63 (define (tag x) (attach-tag 'polar x))
64 (put 'real-part '(polar) real-part)
65 (put 'imag-part '(polar) imag-part)
66 (put 'magnitude '(polar) magnitude)
67 (put 'angle '(polar) angle)
68 (put 'make-from-real-imag 'polar
69 (lambda (x y) (tag (make-from-real-imag x y))))
70 (put 'make-from-mag-ang 'polar
71 (lambda (r a) (tag (make-from-mag-ang r a))))
74 (define (apply-generic op . args)
75 (let* ((type-tags (map type-tag args))
76 (proc (get op type-tags)))
78 (apply proc (map contents args))
80 "No method for these types -- APPLY-GENERIC"
81 (list op type-tags)))))
83 (define (real-part z) (apply-generic 'real-part z))
84 (define (imag-part z) (apply-generic 'imag-part z))
85 (define (magnitude z) (apply-generic 'magnitude z))
86 (define (angle z) (apply-generic 'angle z))
87 (define (make-from-real-imag x y)
88 ((get 'make-from-real-imag 'rectangular) x y))
89 (define (make-from-mag-ang r a)
90 ((get 'make-from-mag-ang 'polar) r a))
92 ;; We can regard this program as performing a dispatch on the type of the expression to be differentiated. In this situation the ``type tag'' of the datum is the algebraic operator symbol (such as +) and the operation being performed is deriv. We can transform this program into data-directed style by rewriting the basic derivative procedure as
94 (define (deriv exp var)
95 (cond ((number? exp) 0)
96 ((variable? exp) (if (same-variable? exp var) 1 0))
97 (else ((get 'deriv (operator exp)) (operands exp)
99 (define (operator exp) (car exp))
100 (define (operands exp) (cdr exp))
102 ;; a. Explain what was done above. Why can't we assimilate the predicates number? and same-variable? into the data-directed dispatch?
104 ;; If exp is a number, we return 0. If it is a variable and we are taking the derivative with respect the same variable, we return 1 (otherwise we return 0). Otherwise, we go to the operation-and-type table and look up the procedure with operation name 'deriv and data type with the same operator. We then apply this procedure on the operands of the expression (passed as a list) and the variable.
106 ;; We cannot assimilate the predicates because there are no operators for simple numbers and variables. These expressions are not lists.
108 ;; b. Write the procedures for derivatives of sums and products, and the auxiliary code required to install them in the table used by the program above.
110 (define (first-operand operands)
112 (define (rest-operands operands)
114 (define (deriv-sum operands var)
115 (make-sum (deriv (first-operand operands) var)
116 (deriv (rest-operands operands) var)))
117 (define (deriv-product operands var)
119 (make-product (first-operand operands)
120 (deriv (rest-operands operands) var))
121 (make-product (deriv (first-operand operands) var)
122 (rest-operands operands))))
123 (put 'deriv '+ deriv-sum)
124 (put 'deriv '* deriv-product)
126 ;; c. Choose any additional differentiation rule that you like, such as the one for exponents (exercise 2.56), and install it in this data-directed system.
128 (define (exponentiation? exp)
129 (and (pair? exp) (eq? (car exp) '**)))
132 (define (exponent exp)
134 (define (=number? x num)
135 (and (number? x) (= x num)))
136 (define (make-exponentiation base exponent)
137 (cond ((and (=number? base 0) (=number? exponent 0)) (error "0^0 undefined"))
138 ((=number? exponent 0) 1)
139 ((=number? base 0) 0)
140 ((=number? base 1) 1)
141 ((and (number? base) (number? exponent)) (expt base exponent))
142 ((=number? exponent 1) base)
143 (else (list '** base exponent))))
145 (define (deriv-exp operands var)
146 (car operands) (cadr operands)...)
148 (put 'deriv '** deriv-exp)
149 ((and (exponentiation? exp)
150 (number? (exponent exp)))
152 (make-product (exponent exp)
153 (make-exponentiation (base exp)
154 (make-sum (exponent exp) -1)))
155 ;; or (- (exponent exp) 1)
156 (deriv (base exp) var)))
161 d. In this simple algebraic manipulator the type of an expression is the algebraic operator that binds it together. Suppose, however, we indexed the procedures in the opposite way, so that the dispatch line in deriv looked like
163 ((get (operator exp) 'deriv) (operands exp) var)
165 What corresponding changes to the derivative system are required?
