1 (define (test-case actual expected)
10 (define (variable? x) (symbol? x))
11 (define (same-variable? v1 v2)
12 (and (variable? v1) (variable? v2) (eq? v1 v2)))
14 (define (deriv exp var)
15 (cond ((number? exp) 0)
16 ((variable? exp) (if (same-variable? exp var) 1 0))
17 ((sum? exp) (make-sum (deriv (addend exp) var)
18 (deriv (augend exp) var)))
19 ((product? exp) (make-sum
20 (make-product (multiplier exp)
21 (deriv (multiplicand exp) var))
22 (make-product (deriv (multiplier exp) var)
24 (error "unknown expression type -- DERIV" exp)))
26 ;; b. The problem becomes substantially harder if we allow standard algebraic notation, such as (x + 3 * (x + y + 2)), which drops unnecessary parentheses and assumes that multiplication is done before addition. Can you design appropriate predicates, selectors, and constructors for this notation such that our derivative program still works?
29 (and (not (number? x))
38 ;; (test-case (sum? '(5 + x)) #t)
39 ;; (test-case (sum? '(5 * x + 3)) #t)
40 ;; (test-case (sum? '(8 * x)) #f)
41 ;; (test-case (sum? 5) #f)
42 ;; (test-case (sum? '(5 * x + 8 * y)) #t)
43 ;; (test-case (sum? '(y * ((5 * x) + 3) + 2)) #t)
45 ;; an expression is a product if it is not a sum and contains a * sign somewhere in the top 'level' of a list
47 (and (not (number? x))
52 (product? (cddr x)))))
54 ;; (display "product?")
56 ;; (test-case (product? '(2 * x * y + 4)) #f)
57 ;; (test-case (product? '(x * y * z)) #t)
58 ;; (test-case (product? '((x + 1) * y)) #t)
59 ;; (test-case (product? '((x + (3 * z) * y) + (5 * z * (3 * y + 5)))) #f)
60 ;; (test-case (product? '((x + 3 * z * y) * y + 5)) #f)
62 ;; If the first operation is +, we return the first element in the list
63 ;; Otherwise, we join the first two elements to the addend of the rest
68 ;; we do not test if (cadddr s) is a number or variable because it might
69 ;; be a single nested list
70 (if (eq? (cadddr s) '+)
71 (list (car s) (cadr s) (addend (cddr s)))
74 (addend (cddr s)))))))
78 ;; (test-case (addend '(a + b + c)) 'a)
79 ;; (test-case (addend '(3 * x + 4 * y)) '(3 * x))
80 ;; (test-case (addend '(x * y * (z + 1) + (2 * 2))) '(x * y * (z + 1)))
81 ;; (test-case (addend '(2 * x * y + 4)) '(2 * x * y))
82 ;; (test-case (addend '((y + 1) * (y + 2) + 2 * ((3 * y) * 2) + 1))
83 ;; '((y + 1) * (y + 2)))
84 ;; (test-case (addend '((y + 1) * (y + 2) * (y + 3) + 2 * ((3 * y) * 2) + 1))
85 ;; '((y + 1) * (y + 2) * (y + 3)))
87 ;; If the first operation is +, we return the either the third element of the list if it is a single expression, or the rest of the list if there are more elements.
97 ;; (test-case (augend '(x + 6)) '6)
98 ;; (test-case (augend '(x + y + 6)) '(y + 6))
99 ;; (test-case (augend '(x + y * x)) '(y * x))
100 ;; (test-case (augend '(a + b + c + d + 5)) '(b + c + d + 5))
101 ;; (test-case (augend '(5 * x + 3 * y + 3))
103 ;; (test-case (augend '(5 * x + (y + 1) * (y + 2) + 2 * ((3 * y) * 2) + 1))
104 ;; '((y + 1) * (y + 2) + 2 * ((3 * y) * 2) + 1))
106 (define (multiplier p)
109 ;; (display "multiplier")
111 ;; (test-case (multiplier '(5 * x)) 5)
112 ;; (test-case (multiplier '(x * (x + 2))) 'x)
113 ;; (test-case (multiplier '((x + 1) * (x + 2) * (x + 3))) '(x + 1))
114 ;; (test-case (multiplier '((5 * x + 2) * 3)) '(5 * x + 2))
115 ;; (test-case (multiplier '((((x + 1) * (x + 2)) + 5) * (x + 3))) '(((x + 1) * (x + 2)) + 5))
116 ;; (test-case (multiplier '((y * (x + 5 * (y + 2)) + 4) * x * z)) '(y * (x + 5 * (y + 2)) + 4))
117 ;; (test-case (multiplier '((x + y + z) * (x + y))) '(x + y + z))
119 (define (multiplicand p)
120 (if (null? (cdddr p))
124 ;; (display "multiplicand")
126 ;; (test-case (multiplicand '(5 * x)) 'x)
127 ;; (test-case (multiplicand '(x * (x + 2))) '(x + 2))
128 ;; (test-case (multiplicand '((x + 1) * (x + 2) * (x + 3))) '((x + 2) * (x + 3)))
129 ;; (test-case (multiplicand '((5 * x + 2) * y)) 'y)
130 ;; (test-case (multiplicand '((((x + 1) * (x + 2)) + 5) * (x + 3 * (x + 4 * (x + 4))) * (x + 3) * (x + 1))) '((x + 3 * (x + 4 * (x + 4))) * (x + 3) * (x + 1)))
131 ;; (test-case (multiplicand '((y * (x + 5 * (y + 2)) + 4) * x * z)) '(x * z))
132 ;; (test-case (multiplicand '((x + y + z) * (x + y))) '(x + y))
134 ;; given a list of items to sum, check to see if any of the items are sums.
135 ;; If they are, return a new list with the addend and augends as separate expressions
136 (define (break-sums exps)
139 (let ((x (car exps)))
142 (break-sums (cons (augend x) (cdr exps))))
143 (cons x (break-sums (cdr exps)))))))
146 ;; (display "break-sums")
148 ;; (test-case (break-sums '((x + 5) x 3)) '(x 5 x 3))
149 ;; (test-case (break-sums '((x + (x + 5)) x 3)) '(x x 5 x 3))
150 ;; (test-case (break-sums '((x + 5 + 2 * x * y) (x * y + 5) (a + 2 + 3 * x) (x + a * b * c + 7))) '(x 5 (2 * x * y) (x * y) 5 a 2 (3 * x) x (a * b * c) 7))
152 ;; interpolate '+ signs between expressions
153 (define (add-plus-signs exps)
155 '() ;; this should never execute
157 (remnant (cdr exps)))
158 (cond ((null? remnant)
162 x)) ;; when x is a one-element list like '((x * y))
165 (cons x (cons '+ (add-plus-signs remnant))))
167 (error "unexpected sum"))
171 (add-plus-signs (cons (multiplicand x) remnant)))))
172 (else (error "expression type not yet implemented"))))))
174 ;; (display "add-plus-signs")
176 ;; (test-case (add-plus-signs '()) '())
177 ;; (test-case (add-plus-signs '(1)) '(1))
178 ;; (test-case (add-plus-signs '(x y z 4)) '(x + y + z + 4))
179 ;; (test-case (add-plus-signs '((x * y))) '(x * y))
180 ;; (test-case (add-plus-signs '((x * y) 5)) '(x * y + 5))
181 ;; (test-case (add-plus-signs '(((x * y) * (x + 1)) (5 * (x + 1)))) '((x * y) * (x + 1) + 5 * (x + 1)))
182 ;; (test-case (add-plus-signs '(((x * y + 2) * (y + 5)) a b (((a * b + 2) * c * (d + 1)) * (e + 4))))
183 ;; '((x * y + 2) * (y + 5) + a + b + ((a * b + 2) * c * (d + 1)) * (e + 4)))
186 ;; a number or a variable: we deal with it is without adding or removing any parentheses
187 ;; a product: we must remove the parentheses around the product but not tamper with parentheses within the multiplier or multiplicand. We must deal with the product as a single term.
188 ;; a sum: we must remove the parentheses around the sum (but we can optionally leave the addend's and potentially multiple augends' existing parentheses intact). We must then deal with the addend and potentially multiple augends as separate terms
189 (define (make-sum . exps)
190 (let* ((terms (break-sums exps))
191 (nums (filter number? terms))
192 (non-nums (filter (lambda (exp) (not (number? exp))) terms))
193 (sum-of-nums (fold-right + 0 nums)))
194 (cond ((null? non-nums) sum-of-nums)
195 ((and (= sum-of-nums 0)
196 (null? (cdr non-nums))) (car non-nums))
197 ((= sum-of-nums 0) (add-plus-signs non-nums))
198 (else (add-plus-signs (append non-nums (list sum-of-nums)))))))
200 ;; (display "make-sum")
202 ;; (test-case (make-sum 0 'x) 'x)
203 ;; (test-case (make-sum 1 2) 3)
204 ;; (test-case (make-sum 1 'x) '(x + 1))
205 ;; (test-case (make-sum 'x 'y) '(x + y))
206 ;; (test-case (make-sum (make-sum -3 'y)
207 ;; (make-sum 3 'x)) '(y + x))
208 ;; (make-sum '(y + -3) '(x + 3))
209 ;; (make-sum 'y -3 'x 3)
210 ;; (test-case (make-sum -3 'y 3 'x) '(y + x))
211 ;; (test-case (make-sum (make-sum 'a (make-sum 'b (make-sum 'c 'd)))) '(a + b + c + d))
212 ;; (test-case (make-sum (make-sum 'a 3) (make-sum 4 5 (make-sum 'x 'y)) (make-sum 'z (make-sum 1 'x)) 'x 'y) '(a + x + y + z + x + x + y + 13)) ;; we're not able to add variables/polynomials
213 ;; (test-case (make-sum 4 '(2 * x * y)) '(2 * x * y + 4))
214 ;; (test-case (make-sum '(3 * z) '(2 * x * y)) '(3 * z + 2 * x * y))
215 ;; (test-case (make-sum '(a * b) '(c * (d + 1) * e) '((f + 2) * (g + 3) * h)) '(a * b + c * (d + 1) * e + (f + 2) * (g + 3) * h))
217 ;; given a list of items to multiply, check to see if any of the items are products.
218 ;; If they are, return a new list with the multiplier and multiplicands as separate expressions
219 (define (break-products exps)
222 (let ((x (car exps)))
225 (break-products (cons (multiplicand x) (cdr exps))))
226 (cons x (break-products (cdr exps)))))))
229 ;; (display "break-products")
231 ;; (test-case (break-products '((5 * x) x 3)) '(5 x x 3))
232 ;; (test-case (break-products '((x * (5 * x)) x 3)) '(x 5 x x 3))
233 ;; (test-case (break-products '((5 * a * b + x + y) (x * y + 5) (2 * a * b) (x * y))) '((5 * a * b + x + y) (x * y + 5) 2 a b x y))
235 ;; interpolate '* signs between expressions
236 (define (add-mult-signs exps)
238 '() ;; this should never execute
240 (remnant (cdr exps)))
241 (cond ((null? remnant)
246 x)) ;; when x is a one-element list like '((x ** y))
250 (cons x (cons '* (add-mult-signs remnant))))
252 (error "unexpected product"))
253 (else (error "expression type not yet implemented"))))))
255 ;; (display "add-mult-signs")
257 ;; (test-case (add-mult-signs '()) '())
258 ;; (test-case (add-mult-signs '(1)) '(1))
259 ;; (test-case (add-mult-signs '(4 x y z)) '(4 * x * y * z))
260 ;; (test-case (add-mult-signs '((x * y))) '(x * y))
261 ;; (test-case (add-mult-signs '(5 (x + y))) '(5 * (x + y)))
262 ;; (test-case (add-mult-signs '((x + y) (x + 1) ((2 * x + 1) + 5 * x))) '((x + y) * (x + 1) * ((2 * x + 1) + 5 * x)))
263 ;; (test-case (add-mult-signs '((x * y + 2) (y + 5) a b (a * b + 2) c (d + 1) (e + 4)))
264 ;; '((x * y + 2) * (y + 5) * a * b * (a * b + 2) * c * (d + 1) * (e + 4)))
267 ;; variable or number, we just multiply without adding any extra parentheses
268 ;; sum, then we leave the parentheses intact and multiply, treating the sum as a single term
269 ;; product, then we must remove the parentheses around the product (optionally leaving the multiplier's and potentially multiple multiplicands' parentheses intact). We must deal with the multiplier and potentially multiple multiplicands as separate terms.
270 ;; (not implemented) a complex expression, we remove the parentheses around the expression and treat it as a single term
272 (define (make-product . exps)
273 (let* ((terms (break-products exps))
274 (nums (filter number? terms))
275 (non-nums (filter (lambda (exp) (not (number? exp))) terms))
276 (product-of-nums (fold-right * 1 nums)))
277 (cond ((null? non-nums) product-of-nums)
278 ((= product-of-nums 0) 0)
279 ((and (= product-of-nums 1)
280 (null? (cdr non-nums))) (car non-nums))
281 ((= product-of-nums 1) (add-mult-signs non-nums))
282 (else (add-mult-signs (cons product-of-nums non-nums))))))
284 ;; (test-case (make-product 5 '(5 * x)) '(25 * x))
285 ;; (test-case (make-product 5 'x) '(5 * x))
286 ;; (test-case (make-product 5 2) 10)
287 ;; (test-case (make-product 0 'x) 0)
288 ;; (test-case (make-product 5 2 'x) '(10 * x))
289 ;; (test-case (make-product 5 1/5 'x 'y) '(x * y))
290 ;; (test-case (make-product (make-product 'x 5) (make-product 'x 3 (make-product 1/15 'y 'z)) 'x) '(x * x * y * z * x))
291 ;; (test-case (make-product '(x + 3) 'y) '((x + 3) * y))
292 ;; (test-case (make-product (make-sum 5 'x)
293 ;; (make-product 'x 'y)
295 ;; '((x + 5) * x * y * (z + 2)))
296 ;; (test-case (make-product
297 ;; (make-sum (make-product 5 'x)
298 ;; (make-product 3 'y))
299 ;; (make-sum (make-product 2 'y)
300 ;; (make-product 2 3))
301 ;; (make-sum (make-sum 'x 4) (make-product 3 'y)))
302 ;; '((5 * x + 3 * y) * (2 * y + 6) * (x + 3 * y + 4)))
303 (test-case (make-sum (make-product 'a 'b)
304 (make-product 'c (make-sum 'd 1) 'e)
305 (make-product (make-sum 'f 2) (make-sum 'g 3) 'h))
306 '(a * b + c * (d + 1) * e + (f + 2) * (g + 3) * h))
307 (test-case (make-product (make-sum 5 'x)
310 '((x + 5) * x * y * (z + 2)))
315 (test-case (deriv '(x * y * (x + 3)) 'x) '(x * y + y * (x + 3)))
