1 665c255d 2023-08-04 jrmu (define (test-case actual expected)
3 665c255d 2023-08-04 jrmu (display "Actual: ")
4 665c255d 2023-08-04 jrmu (display actual)
6 665c255d 2023-08-04 jrmu (display "Expected: ")
7 665c255d 2023-08-04 jrmu (display expected)
10 665c255d 2023-08-04 jrmu (define (variable? x) (symbol? x))
11 665c255d 2023-08-04 jrmu (define (same-variable? v1 v2)
12 665c255d 2023-08-04 jrmu (and (variable? v1) (variable? v2) (eq? v1 v2)))
13 665c255d 2023-08-04 jrmu (define (make-sum a1 a2) (list '+ a1 a2))
14 665c255d 2023-08-04 jrmu (define (make-product m1 m2) (list '* m1 m2))
15 665c255d 2023-08-04 jrmu (define (sum? x)
16 665c255d 2023-08-04 jrmu (and (pair? x) (eq? (car x) '+)))
17 665c255d 2023-08-04 jrmu (define (addend s) (cadr s))
18 665c255d 2023-08-04 jrmu (define (augend s) (caddr s))
19 665c255d 2023-08-04 jrmu (define (product? x)
20 665c255d 2023-08-04 jrmu (and (pair? x) (eq? (car x) '*)))
21 665c255d 2023-08-04 jrmu (define (multiplier p) (cadr p))
22 665c255d 2023-08-04 jrmu (define (multiplicand p) (caddr p))
24 665c255d 2023-08-04 jrmu (define (make-sum a1 a2)
25 665c255d 2023-08-04 jrmu (cond ((=number? a1 0) a2)
26 665c255d 2023-08-04 jrmu ((=number? a2 0) a1)
27 665c255d 2023-08-04 jrmu ((and (number? a1) (number? a2)) (+ a1 a2))
28 665c255d 2023-08-04 jrmu (else (list '+ a1 a2))))
29 665c255d 2023-08-04 jrmu (define (=number? exp num)
30 665c255d 2023-08-04 jrmu (and (number? exp) (= exp num)))
32 665c255d 2023-08-04 jrmu (define (make-product m1 m2)
33 665c255d 2023-08-04 jrmu (cond ((or (=number? m1 0) (=number? m2 0)) 0)
34 665c255d 2023-08-04 jrmu ((=number? m1 1) m2)
35 665c255d 2023-08-04 jrmu ((=number? m2 1) m1)
36 665c255d 2023-08-04 jrmu ((and (number? m1) (number? m2)) (* m1 m2))
37 665c255d 2023-08-04 jrmu (else (list '* m1 m2))))
39 665c255d 2023-08-04 jrmu ;; Exercise 2.56. Show how to extend the basic differentiator to handle more kinds of expressions. For instance, implement the differentiation rule
41 665c255d 2023-08-04 jrmu ;; d(u^n)/dx = n*u^(n-1) * (du/dx)
43 665c255d 2023-08-04 jrmu ;; 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 665c255d 2023-08-04 jrmu (define (deriv exp var)
46 665c255d 2023-08-04 jrmu (cond ((number? exp) 0)
47 665c255d 2023-08-04 jrmu ((variable? exp) (if (same-variable? exp var) 1 0))
48 665c255d 2023-08-04 jrmu ((sum? exp) (make-sum (deriv (addend exp) var)
49 665c255d 2023-08-04 jrmu (deriv (augend exp) var)))
50 665c255d 2023-08-04 jrmu ((product? exp) (make-sum
51 665c255d 2023-08-04 jrmu (make-product (multiplier exp)
52 665c255d 2023-08-04 jrmu (deriv (multiplicand exp) var))
53 665c255d 2023-08-04 jrmu (make-product (deriv (multiplier exp) var)
54 665c255d 2023-08-04 jrmu (multiplicand exp))))
55 665c255d 2023-08-04 jrmu ((and (exponentiation? exp)
56 665c255d 2023-08-04 jrmu (number? (exponent exp)))
57 665c255d 2023-08-04 jrmu (make-product
58 665c255d 2023-08-04 jrmu (make-product (exponent exp)
59 665c255d 2023-08-04 jrmu (make-exponentiation (base exp)
60 665c255d 2023-08-04 jrmu (make-sum (exponent exp) -1)))
61 665c255d 2023-08-04 jrmu ;; or (- (exponent exp) 1)
62 665c255d 2023-08-04 jrmu (deriv (base exp) var)))
63 665c255d 2023-08-04 jrmu (error "unknown expression type -- DERIV" exp)))
65 665c255d 2023-08-04 jrmu ;; 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 665c255d 2023-08-04 jrmu (define (exponentiation? exp)
68 665c255d 2023-08-04 jrmu (and (pair? exp) (eq? (car exp) '**)))
69 665c255d 2023-08-04 jrmu (define (base exp)
71 665c255d 2023-08-04 jrmu (define (exponent exp)
72 665c255d 2023-08-04 jrmu (caddr exp))
74 665c255d 2023-08-04 jrmu (define (make-exponentiation base exponent)
75 665c255d 2023-08-04 jrmu (cond ((and (=number? base 0) (=number? exponent 0)) (error "0^0 undefined"))
76 665c255d 2023-08-04 jrmu ((=number? exponent 0) 1)
77 665c255d 2023-08-04 jrmu ((=number? base 0) 0)
78 665c255d 2023-08-04 jrmu ((=number? base 1) 1)
79 665c255d 2023-08-04 jrmu ((and (number? base) (number? exponent)) (expt base exponent))
80 665c255d 2023-08-04 jrmu ((=number? exponent 1) base)
81 665c255d 2023-08-04 jrmu (else (list '** base exponent))))
82 665c255d 2023-08-04 jrmu ;; warning, does not warn if x = 0 for 0^x
84 665c255d 2023-08-04 jrmu ;;(test-case (make-exponentiation 0 0) "0^0 undefined")
85 665c255d 2023-08-04 jrmu (test-case (make-exponentiation 0 1) 0)
86 665c255d 2023-08-04 jrmu (test-case (make-exponentiation 1 0) 1)
87 665c255d 2023-08-04 jrmu (test-case (make-exponentiation 5 5) 3125)
88 665c255d 2023-08-04 jrmu (test-case (make-exponentiation 'x 0) 1) ;; bug -- what if x = 0?
89 665c255d 2023-08-04 jrmu (test-case (make-exponentiation 'x 1) 'x)
90 665c255d 2023-08-04 jrmu (test-case (make-exponentiation 1 'x) 1)
91 665c255d 2023-08-04 jrmu (test-case (make-exponentiation 'x 5) '(** x 5))
92 665c255d 2023-08-04 jrmu (test-case (make-exponentiation 0 'x) 0) ;; bug -- what if x = 0?
93 665c255d 2023-08-04 jrmu (test-case (make-exponentiation 5 'x) '(** 5 x))
94 665c255d 2023-08-04 jrmu (test-case (make-exponentiation 'x 'x) '(** x x))
96 665c255d 2023-08-04 jrmu (test-case (deriv (make-sum (make-sum (make-exponentiation 'x 3)
97 665c255d 2023-08-04 jrmu (make-product 3 (make-exponentiation 'x 2)))
98 665c255d 2023-08-04 jrmu (make-product 2 'x))
100 665c255d 2023-08-04 jrmu '(+ (+ (* 3 (** x 2))
104 665c255d 2023-08-04 jrmu ;; 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 665c255d 2023-08-04 jrmu ;; (deriv '(* x y (+ x 3)) 'x)
108 665c255d 2023-08-04 jrmu ;; 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 665c255d 2023-08-04 jrmu ;; (define (collect-terms term structure)
112 665c255d 2023-08-04 jrmu ;; (make-sum 1 2 3 4 5)
113 665c255d 2023-08-04 jrmu ;; (+ 1 (+ 2 (+ 3 (+ 4 5))))
115 665c255d 2023-08-04 jrmu ;; (+ (+ (+ (+ 4 5)
120 665c255d 2023-08-04 jrmu ;; (+ 1 x 4 y -2)
121 665c255d 2023-08-04 jrmu ;; (+ 3 x y)
124 665c255d 2023-08-04 jrmu ;; (test-case (combine-terms 1 '()) 0)
125 665c255d 2023-08-04 jrmu ;; (test-case (combine-terms '(+ 1 2 3)
126 665c255d 2023-08-04 jrmu ;; (test-case (+ 1 x 4 y -2) '(+ 3 x y))
127 665c255d 2023-08-04 jrmu ;; (test-case (+ 1 (* x y) (* 2 x y) -3) '(+ -2 (* 3 x y)))
129 665c255d 2023-08-04 jrmu ;; (test-case (combine-constants '(+ 1 2 3)) 6)
130 665c255d 2023-08-04 jrmu ;; (define (combine-constants exp)
131 665c255d 2023-08-04 jrmu ;; (define (combine accum terms)
132 665c255d 2023-08-04 jrmu ;; (cond ((null? terms) accum)
133 665c255d 2023-08-04 jrmu ;; ((number? terms) (+ accum terms))
134 665c255d 2023-08-04 jrmu ;; ((product? terms) terms)
135 665c255d 2023-08-04 jrmu ;; ((exponentiation? terms) terms)
136 665c255d 2023-08-04 jrmu ;; ((sum? terms)
137 665c255d 2023-08-04 jrmu ;; (if (number? (addend terms))
138 665c255d 2023-08-04 jrmu ;; (combine (+ accum (addend terms)) (augend terms))
139 665c255d 2023-08-04 jrmu ;; (make-sum ()
141 665c255d 2023-08-04 jrmu ;; (augend terms)
142 665c255d 2023-08-04 jrmu ;; (combine (+ accum (addend terms)) (augend terms)))))
143 665c255d 2023-08-04 jrmu ;; (combine 0 exp))
145 665c255d 2023-08-04 jrmu ;; combines terms within items that share term in common
146 665c255d 2023-08-04 jrmu (define (combine-terms term items)
147 665c255d 2023-08-04 jrmu (cond ((null? items) 0)
149 665c255d 2023-08-04 jrmu ((number? term)
151 665c255d 2023-08-04 jrmu (else ...)))
153 665c255d 2023-08-04 jrmu ;; we no longer combine constants, nor do we combine like terms
154 665c255d 2023-08-04 jrmu ;; all sums must have at least 2 terms
155 665c255d 2023-08-04 jrmu (define (make-sum . items)
156 665c255d 2023-08-04 jrmu (cond ((null? items) 0)
157 665c255d 2023-08-04 jrmu ((null? (cdr items)) (car items))
158 665c255d 2023-08-04 jrmu (else (append (list '+) items))))
160 665c255d 2023-08-04 jrmu ;; (define (make-sum . exps)
161 665c255d 2023-08-04 jrmu ;; (define (make-sum-recur items)
162 665c255d 2023-08-04 jrmu ;; (cond ((null? items) 0)
163 665c255d 2023-08-04 jrmu ;; (else (list '+ (car items) (make-sum (cdr items))))))
164 665c255d 2023-08-04 jrmu ;; (make-sum-recur items))
166 665c255d 2023-08-04 jrmu ;; (if (null? augends)
168 665c255d 2023-08-04 jrmu ;; (cons addend (make-sum (car augends) (cdr augends)))))
169 665c255d 2023-08-04 jrmu ;; (list '+ addend augends))
170 665c255d 2023-08-04 jrmu (define (make-product . items)
171 665c255d 2023-08-04 jrmu (append (list '*) items))
173 665c255d 2023-08-04 jrmu (define (make-sum a1 a2)
174 665c255d 2023-08-04 jrmu (cond ((=number? a1 0) a2)
175 665c255d 2023-08-04 jrmu ((=number? a2 0) a1)
176 665c255d 2023-08-04 jrmu ((and (number? a1) (number? a2)) (+ a1 a2))
177 665c255d 2023-08-04 jrmu (else (list '+ a1 a2))))
178 665c255d 2023-08-04 jrmu (define (=number? exp num)
179 665c255d 2023-08-04 jrmu (and (number? exp) (= exp num)))
181 665c255d 2023-08-04 jrmu (define (make-product m1 m2)
182 665c255d 2023-08-04 jrmu (cond ((or (=number? m1 0) (=number? m2 0)) 0)
183 665c255d 2023-08-04 jrmu ((=number? m1 1) m2)
184 665c255d 2023-08-04 jrmu ((=number? m2 1) m1)
185 665c255d 2023-08-04 jrmu ((and (number? m1) (number? m2)) (* m1 m2))
186 665c255d 2023-08-04 jrmu (else (list '* m1 m2))))
188 665c255d 2023-08-04 jrmu ;; assuming that all sums must contain at least 1 term
192 665c255d 2023-08-04 jrmu (define (augend s)
193 665c255d 2023-08-04 jrmu (cond ((null? (cddr s)) 0)
194 665c255d 2023-08-04 jrmu ((null? (cdddr s))
196 665c255d 2023-08-04 jrmu (define (multiplicand p) ...)
