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