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 (deriv-sum operands var)
111 665c255d 2023-08-04 jrmu (make-sum (deriv (car operands) var)
112 665c255d 2023-08-04 jrmu (deriv (cadr operands) var)))
113 665c255d 2023-08-04 jrmu (define (deriv-product operands var)
114 665c255d 2023-08-04 jrmu (let ((multiplier (car operands))
115 665c255d 2023-08-04 jrmu (multiplicand (cadr operands)))
117 665c255d 2023-08-04 jrmu (make-product multiplier
118 665c255d 2023-08-04 jrmu (deriv multiplicand var))
119 665c255d 2023-08-04 jrmu (make-product (deriv multiplier var)
120 665c255d 2023-08-04 jrmu multiplicand))))
121 665c255d 2023-08-04 jrmu (put 'deriv '+ deriv-sum)
122 665c255d 2023-08-04 jrmu (put 'deriv '* deriv-product)
124 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.
126 665c255d 2023-08-04 jrmu (define (exponentiation? exp)
127 665c255d 2023-08-04 jrmu (and (pair? exp) (eq? (car exp) '**)))
128 665c255d 2023-08-04 jrmu (define (base exp)
129 665c255d 2023-08-04 jrmu (cadr exp))
130 665c255d 2023-08-04 jrmu (define (exponent exp)
131 665c255d 2023-08-04 jrmu (caddr exp))
132 665c255d 2023-08-04 jrmu (define (=number? x num)
133 665c255d 2023-08-04 jrmu (and (number? x) (= x num)))
134 665c255d 2023-08-04 jrmu (define (make-exponentiation base exponent)
135 665c255d 2023-08-04 jrmu (cond ((and (=number? base 0) (=number? exponent 0)) (error "0^0 undefined"))
136 665c255d 2023-08-04 jrmu ((=number? exponent 0) 1)
137 665c255d 2023-08-04 jrmu ((=number? base 0) 0)
138 665c255d 2023-08-04 jrmu ((=number? base 1) 1)
139 665c255d 2023-08-04 jrmu ((and (number? base) (number? exponent)) (expt base exponent))
140 665c255d 2023-08-04 jrmu ((=number? exponent 1) base)
141 665c255d 2023-08-04 jrmu (else (list '** base exponent))))
143 665c255d 2023-08-04 jrmu (define (deriv-exp operands var)
144 665c255d 2023-08-04 jrmu (let ((base (car operands))
145 665c255d 2023-08-04 jrmu (exponent (cadr operands)))
146 665c255d 2023-08-04 jrmu (make-product (make-product
148 665c255d 2023-08-04 jrmu (make-exponentiation base (make-sum exponent -1)))
149 665c255d 2023-08-04 jrmu (deriv base var))))
151 665c255d 2023-08-04 jrmu (put 'deriv '** deriv-exp)
153 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
155 665c255d 2023-08-04 jrmu ;; ((get (operator exp) 'deriv) (operands exp) var)
157 665c255d 2023-08-04 jrmu ;; What corresponding changes to the derivative system are required?
159 665c255d 2023-08-04 jrmu ;; All we need to do is change the put operations to (put 'operator 'operations procedure-name)
160 665c255d 2023-08-04 jrmu ;; not a big deal
