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 ;; 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 665c255d 2023-08-04 jrmu (define (deriv exp var)
95 665c255d 2023-08-04 jrmu (cond ((number? exp) 0)
96 665c255d 2023-08-04 jrmu ((variable? exp) (if (same-variable? exp var) 1 0))
97 665c255d 2023-08-04 jrmu (else ((get 'deriv (operator exp)) (operands exp)
99 665c255d 2023-08-04 jrmu (define (operator exp) (car exp))
100 665c255d 2023-08-04 jrmu (define (operands exp) (cdr exp))
102 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?
104 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.
106 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.
108 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.
110 665c255d 2023-08-04 jrmu (define (first-operand operands)
111 665c255d 2023-08-04 jrmu (car operands))
112 665c255d 2023-08-04 jrmu (define (rest-operands operands)
113 665c255d 2023-08-04 jrmu (cdr operands))
114 665c255d 2023-08-04 jrmu (define (deriv-sum operands var)
115 665c255d 2023-08-04 jrmu (make-sum (deriv (first-operand operands) var)
116 665c255d 2023-08-04 jrmu (deriv (rest-operands operands) var)))
117 665c255d 2023-08-04 jrmu (define (deriv-product operands var)
119 665c255d 2023-08-04 jrmu (make-product (first-operand operands)
120 665c255d 2023-08-04 jrmu (deriv (rest-operands operands) var))
121 665c255d 2023-08-04 jrmu (make-product (deriv (first-operand operands) var)
122 665c255d 2023-08-04 jrmu (rest-operands operands))))
123 665c255d 2023-08-04 jrmu (put 'deriv '+ deriv-sum)
124 665c255d 2023-08-04 jrmu (put 'deriv '* deriv-product)
126 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.
128 665c255d 2023-08-04 jrmu (define (exponentiation? exp)
129 665c255d 2023-08-04 jrmu (and (pair? exp) (eq? (car exp) '**)))
130 665c255d 2023-08-04 jrmu (define (base exp)
131 665c255d 2023-08-04 jrmu (cadr exp))
132 665c255d 2023-08-04 jrmu (define (exponent exp)
133 665c255d 2023-08-04 jrmu (caddr exp))
134 665c255d 2023-08-04 jrmu (define (=number? x num)
135 665c255d 2023-08-04 jrmu (and (number? x) (= x num)))
136 665c255d 2023-08-04 jrmu (define (make-exponentiation base exponent)
137 665c255d 2023-08-04 jrmu (cond ((and (=number? base 0) (=number? exponent 0)) (error "0^0 undefined"))
138 665c255d 2023-08-04 jrmu ((=number? exponent 0) 1)
139 665c255d 2023-08-04 jrmu ((=number? base 0) 0)
140 665c255d 2023-08-04 jrmu ((=number? base 1) 1)
141 665c255d 2023-08-04 jrmu ((and (number? base) (number? exponent)) (expt base exponent))
142 665c255d 2023-08-04 jrmu ((=number? exponent 1) base)
143 665c255d 2023-08-04 jrmu (else (list '** base exponent))))
145 665c255d 2023-08-04 jrmu (define (deriv-exp operands var)
146 665c255d 2023-08-04 jrmu (car operands) (cadr operands)...)
148 665c255d 2023-08-04 jrmu (put 'deriv '** deriv-exp)
149 665c255d 2023-08-04 jrmu ((and (exponentiation? exp)
150 665c255d 2023-08-04 jrmu (number? (exponent exp)))
151 665c255d 2023-08-04 jrmu (make-product
152 665c255d 2023-08-04 jrmu (make-product (exponent exp)
153 665c255d 2023-08-04 jrmu (make-exponentiation (base exp)
154 665c255d 2023-08-04 jrmu (make-sum (exponent exp) -1)))
155 665c255d 2023-08-04 jrmu ;; or (- (exponent exp) 1)
156 665c255d 2023-08-04 jrmu (deriv (base exp) var)))
159 665c255d 2023-08-04 jrmu (define (deriv-exp)
161 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
163 665c255d 2023-08-04 jrmu ((get (operator exp) 'deriv) (operands exp) var)
165 665c255d 2023-08-04 jrmu What corresponding changes to the derivative system are required?
