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)))
13 (define (make-sum a1 a2) (list '+ a1 a2))
14 (define (make-product m1 m2) (list '* m1 m2))
16 (and (pair? x) (eq? (car x) '+)))
17 (define (addend s) (cadr s))
18 (define (augend s) (caddr s))
20 (and (pair? x) (eq? (car x) '*)))
21 (define (multiplier p) (cadr p))
22 (define (multiplicand p) (caddr p))
24 (define (make-sum a1 a2)
25 (cond ((=number? a1 0) a2)
27 ((and (number? a1) (number? a2)) (+ a1 a2))
28 (else (list '+ a1 a2))))
29 (define (=number? exp num)
30 (and (number? exp) (= exp num)))
32 (define (make-product m1 m2)
33 (cond ((or (=number? m1 0) (=number? m2 0)) 0)
36 ((and (number? m1) (number? m2)) (* m1 m2))
37 (else (list '* m1 m2))))
39 ;; Exercise 2.56. Show how to extend the basic differentiator to handle more kinds of expressions. For instance, implement the differentiation rule
41 ;; d(u^n)/dx = n*u^(n-1) * (du/dx)
43 ;; by adding a new clause to the deriv program and defining appropriate procedures exponentiation?, base, exponent, and make-exponentiation. (You may use the symbol ** to denote exponentiation.) Build in the rules that anything raised to the power 0 is 1 and anything raised to the power 1 is the thing itself.
45 (define (deriv exp var)
46 (cond ((number? exp) 0)
47 ((variable? exp) (if (same-variable? exp var) 1 0))
48 ((sum? exp) (make-sum (deriv (addend exp) var)
49 (deriv (augend exp) var)))
50 ((product? exp) (make-sum
51 (make-product (multiplier exp)
52 (deriv (multiplicand exp) var))
53 (make-product (deriv (multiplier exp) var)
55 ((and (exponentiation? exp)
56 (number? (exponent exp)))
58 (make-product (exponent exp)
59 (make-exponentiation (base exp)
60 (make-sum (exponent exp) -1)))
61 ;; or (- (exponent exp) 1)
62 (deriv (base exp) var)))
63 (error "unknown expression type -- DERIV" exp)))
65 ;; by adding a new clause to the deriv program and defining appropriate procedures exponentiation?, base, exponent, and make-exponentiation. (You may use the symbol ** to denote exponentiation.) Build in the rules that anything raised to the power 0 is 1 and anything raised to the power 1 is the thing itself.
67 (define (exponentiation? exp)
68 (and (pair? exp) (eq? (car exp) '**)))
71 (define (exponent exp)
74 (define (make-exponentiation base exponent)
75 (cond ((and (=number? base 0) (=number? exponent 0)) (error "0^0 undefined"))
76 ((=number? exponent 0) 1)
79 ((and (number? base) (number? exponent)) (expt base exponent))
80 ((=number? exponent 1) base)
81 (else (list '** base exponent))))
82 ;; warning, does not warn if x = 0 for 0^x
84 ;;(test-case (make-exponentiation 0 0) "0^0 undefined")
85 (test-case (make-exponentiation 0 1) 0)
86 (test-case (make-exponentiation 1 0) 1)
87 (test-case (make-exponentiation 5 5) 3125)
88 (test-case (make-exponentiation 'x 0) 1) ;; bug -- what if x = 0?
89 (test-case (make-exponentiation 'x 1) 'x)
90 (test-case (make-exponentiation 1 'x) 1)
91 (test-case (make-exponentiation 'x 5) '(** x 5))
92 (test-case (make-exponentiation 0 'x) 0) ;; bug -- what if x = 0?
93 (test-case (make-exponentiation 5 'x) '(** 5 x))
94 (test-case (make-exponentiation 'x 'x) '(** x x))
96 (test-case (deriv (make-sum (make-sum (make-exponentiation 'x 3)
97 (make-product 3 (make-exponentiation 'x 2)))
100 '(+ (+ (* 3 (** x 2))
104 ;; Exercise 2.57. Extend the differentiation program to handle sums and products of arbitrary numbers of (two or more) terms. Then the last example above could be expressed as
106 ;; (deriv '(* x y (+ x 3)) 'x)
108 ;; Try to do this by changing only the representation for sums and products, without changing the deriv procedure at all. For example, the addend of a sum would be the first term, and the augend would be the sum of the rest of the terms.
110 ;; (define (collect-terms term structure)
112 ;; (make-sum 1 2 3 4 5)
113 ;; (+ 1 (+ 2 (+ 3 (+ 4 5))))
124 ;; (test-case (combine-terms 1 '()) 0)
125 ;; (test-case (combine-terms '(+ 1 2 3)
126 ;; (test-case (+ 1 x 4 y -2) '(+ 3 x y))
127 ;; (test-case (+ 1 (* x y) (* 2 x y) -3) '(+ -2 (* 3 x y)))
129 ;; (test-case (combine-constants '(+ 1 2 3)) 6)
130 ;; (define (combine-constants exp)
131 ;; (define (combine accum terms)
132 ;; (cond ((null? terms) accum)
133 ;; ((number? terms) (+ accum terms))
134 ;; ((product? terms) terms)
135 ;; ((exponentiation? terms) terms)
137 ;; (if (number? (addend terms))
138 ;; (combine (+ accum (addend terms)) (augend terms))
142 ;; (combine (+ accum (addend terms)) (augend terms)))))
145 ;; combines terms within items that share term in common
146 (define (combine-terms term items)
147 (cond ((null? items) 0)
153 ;; we no longer combine constants, nor do we combine like terms
154 ;; all sums must have at least 2 terms
155 (define (make-sum . items)
156 (cond ((null? items) 0)
157 ((null? (cdr items)) (car items))
158 (else (append (list '+) items))))
160 ;; (define (make-sum . exps)
161 ;; (define (make-sum-recur items)
162 ;; (cond ((null? items) 0)
163 ;; (else (list '+ (car items) (make-sum (cdr items))))))
164 ;; (make-sum-recur items))
166 ;; (if (null? augends)
168 ;; (cons addend (make-sum (car augends) (cdr augends)))))
169 ;; (list '+ addend augends))
170 (define (make-product . items)
171 (append (list '*) items))
173 (define (make-sum a1 a2)
174 (cond ((=number? a1 0) a2)
176 ((and (number? a1) (number? a2)) (+ a1 a2))
177 (else (list '+ a1 a2))))
178 (define (=number? exp num)
179 (and (number? exp) (= exp num)))
181 (define (make-product m1 m2)
182 (cond ((or (=number? m1 0) (=number? m2 0)) 0)
185 ((and (number? m1) (number? m2)) (* m1 m2))
186 (else (list '* m1 m2))))
188 ;; assuming that all sums must contain at least 1 term
193 (cond ((null? (cddr s)) 0)
196 (define (multiplicand p) ...)
