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))))
13 
14 (define (attach-tag type-tag contents)
15   (cons type-tag contents))
16 (define (type-tag datum)
17   (if (pair? datum)
18       (car datum)
19       (error "Bad tagged datum -- TYPE-TAG" datum)))
20 (define (contents datum)
21   (if (pair? datum)
22       (cdr datum)
23       (error "Bad tagged datum -- CONTENTS" datum)))
24 (define (rectangular? z)
25   (eq? (type-tag z) 'rectangular))
26 (define (polar? z)
27   (eq? (type-tag z) 'polar))
28 
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)
33     (cons x y))
34   (define (magnitude z)
35     (sqrt (+ (square (real-part z))
36 	     (square (imag-part z)))))
37   (define (angle 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))))
50   'done)
51 
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))
56   (define (real-part z)
57     (* (magnitude z) (cos (angle z))))
58   (define (imag-part z)
59     (* (magnitude z) (sin (angle z))))
60   (define (make-from-real-imag x y)
61     (cons (sqrt (+ (square x) (square y)))
62 	  (atan y x)))
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))))
72   'done)
73 
74 (define (apply-generic op . args)
75   (let* ((type-tags (map type-tag args))
76 	 (proc (get op type-tags)))
77     (if proc
78 	(apply proc (map contents args))
79 	(error
80 	 "No method for these types -- APPLY-GENERIC"
81 	 (list op type-tags)))))
82 
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))
91 
92 (define (deriv exp var)
93   (cond ((number? exp) 0)
94 	((variable? exp) (if (same-variable? exp var) 1 0))
95 	((sum? exp)
96 	 (make-sum (deriv (addend exp) var)
97 		   (deriv (augend exp) var)))
98 	((product? exp)
99 	 (make-sum
100 	  (make-product (multiplier exp)
101 			(deriv (multiplicand exp) var))
102 	  (make-product (deriv (multiplier exp) var)
103 			(multiplicand exp))))
104 	(else (error "unknown expression type -- DERIV" exp))))
105 
106 ;; 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
107 
108 (define (deriv exp var)
109    (cond ((number? exp) 0)
110          ((variable? exp) (if (same-variable? exp var) 1 0))
111          (else ((get 'deriv (operator exp)) (operands exp)
112                                             var))))
113 (define (operator exp) (car exp))
114 (define (operands exp) (cdr exp))
115 
116 ;; a.  Explain what was done above. Why can't we assimilate the predicates number? and same-variable? into the data-directed dispatch?
117 
118 ;; 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.
119 
120 ;; We cannot assimilate the predicates because there are no operators for simple numbers and variables. These expressions are not lists.
121 
122 ;; 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.
123 
124 (define (first-operand operands)
125   (car operands))
126 (define (rest-operands operands)
127   (cdr operands))
128 (define (deriv-sum operands var)
129   (make-sum (deriv (first-operand operands) var)
130 	    (deriv (rest-operands operands) var)))
131 (define (deriv-product operands var)
132   (make-sum
133    (make-product (first-operand operands)
134 		 (deriv (rest-operands operands) var))
135    (make-product (deriv (first-operand operands) var)
136 		 (rest-operands operands))))
137 (put 'deriv '+ deriv-sum)
138 (put 'deriv '* deriv-product)
139 
140 ;; 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.
141 
142 (define (exponentiation? exp)
143   (and (pair? exp) (eq? (car exp) '**)))
144 (define (base exp)
145   (cadr exp))
146 (define (exponent exp)
147   (caddr exp))
148 	((and (exponentiation? exp) 
149 	      (number? (exponent exp)))
150 	 (make-product
151 	  (make-product (exponent exp)
152 			(make-exponentiation (base exp)
153 					     (make-sum (exponent exp) -1)))
154 ;; or (- (exponent exp) 1)
155 	  (deriv (base exp) var)))
156 (define (make-exponentiation base exponent)
157   (cond ((and (=number? base 0) (=number? exponent 0)) (error "0^0 undefined"))
158 	((=number? exponent 0) 1)
159 	((=number? base 0) 0)
160 	((=number? base 1) 1)
161 	((and (number? base) (number? exponent)) (expt base exponent))
162 	((=number? exponent 1) base)
163 	(else (list '** base exponent))))
164 
165 (define (deriv-exp)
166 
167 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
168 
169 ((get (operator exp) 'deriv) (operands exp) var)
170 
171 What corresponding changes to the derivative system are required?