1 665c255d 2023-08-04 jrmu (define (add-complex z1 z2)
2 665c255d 2023-08-04 jrmu (make-from-real-imag (+ (real-part z1) (real-part z2))
3 665c255d 2023-08-04 jrmu (+ (imag-part z1) (imag-part z2))))
4 665c255d 2023-08-04 jrmu (define (sub-complex z1 z2)
5 665c255d 2023-08-04 jrmu (make-from-real-imag (- (real-part z1) (real-part z2))
6 665c255d 2023-08-04 jrmu (- (imag-part z1) (imag-part z2))))
7 665c255d 2023-08-04 jrmu (define (mul-complex z1 z2)
8 665c255d 2023-08-04 jrmu (make-from-mag-ang (* (magnitude z1) (magnitude z2))
9 665c255d 2023-08-04 jrmu (+ (angle z1) (angle z2))))
10 665c255d 2023-08-04 jrmu (define (div-complex z1 z2)
11 665c255d 2023-08-04 jrmu (make-from-mag-ang (/ (magnitude z1) (magnitude z2))
12 665c255d 2023-08-04 jrmu (- (angle z1) (angle z2))))
14 665c255d 2023-08-04 jrmu (define (attach-tag type-tag contents)
15 665c255d 2023-08-04 jrmu (cons type-tag contents))
16 665c255d 2023-08-04 jrmu (define (type-tag datum)
17 665c255d 2023-08-04 jrmu (if (pair? datum)
19 665c255d 2023-08-04 jrmu (error "Bad tagged datum -- TYPE-TAG" datum)))
20 665c255d 2023-08-04 jrmu (define (contents datum)
21 665c255d 2023-08-04 jrmu (if (pair? datum)
23 665c255d 2023-08-04 jrmu (error "Bad tagged datum -- CONTENTS" datum)))
24 665c255d 2023-08-04 jrmu (define (rectangular? z)
25 665c255d 2023-08-04 jrmu (eq? (type-tag z) 'rectangular))
26 665c255d 2023-08-04 jrmu (define (polar? z)
27 665c255d 2023-08-04 jrmu (eq? (type-tag z) 'polar))
29 665c255d 2023-08-04 jrmu (define (install-rectangular-package)
30 665c255d 2023-08-04 jrmu (define (real-part z) (car z))
31 665c255d 2023-08-04 jrmu (define (imag-part z) (cdr z))
32 665c255d 2023-08-04 jrmu (define (make-from-real-imag x y)
34 665c255d 2023-08-04 jrmu (define (magnitude z)
35 665c255d 2023-08-04 jrmu (sqrt (+ (square (real-part z))
36 665c255d 2023-08-04 jrmu (square (imag-part z)))))
37 665c255d 2023-08-04 jrmu (define (angle z)
38 665c255d 2023-08-04 jrmu (atan (imag-part z) (real-part z)))
39 665c255d 2023-08-04 jrmu (define (make-from-mag-ang r a)
40 665c255d 2023-08-04 jrmu (cons (* r (cos a)) (* r (sin a))))
41 665c255d 2023-08-04 jrmu (define (tag x) (attach-tag 'rectangular x))
42 665c255d 2023-08-04 jrmu (put 'real-part '(rectangular) real-part)
43 665c255d 2023-08-04 jrmu (put 'imag-part '(rectangular) imag-part)
44 665c255d 2023-08-04 jrmu (put 'magnitude '(rectangular) magnitude)
45 665c255d 2023-08-04 jrmu (put 'angle '(rectangular) angle)
46 665c255d 2023-08-04 jrmu (put 'make-from-real-imag 'rectangular
47 665c255d 2023-08-04 jrmu (lambda (x y) (tag (make-from-real-imag x y))))
48 665c255d 2023-08-04 jrmu (put 'make-from-mag-ang 'rectangular
49 665c255d 2023-08-04 jrmu (lambda (r a) (tag (make-from-mag-ang r a))))
52 665c255d 2023-08-04 jrmu (define (install-polar-package)
53 665c255d 2023-08-04 jrmu (define (magnitude z) (car z))
54 665c255d 2023-08-04 jrmu (define (angle z) (cdr z))
55 665c255d 2023-08-04 jrmu (define (make-from-mag-ang r a) (cons r a))
56 665c255d 2023-08-04 jrmu (define (real-part z)
57 665c255d 2023-08-04 jrmu (* (magnitude z) (cos (angle z))))
58 665c255d 2023-08-04 jrmu (define (imag-part z)
59 665c255d 2023-08-04 jrmu (* (magnitude z) (sin (angle z))))
60 665c255d 2023-08-04 jrmu (define (make-from-real-imag x y)
61 665c255d 2023-08-04 jrmu (cons (sqrt (+ (square x) (square y)))
62 665c255d 2023-08-04 jrmu (atan y x)))
63 665c255d 2023-08-04 jrmu (define (tag x) (attach-tag 'polar x))
64 665c255d 2023-08-04 jrmu (put 'real-part '(polar) real-part)
65 665c255d 2023-08-04 jrmu (put 'imag-part '(polar) imag-part)
66 665c255d 2023-08-04 jrmu (put 'magnitude '(polar) magnitude)
67 665c255d 2023-08-04 jrmu (put 'angle '(polar) angle)
68 665c255d 2023-08-04 jrmu (put 'make-from-real-imag 'polar
69 665c255d 2023-08-04 jrmu (lambda (x y) (tag (make-from-real-imag x y))))
70 665c255d 2023-08-04 jrmu (put 'make-from-mag-ang 'polar
71 665c255d 2023-08-04 jrmu (lambda (r a) (tag (make-from-mag-ang r a))))
74 665c255d 2023-08-04 jrmu (define (apply-generic op . args)
75 665c255d 2023-08-04 jrmu (let* ((type-tags (map type-tag args))
76 665c255d 2023-08-04 jrmu (proc (get op type-tags)))
78 665c255d 2023-08-04 jrmu (apply proc (map contents args))
80 665c255d 2023-08-04 jrmu "No method for these types -- APPLY-GENERIC"
81 665c255d 2023-08-04 jrmu (list op type-tags)))))
83 665c255d 2023-08-04 jrmu (define (real-part z) (apply-generic 'real-part z))
84 665c255d 2023-08-04 jrmu (define (imag-part z) (apply-generic 'imag-part z))
85 665c255d 2023-08-04 jrmu (define (magnitude z) (apply-generic 'magnitude z))
86 665c255d 2023-08-04 jrmu (define (angle z) (apply-generic 'angle z))
87 665c255d 2023-08-04 jrmu (define (make-from-real-imag x y)
88 665c255d 2023-08-04 jrmu ((get 'make-from-real-imag 'rectangular) x y))
89 665c255d 2023-08-04 jrmu (define (make-from-mag-ang r a)
90 665c255d 2023-08-04 jrmu ((get 'make-from-mag-ang 'polar) r a))
92 665c255d 2023-08-04 jrmu (define (deriv exp var)
93 665c255d 2023-08-04 jrmu (cond ((number? exp) 0)
94 665c255d 2023-08-04 jrmu ((variable? exp) (if (same-variable? exp var) 1 0))
96 665c255d 2023-08-04 jrmu (make-sum (deriv (addend exp) var)
97 665c255d 2023-08-04 jrmu (deriv (augend exp) var)))
98 665c255d 2023-08-04 jrmu ((product? exp)
100 665c255d 2023-08-04 jrmu (make-product (multiplier exp)
101 665c255d 2023-08-04 jrmu (deriv (multiplicand exp) var))
102 665c255d 2023-08-04 jrmu (make-product (deriv (multiplier exp) var)
103 665c255d 2023-08-04 jrmu (multiplicand exp))))
104 665c255d 2023-08-04 jrmu (else (error "unknown expression type -- DERIV" exp))))
106 665c255d 2023-08-04 jrmu ;; 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
108 665c255d 2023-08-04 jrmu (define (deriv exp var)
109 665c255d 2023-08-04 jrmu (cond ((number? exp) 0)
110 665c255d 2023-08-04 jrmu ((variable? exp) (if (same-variable? exp var) 1 0))
111 665c255d 2023-08-04 jrmu (else ((get 'deriv (operator exp)) (operands exp)
113 665c255d 2023-08-04 jrmu (define (operator exp) (car exp))
114 665c255d 2023-08-04 jrmu (define (operands exp) (cdr exp))
116 665c255d 2023-08-04 jrmu ;; a. Explain what was done above. Why can't we assimilate the predicates number? and same-variable? into the data-directed dispatch?
118 665c255d 2023-08-04 jrmu ;; 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.
120 665c255d 2023-08-04 jrmu ;; We cannot assimilate the predicates because there are no operators for simple numbers and variables. These expressions are not lists.
122 665c255d 2023-08-04 jrmu ;; 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.
124 665c255d 2023-08-04 jrmu (define (first-operand operands)
125 665c255d 2023-08-04 jrmu (car operands))
126 665c255d 2023-08-04 jrmu (define (rest-operands operands)
127 665c255d 2023-08-04 jrmu (cdr operands))
128 665c255d 2023-08-04 jrmu (define (deriv-sum operands var)
129 665c255d 2023-08-04 jrmu (make-sum (deriv (first-operand operands) var)
130 665c255d 2023-08-04 jrmu (deriv (rest-operands operands) var)))
131 665c255d 2023-08-04 jrmu (define (deriv-product operands var)
133 665c255d 2023-08-04 jrmu (make-product (first-operand operands)
134 665c255d 2023-08-04 jrmu (deriv (rest-operands operands) var))
135 665c255d 2023-08-04 jrmu (make-product (deriv (first-operand operands) var)
136 665c255d 2023-08-04 jrmu (rest-operands operands))))
137 665c255d 2023-08-04 jrmu (put 'deriv '+ deriv-sum)
138 665c255d 2023-08-04 jrmu (put 'deriv '* deriv-product)
140 665c255d 2023-08-04 jrmu ;; 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.
142 665c255d 2023-08-04 jrmu (define (exponentiation? exp)
143 665c255d 2023-08-04 jrmu (and (pair? exp) (eq? (car exp) '**)))
144 665c255d 2023-08-04 jrmu (define (base exp)
145 665c255d 2023-08-04 jrmu (cadr exp))
146 665c255d 2023-08-04 jrmu (define (exponent exp)
147 665c255d 2023-08-04 jrmu (caddr exp))
148 665c255d 2023-08-04 jrmu ((and (exponentiation? exp)
149 665c255d 2023-08-04 jrmu (number? (exponent exp)))
150 665c255d 2023-08-04 jrmu (make-product
151 665c255d 2023-08-04 jrmu (make-product (exponent exp)
152 665c255d 2023-08-04 jrmu (make-exponentiation (base exp)
153 665c255d 2023-08-04 jrmu (make-sum (exponent exp) -1)))
154 665c255d 2023-08-04 jrmu ;; or (- (exponent exp) 1)
155 665c255d 2023-08-04 jrmu (deriv (base exp) var)))
156 665c255d 2023-08-04 jrmu (define (make-exponentiation base exponent)
157 665c255d 2023-08-04 jrmu (cond ((and (=number? base 0) (=number? exponent 0)) (error "0^0 undefined"))
158 665c255d 2023-08-04 jrmu ((=number? exponent 0) 1)
159 665c255d 2023-08-04 jrmu ((=number? base 0) 0)
160 665c255d 2023-08-04 jrmu ((=number? base 1) 1)
161 665c255d 2023-08-04 jrmu ((and (number? base) (number? exponent)) (expt base exponent))
162 665c255d 2023-08-04 jrmu ((=number? exponent 1) base)
163 665c255d 2023-08-04 jrmu (else (list '** base exponent))))
165 665c255d 2023-08-04 jrmu (define (deriv-exp)
167 665c255d 2023-08-04 jrmu 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
169 665c255d 2023-08-04 jrmu ((get (operator exp) 'deriv) (operands exp) var)
171 665c255d 2023-08-04 jrmu What corresponding changes to the derivative system are required?
