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)))
14 665c255d 2023-08-04 jrmu (define (deriv exp var)
15 665c255d 2023-08-04 jrmu (cond ((number? exp) 0)
16 665c255d 2023-08-04 jrmu ((variable? exp) (if (same-variable? exp var) 1 0))
17 665c255d 2023-08-04 jrmu ((sum? exp) (make-sum (deriv (addend exp) var)
18 665c255d 2023-08-04 jrmu (deriv (augend exp) var)))
19 665c255d 2023-08-04 jrmu ((product? exp) (make-sum
20 665c255d 2023-08-04 jrmu (make-product (multiplier exp)
21 665c255d 2023-08-04 jrmu (deriv (multiplicand exp) var))
22 665c255d 2023-08-04 jrmu (make-product (deriv (multiplier exp) var)
23 665c255d 2023-08-04 jrmu (multiplicand exp))))
24 665c255d 2023-08-04 jrmu (error "unknown expression type -- DERIV" exp)))
26 665c255d 2023-08-04 jrmu ;; 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?
28 665c255d 2023-08-04 jrmu (define (sum? x)
29 665c255d 2023-08-04 jrmu (and (not (number? x))
30 665c255d 2023-08-04 jrmu (not (variable? x))
31 665c255d 2023-08-04 jrmu (not (null? (cdr x)))
32 665c255d 2023-08-04 jrmu (or (eq? (cadr x) '+)
33 665c255d 2023-08-04 jrmu (sum? (cddr x)))))
35 665c255d 2023-08-04 jrmu ;; (newline)
36 665c255d 2023-08-04 jrmu ;; (display "sum??")
37 665c255d 2023-08-04 jrmu ;; (newline)
38 665c255d 2023-08-04 jrmu ;; (test-case (sum? '(5 + x)) #t)
39 665c255d 2023-08-04 jrmu ;; (test-case (sum? '(5 * x + 3)) #t)
40 665c255d 2023-08-04 jrmu ;; (test-case (sum? '(8 * x)) #f)
41 665c255d 2023-08-04 jrmu ;; (test-case (sum? 5) #f)
42 665c255d 2023-08-04 jrmu ;; (test-case (sum? '(5 * x + 8 * y)) #t)
43 665c255d 2023-08-04 jrmu ;; (test-case (sum? '(y * ((5 * x) + 3) + 2)) #t)
45 665c255d 2023-08-04 jrmu ;; an expression is a product if it is not a sum and contains a * sign somewhere in the top 'level' of a list
46 665c255d 2023-08-04 jrmu (define (product? x)
47 665c255d 2023-08-04 jrmu (and (not (number? x))
48 665c255d 2023-08-04 jrmu (not (variable? x))
49 665c255d 2023-08-04 jrmu (not (sum? x))
50 665c255d 2023-08-04 jrmu (not (null? (cdr x)))
51 665c255d 2023-08-04 jrmu (or (eq? (cadr x) '*)
52 665c255d 2023-08-04 jrmu (product? (cddr x)))))
53 665c255d 2023-08-04 jrmu ;; (newline)
54 665c255d 2023-08-04 jrmu ;; (display "product?")
55 665c255d 2023-08-04 jrmu ;; (newline)
56 665c255d 2023-08-04 jrmu ;; (test-case (product? '(2 * x * y + 4)) #f)
57 665c255d 2023-08-04 jrmu ;; (test-case (product? '(x * y * z)) #t)
58 665c255d 2023-08-04 jrmu ;; (test-case (product? '((x + 1) * y)) #t)
59 665c255d 2023-08-04 jrmu ;; (test-case (product? '((x + (3 * z) * y) + (5 * z * (3 * y + 5)))) #f)
60 665c255d 2023-08-04 jrmu ;; (test-case (product? '((x + 3 * z * y) * y + 5)) #f)
62 665c255d 2023-08-04 jrmu ;; If the first operation is +, we return the first element in the list
63 665c255d 2023-08-04 jrmu ;; Otherwise, we join the first two elements to the addend of the rest
64 665c255d 2023-08-04 jrmu ;; of the list.
65 665c255d 2023-08-04 jrmu (define (addend s)
66 665c255d 2023-08-04 jrmu (if (eq? '+ (cadr s))
68 665c255d 2023-08-04 jrmu ;; we do not test if (cadddr s) is a number or variable because it might
69 665c255d 2023-08-04 jrmu ;; be a single nested list
70 665c255d 2023-08-04 jrmu (if (eq? (cadddr s) '+)
71 665c255d 2023-08-04 jrmu (list (car s) (cadr s) (addend (cddr s)))
72 665c255d 2023-08-04 jrmu (cons (car s)
73 665c255d 2023-08-04 jrmu (cons (cadr s)
74 665c255d 2023-08-04 jrmu (addend (cddr s)))))))
75 665c255d 2023-08-04 jrmu ;; (newline)
76 665c255d 2023-08-04 jrmu ;; (display "addend")
77 665c255d 2023-08-04 jrmu ;; (newline)
78 665c255d 2023-08-04 jrmu ;; (test-case (addend '(a + b + c)) 'a)
79 665c255d 2023-08-04 jrmu ;; (test-case (addend '(3 * x + 4 * y)) '(3 * x))
80 665c255d 2023-08-04 jrmu ;; (test-case (addend '(x * y * (z + 1) + (2 * 2))) '(x * y * (z + 1)))
81 665c255d 2023-08-04 jrmu ;; (test-case (addend '(2 * x * y + 4)) '(2 * x * y))
82 665c255d 2023-08-04 jrmu ;; (test-case (addend '((y + 1) * (y + 2) + 2 * ((3 * y) * 2) + 1))
83 665c255d 2023-08-04 jrmu ;; '((y + 1) * (y + 2)))
84 665c255d 2023-08-04 jrmu ;; (test-case (addend '((y + 1) * (y + 2) * (y + 3) + 2 * ((3 * y) * 2) + 1))
85 665c255d 2023-08-04 jrmu ;; '((y + 1) * (y + 2) * (y + 3)))
87 665c255d 2023-08-04 jrmu ;; 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.
88 665c255d 2023-08-04 jrmu (define (augend s)
89 665c255d 2023-08-04 jrmu (if (eq? '+ (cadr s))
90 665c255d 2023-08-04 jrmu (if (null? (cdddr s))
93 665c255d 2023-08-04 jrmu (augend (cddr s))))
94 665c255d 2023-08-04 jrmu ;; (newline)
95 665c255d 2023-08-04 jrmu ;; (display "augend")
96 665c255d 2023-08-04 jrmu ;; (newline)
97 665c255d 2023-08-04 jrmu ;; (test-case (augend '(x + 6)) '6)
98 665c255d 2023-08-04 jrmu ;; (test-case (augend '(x + y + 6)) '(y + 6))
99 665c255d 2023-08-04 jrmu ;; (test-case (augend '(x + y * x)) '(y * x))
100 665c255d 2023-08-04 jrmu ;; (test-case (augend '(a + b + c + d + 5)) '(b + c + d + 5))
101 665c255d 2023-08-04 jrmu ;; (test-case (augend '(5 * x + 3 * y + 3))
102 665c255d 2023-08-04 jrmu ;; '(3 * y + 3))
103 665c255d 2023-08-04 jrmu ;; (test-case (augend '(5 * x + (y + 1) * (y + 2) + 2 * ((3 * y) * 2) + 1))
104 665c255d 2023-08-04 jrmu ;; '((y + 1) * (y + 2) + 2 * ((3 * y) * 2) + 1))
106 665c255d 2023-08-04 jrmu (define (multiplier p)
108 665c255d 2023-08-04 jrmu ;; (newline)
109 665c255d 2023-08-04 jrmu ;; (display "multiplier")
110 665c255d 2023-08-04 jrmu ;; (newline)
111 665c255d 2023-08-04 jrmu ;; (test-case (multiplier '(5 * x)) 5)
112 665c255d 2023-08-04 jrmu ;; (test-case (multiplier '(x * (x + 2))) 'x)
113 665c255d 2023-08-04 jrmu ;; (test-case (multiplier '((x + 1) * (x + 2) * (x + 3))) '(x + 1))
114 665c255d 2023-08-04 jrmu ;; (test-case (multiplier '((5 * x + 2) * 3)) '(5 * x + 2))
115 665c255d 2023-08-04 jrmu ;; (test-case (multiplier '((((x + 1) * (x + 2)) + 5) * (x + 3))) '(((x + 1) * (x + 2)) + 5))
116 665c255d 2023-08-04 jrmu ;; (test-case (multiplier '((y * (x + 5 * (y + 2)) + 4) * x * z)) '(y * (x + 5 * (y + 2)) + 4))
117 665c255d 2023-08-04 jrmu ;; (test-case (multiplier '((x + y + z) * (x + y))) '(x + y + z))
119 665c255d 2023-08-04 jrmu (define (multiplicand p)
120 665c255d 2023-08-04 jrmu (if (null? (cdddr p))
123 665c255d 2023-08-04 jrmu ;; (newline)
124 665c255d 2023-08-04 jrmu ;; (display "multiplicand")
125 665c255d 2023-08-04 jrmu ;; (newline)
126 665c255d 2023-08-04 jrmu ;; (test-case (multiplicand '(5 * x)) 'x)
127 665c255d 2023-08-04 jrmu ;; (test-case (multiplicand '(x * (x + 2))) '(x + 2))
128 665c255d 2023-08-04 jrmu ;; (test-case (multiplicand '((x + 1) * (x + 2) * (x + 3))) '((x + 2) * (x + 3)))
129 665c255d 2023-08-04 jrmu ;; (test-case (multiplicand '((5 * x + 2) * y)) 'y)
130 665c255d 2023-08-04 jrmu ;; (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 665c255d 2023-08-04 jrmu ;; (test-case (multiplicand '((y * (x + 5 * (y + 2)) + 4) * x * z)) '(x * z))
132 665c255d 2023-08-04 jrmu ;; (test-case (multiplicand '((x + y + z) * (x + y))) '(x + y))
134 665c255d 2023-08-04 jrmu ;; given a list of items to sum, check to see if any of the items are sums.
135 665c255d 2023-08-04 jrmu ;; If they are, return a new list with the addend and augends as separate expressions
136 665c255d 2023-08-04 jrmu (define (break-sums exps)
137 665c255d 2023-08-04 jrmu (if (null? exps)
139 665c255d 2023-08-04 jrmu (let ((x (car exps)))
140 665c255d 2023-08-04 jrmu (if (sum? x)
141 665c255d 2023-08-04 jrmu (cons (addend x)
142 665c255d 2023-08-04 jrmu (break-sums (cons (augend x) (cdr exps))))
143 665c255d 2023-08-04 jrmu (cons x (break-sums (cdr exps)))))))
145 665c255d 2023-08-04 jrmu ;; (newline)
146 665c255d 2023-08-04 jrmu ;; (display "break-sums")
147 665c255d 2023-08-04 jrmu ;; (newline)
148 665c255d 2023-08-04 jrmu ;; (test-case (break-sums '((x + 5) x 3)) '(x 5 x 3))
149 665c255d 2023-08-04 jrmu ;; (test-case (break-sums '((x + (x + 5)) x 3)) '(x x 5 x 3))
150 665c255d 2023-08-04 jrmu ;; (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 665c255d 2023-08-04 jrmu ;; interpolate '+ signs between expressions
153 665c255d 2023-08-04 jrmu (define (add-plus-signs exps)
154 665c255d 2023-08-04 jrmu (if (null? exps)
155 665c255d 2023-08-04 jrmu '() ;; this should never execute
156 665c255d 2023-08-04 jrmu (let ((x (car exps))
157 665c255d 2023-08-04 jrmu (remnant (cdr exps)))
158 665c255d 2023-08-04 jrmu (cond ((null? remnant) (if (or (number? x)
159 665c255d 2023-08-04 jrmu (variable? x))
161 665c255d 2023-08-04 jrmu x)) ;; when x is a one-element list like '((x * y))
162 665c255d 2023-08-04 jrmu ((or (number? x)
163 665c255d 2023-08-04 jrmu (variable? x)) (cons x (cons '+ (add-plus-signs remnant))))
164 665c255d 2023-08-04 jrmu ((sum? x) (error "unexpected sum"))
165 665c255d 2023-08-04 jrmu ;; if x is a product or some other complicated expression
166 665c255d 2023-08-04 jrmu ((product? x) (cons (multiplier x)
168 665c255d 2023-08-04 jrmu (add-plus-signs (cons (multiplicand x) remnant)))))
169 665c255d 2023-08-04 jrmu ;; (cons (multiplicand x)
170 665c255d 2023-08-04 jrmu ;; (cons '+ (add-plus-signs remnant))))))
171 665c255d 2023-08-04 jrmu (else (error "expression type not yet implemented"))))))
172 665c255d 2023-08-04 jrmu ;; (newline)
173 665c255d 2023-08-04 jrmu ;; (display "add-plus-signs")
174 665c255d 2023-08-04 jrmu ;; (newline)
175 665c255d 2023-08-04 jrmu ;; (test-case (add-plus-signs '()) '())
176 665c255d 2023-08-04 jrmu ;; (test-case (add-plus-signs '(1)) '(1))
177 665c255d 2023-08-04 jrmu ;; (test-case (add-plus-signs '(x y z 4)) '(x + y + z + 4))
178 665c255d 2023-08-04 jrmu ;; (test-case (add-plus-signs '((x * y))) '(x * y))
179 665c255d 2023-08-04 jrmu ;; (test-case (add-plus-signs '((x * y) 5)) '(x * y + 5))
180 665c255d 2023-08-04 jrmu ;; (test-case (add-plus-signs '(((x * y) * (x + 1)) (5 * (x + 1)))) '((x * y) * (x + 1) + 5 * (x + 1)))
181 665c255d 2023-08-04 jrmu ;; (test-case (add-plus-signs '(((x * y + 2) * (y + 5)) a b (((a * b + 2) * c * (d + 1)) * (e + 4))))
182 665c255d 2023-08-04 jrmu ;; '((x * y + 2) * (y + 5) + a + b + ((a * b + 2) * c * (d + 1)) * (e + 4)))
184 665c255d 2023-08-04 jrmu ;; If the term is:
185 665c255d 2023-08-04 jrmu ;; a number or a variable: we deal with it is without adding or removing any parentheses
186 665c255d 2023-08-04 jrmu ;; 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.
187 665c255d 2023-08-04 jrmu ;; 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 individually.
189 665c255d 2023-08-04 jrmu (define (make-sum . exps)
190 665c255d 2023-08-04 jrmu (let* ((terms (break-sums exps))
191 665c255d 2023-08-04 jrmu (nums (filter number? terms))
192 665c255d 2023-08-04 jrmu (non-nums (filter (lambda (exp) (not (number? exp))) terms))
193 665c255d 2023-08-04 jrmu (sum-of-nums (fold-right + 0 nums)))
194 665c255d 2023-08-04 jrmu (cond ((null? non-nums) sum-of-nums)
195 665c255d 2023-08-04 jrmu ((and (= sum-of-nums 0)
196 665c255d 2023-08-04 jrmu (null? (cdr non-nums))) (car non-nums))
197 665c255d 2023-08-04 jrmu ((= sum-of-nums 0) (add-plus-signs non-nums))
198 665c255d 2023-08-04 jrmu (else (add-plus-signs (append non-nums (list sum-of-nums)))))))
200 665c255d 2023-08-04 jrmu (display "make-sum")
202 665c255d 2023-08-04 jrmu (test-case (make-sum 0 'x) 'x)
203 665c255d 2023-08-04 jrmu (test-case (make-sum 1 2) 3)
204 665c255d 2023-08-04 jrmu (test-case (make-sum 1 'x) '(x + 1))
205 665c255d 2023-08-04 jrmu (test-case (make-sum 'x 'y) '(x + y))
206 665c255d 2023-08-04 jrmu (test-case (make-sum (make-sum -3 'y)
207 665c255d 2023-08-04 jrmu (make-sum 3 'x)) '(y + x))
208 665c255d 2023-08-04 jrmu (make-sum '(y + -3) '(x + 3))
209 665c255d 2023-08-04 jrmu (make-sum 'y -3 'x 3)
210 665c255d 2023-08-04 jrmu (test-case (make-sum -3 'y 3 'x) '(y + x))
211 665c255d 2023-08-04 jrmu (test-case (make-sum (make-sum 'a (make-sum 'b (make-sum 'c 'd)))) '(a + b + c + d))
212 665c255d 2023-08-04 jrmu (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 665c255d 2023-08-04 jrmu (test-case (make-sum 4 '(2 * x * y)) '(2 * x * y + 4))
214 665c255d 2023-08-04 jrmu (test-case (make-sum '(3 * z) '(2 * x * y)) '(3 * z + 2 * x * y))
215 665c255d 2023-08-04 jrmu (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 665c255d 2023-08-04 jrmu ;; (test-case (make-product (make-sum 5 'x)
218 665c255d 2023-08-04 jrmu ;; (make-product 'x 'y)
219 665c255d 2023-08-04 jrmu ;; (make-sum 'z 2))
220 665c255d 2023-08-04 jrmu ;; '((5 + x) * x * y * (z + 2)))
221 665c255d 2023-08-04 jrmu ;; ;; if we are dealing with sums, then we must add parentheses; otherwise, omit parentheses
222 665c255d 2023-08-04 jrmu ;; (test-case (make-sum (make-sum -5 6 'x)
224 665c255d 2023-08-04 jrmu ;; (make-sum -3 3))
225 665c255d 2023-08-04 jrmu ;; '(x + 1 + y)) ;; notice that the constant 1 is not right-most
226 665c255d 2023-08-04 jrmu ;; (test-case (make-product (make-sum 2 4 (make-product 3 -2))
227 665c255d 2023-08-04 jrmu ;; (make-product 4 'y)) 0)
228 665c255d 2023-08-04 jrmu ;; (test-case (make-sum (make-product 5 'x)
229 665c255d 2023-08-04 jrmu ;; (make-product 3 'y)
230 665c255d 2023-08-04 jrmu ;; (make-product 2 'y)
231 665c255d 2023-08-04 jrmu ;; (make-product 2 3))
232 665c255d 2023-08-04 jrmu ;; '(5 * x + 3 * y + 2 * y + 6))
233 665c255d 2023-08-04 jrmu ;; (test-case (make-sum (make-product 5 'x 'y)
234 665c255d 2023-08-04 jrmu ;; (make-product 4 'a 'b 'c))
235 665c255d 2023-08-04 jrmu ;; '(5 * x * y + 4 * a * b * c))
238 665c255d 2023-08-04 jrmu (define (make-product . exps)
239 665c255d 2023-08-04 jrmu (let* ((nums (filter number? exps))
240 665c255d 2023-08-04 jrmu (non-nums (filter (lambda (exp) (not (number? exp))) exps))
241 665c255d 2023-08-04 jrmu (product-of-nums (fold-right * 1 nums)))
242 665c255d 2023-08-04 jrmu (cond ((null? non-nums) product-of-nums)
243 665c255d 2023-08-04 jrmu ((= product-of-nums 0) 0)
244 665c255d 2023-08-04 jrmu ((and (= product-of-nums 1)
245 665c255d 2023-08-04 jrmu (null? (cdr non-nums))) (car non-nums))
246 665c255d 2023-08-04 jrmu ((= product-of-nums 1) (add-mult-signs non-nums))
247 665c255d 2023-08-04 jrmu (else (add-mult-signs (cons product-of-nums non-nums))))))
249 665c255d 2023-08-04 jrmu (test-case (make-product 5 'x) '(5 * x))
250 665c255d 2023-08-04 jrmu (test-case (make-product 5 2) 10)
251 665c255d 2023-08-04 jrmu (test-case (make-product 0 'x) 0)
252 665c255d 2023-08-04 jrmu (test-case (make-product 5 2 'x) '(10 * x))
253 665c255d 2023-08-04 jrmu (test-case (make-product 5 1/5 'x 'y) '(x * y))
254 665c255d 2023-08-04 jrmu (test-case (make-product (make-product 'x 5) (make-product 'x 3 (make-product 1/15 'y 'z)) 'x) '(x * x * y * z * x))
255 665c255d 2023-08-04 jrmu (test-case (make-product '(x + 3) 'y) '((x + 3) * y))
258 665c255d 2023-08-04 jrmu If the exp is a:
259 665c255d 2023-08-04 jrmu variable or number, we just multiply without adding any extra parentheses
260 665c255d 2023-08-04 jrmu sum, then we must put parentheses around it and then multiply
261 665c255d 2023-08-04 jrmu product, then we just multiply without adding any extra parentheses
262 665c255d 2023-08-04 jrmu a complex expression, we just multiply without adding any extra parenthese around it
264 665c255d 2023-08-04 jrmu ;; (define (add-mult-signs exps)
265 665c255d 2023-08-04 jrmu ;; (cond ((null? exps) '())
266 665c255d 2023-08-04 jrmu ;; ((null? (cdr exps)) exps)
267 665c255d 2023-08-04 jrmu ;; (else (cons (car exps)
268 665c255d 2023-08-04 jrmu ;; (cons '*
269 665c255d 2023-08-04 jrmu ;; (add-mult-signs (cdr exps)))))))
274 665c255d 2023-08-04 jrmu '((2 * y + 3 * x) (4 * z + 5 * a))
275 665c255d 2023-08-04 jrmu ;; if there is no sum in exp, remove the parentheses
289 665c255d 2023-08-04 jrmu ;; make-sum
290 665c255d 2023-08-04 jrmu (test-case (make-sum (make-product 2 'x 'y) 4) '(2 * x * y + 4))
291 665c255d 2023-08-04 jrmu (test-case (make-sum 4 (make-product 2 'x 'y)) '(4 + 2 * x * y))
292 665c255d 2023-08-04 jrmu (test-case (make-sum (make-product 3 'z) (make-product 2 'x 'y)) '(3 * z + 2 * x * y))
293 665c255d 2023-08-04 jrmu (test-case (make-sum (make-product 'a 'b)
294 665c255d 2023-08-04 jrmu (make-product 'c (make-sum 'd 1) 'e)
295 665c255d 2023-08-04 jrmu (make-product (make-sum 'f 2) (make-sum 'g 3) 'h))
296 665c255d 2023-08-04 jrmu '(a * b + c * (d + 1) * e + (f + 2) * (g + 3) * h))
297 665c255d 2023-08-04 jrmu (test-case (make-product 5 'x) '(5 * x))
298 665c255d 2023-08-04 jrmu (test-case (make-product 5 2) 10)
299 665c255d 2023-08-04 jrmu (test-case (make-product 0 'x) 0)
300 665c255d 2023-08-04 jrmu (test-case (make-product 5 2 'x) '(10 * x))
301 665c255d 2023-08-04 jrmu (test-case (make-product 5 1/5 'x 'y) '(x * y))
302 665c255d 2023-08-04 jrmu (test-case (make-product 5 (make-product 'x 'y) 'z) '(5 * x * y * z))
303 665c255d 2023-08-04 jrmu (test-case (make-product (make-sum 5 'x)
304 665c255d 2023-08-04 jrmu (make-product 'x 'y)
305 665c255d 2023-08-04 jrmu (make-sum 'z 2))
306 665c255d 2023-08-04 jrmu '((5 + x) * x * y * (z + 2)))
307 665c255d 2023-08-04 jrmu ;; if we are dealing with sums, then we must add parentheses; otherwise, omit parentheses
308 665c255d 2023-08-04 jrmu (test-case (make-sum (make-sum -5 6 'x)
310 665c255d 2023-08-04 jrmu (make-sum -3 3))
311 665c255d 2023-08-04 jrmu '(x + 1 + y)) ;; notice that the constant 1 is not right-most
312 665c255d 2023-08-04 jrmu (test-case (make-product (make-sum 2 4 (make-product 3 -2))
313 665c255d 2023-08-04 jrmu (make-product 4 'y)) 0)
314 665c255d 2023-08-04 jrmu (test-case (make-sum (make-product 5 'x)
315 665c255d 2023-08-04 jrmu (make-product 3 'y)
316 665c255d 2023-08-04 jrmu (make-product 2 'y)
317 665c255d 2023-08-04 jrmu (make-product 2 3))
318 665c255d 2023-08-04 jrmu '(5 * x + 3 * y + 2 * y + 6))
319 665c255d 2023-08-04 jrmu (test-case (make-sum (make-product 5 'x 'y)
320 665c255d 2023-08-04 jrmu (make-product 4 'a 'b 'c))
321 665c255d 2023-08-04 jrmu '(5 * x * y + 4 * a * b * c))
324 665c255d 2023-08-04 jrmu (test-case (multiplier '(20 * x * ( (make-product (make-product 5 4 'x (make-sum 1 'y))
325 665c255d 2023-08-04 jrmu (make-sum 2 'z)))
326 665c255d 2023-08-04 jrmu '(20 * x * (y + 1)))
327 665c255d 2023-08-04 jrmu (test-case (multiplier (make-product (make-sum 5 6 4 -2)
329 665c255d 2023-08-04 jrmu (make-sum 1 -3 3)))
331 665c255d 2023-08-04 jrmu (test-case (multiplicand (make-product 5 'x)) 'x)
332 665c255d 2023-08-04 jrmu (test-case (multiplicand (make-product 5 'x 'y 'z)) '(x * y * z))
333 665c255d 2023-08-04 jrmu (test-case (multiplicand (make-product 5 'x 2 -3 'y)) '(x * y))
334 665c255d 2023-08-04 jrmu (test-case (multiplicand (make-product (make-sum 5 6 4 -2)
336 665c255d 2023-08-04 jrmu (make-sum 1 -3 3)))
339 665c255d 2023-08-04 jrmu (test-case (deriv '(* x y (+ x 3)) 'x) '(+ (* x y) (* y (+ x 3))))
342 665c255d 2023-08-04 jrmu ;; (define (make-sum . exps)
343 665c255d 2023-08-04 jrmu ;; (let* ((nums (filter number? exps))
344 665c255d 2023-08-04 jrmu ;; (non-nums (filter (lambda (exp) (not (number? exp))) exps))
345 665c255d 2023-08-04 jrmu ;; (sum-of-nums (fold-right + 0 nums)))
346 665c255d 2023-08-04 jrmu ;; (cond ((null? non-nums) sum-of-nums)
347 665c255d 2023-08-04 jrmu ;; ((and (= sum-of-nums 0)
348 665c255d 2023-08-04 jrmu ;; (null? (cdr non-nums))) (car non-nums))
349 665c255d 2023-08-04 jrmu ;; ((= sum-of-nums 0) (add-plus-signs non-nums))
350 665c255d 2023-08-04 jrmu ;; (else (add-plus-signs (append non-nums (list sum-of-nums)))))))
358 665c255d 2023-08-04 jrmu (define (remove-parens exps)
359 665c255d 2023-08-04 jrmu (cond ((sum? exps) ...)
362 665c255d 2023-08-04 jrmu (display "remove-parens")
364 665c255d 2023-08-04 jrmu (test-case (remove-parens '(0 x)) '(0 x))
365 665c255d 2023-08-04 jrmu (test-case (remove-parents
366 665c255d 2023-08-04 jrmu (make-sum '(y + -3)
368 665c255d 2023-08-04 jrmu '(y + x + 3))
369 665c255d 2023-08-04 jrmu (test-case (make-sum -3 'y 3 'x) '(y + x))
370 665c255d 2023-08-04 jrmu (test-case (make-sum (make-sum 'a (make-sum 'b (make-sum 'c 'd)))) '(a + b + c + d))
371 665c255d 2023-08-04 jrmu (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
373 665c255d 2023-08-04 jrmu ;; (test-case (remove-parens '((
375 665c255d 2023-08-04 jrmu ;; (define (make-sum . exps)
376 665c255d 2023-08-04 jrmu ;; (let* ((terms (append exps))
377 665c255d 2023-08-04 jrmu ;; (nums (filter number? terms))
378 665c255d 2023-08-04 jrmu ;; (non-nums (filter (lambda (exp) (not (number? exp))) terms))
379 665c255d 2023-08-04 jrmu ;; (sum-of-nums (fold-right + 0 nums)))
380 665c255d 2023-08-04 jrmu ;; (cond ((null? non-nums) sum-of-nums)
381 665c255d 2023-08-04 jrmu ;; ((and (= sum-of-nums 0)
382 665c255d 2023-08-04 jrmu ;; (null? (cdr non-nums))) (car non-nums))
383 665c255d 2023-08-04 jrmu ;; ((= sum-of-nums 0) (add-signs non-nums '+))
384 665c255d 2023-08-04 jrmu ;; (else (add-plus-signs (append non-nums (list sum-of-nums)))))))
386 665c255d 2023-08-04 jrmu ;;given a list of expressions to add, remove unnecessary groupings
387 665c255d 2023-08-04 jrmu (define (extract-terms exps)
388 665c255d 2023-08-04 jrmu (if (null? exps)
390 665c255d 2023-08-04 jrmu (let ((first-exp (car exps)))
391 665c255d 2023-08-04 jrmu (if (sum? first-exp)
392 665c255d 2023-08-04 jrmu (cons (addend first-exp)
393 665c255d 2023-08-04 jrmu (append (extract-terms (augend first-exp))
394 665c255d 2023-08-04 jrmu (extract-terms (cdr exps))))))))
395 665c255d 2023-08-04 jrmu (cons first-exp (extract-terms (cdr exprs)))
399 665c255d 2023-08-04 jrmu (test-case (extract-terms '((y + -3) (x + 3))) '(y
401 665c255d 2023-08-04 jrmu (test-case (make-sum (make-sum -3 'y)
402 665c255d 2023-08-04 jrmu (make-sum 3 'x)) '(y + x + 3))
403 665c255d 2023-08-04 jrmu (make-sum '(y + -3) '(x + 3))
404 665c255d 2023-08-04 jrmu (make-sum 'y -3 'x 3)
405 665c255d 2023-08-04 jrmu (test-case (make-sum -3 'y 3 'x) '(y + x))
406 665c255d 2023-08-04 jrmu (test-case (make-sum (make-sum 'a (make-sum 'b (make-sum 'c 'd)))) '(a + b + c + d))
407 665c255d 2023-08-04 jrmu (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
409 665c255d 2023-08-04 jrmu (test-case (make-sum (make-product 2 'x 'y) 4) '(2 * x * y + 4))
410 665c255d 2023-08-04 jrmu (test-case (make-sum 4 (make-product 2 'x 'y)) '(4 + 2 * x * y))
411 665c255d 2023-08-04 jrmu (test-case (make-sum (make-product 3 'z) (make-product 2 'x 'y)) '(3 * z + 2 * x * y))
412 665c255d 2023-08-04 jrmu (test-case (make-sum (make-product 'a 'b)
413 665c255d 2023-08-04 jrmu (make-product 'c (make-sum 'd 1) 'e)
414 665c255d 2023-08-04 jrmu (make-product (make-sum 'f 2) (make-sum 'g 3) 'h))
415 665c255d 2023-08-04 jrmu '(a * b + c * (d + 1) * e + (f + 2) * (g + 3) * h))
416 665c255d 2023-08-04 jrmu (test-case (make-product 5 'x) '(5 * x))
417 665c255d 2023-08-04 jrmu (test-case (make-product 5 2) 10)
418 665c255d 2023-08-04 jrmu (test-case (make-product 0 'x) 0)
419 665c255d 2023-08-04 jrmu (test-case (make-product 5 2 'x) '(10 * x))
420 665c255d 2023-08-04 jrmu (test-case (make-product 5 1/5 'x 'y) '(x * y))
421 665c255d 2023-08-04 jrmu (test-case (make-product 5 (make-product 'x 'y) 'z) '(5 * x * y * z))
422 665c255d 2023-08-04 jrmu (test-case (make-product (make-sum 5 'x)
423 665c255d 2023-08-04 jrmu (make-product 'x 'y)
424 665c255d 2023-08-04 jrmu (make-sum 'z 2))
425 665c255d 2023-08-04 jrmu '((5 + x) * x * y * (z + 2)))
426 665c255d 2023-08-04 jrmu ;; if we are dealing with sums, then we must add parentheses; otherwise, omit parentheses
427 665c255d 2023-08-04 jrmu (test-case (make-sum (make-sum -5 6 'x)
429 665c255d 2023-08-04 jrmu (make-sum -3 3))
430 665c255d 2023-08-04 jrmu '(x + 1 + y)) ;; notice that the constant 1 is not right-most
431 665c255d 2023-08-04 jrmu (test-case (make-product (make-sum 2 4 (make-product 3 -2))
432 665c255d 2023-08-04 jrmu (make-product 4 'y)) 0)
433 665c255d 2023-08-04 jrmu (test-case (make-sum (make-product 5 'x)
434 665c255d 2023-08-04 jrmu (make-product 3 'y)
435 665c255d 2023-08-04 jrmu (make-product 2 'y)
436 665c255d 2023-08-04 jrmu (make-product 2 3))
437 665c255d 2023-08-04 jrmu '(5 * x + 3 * y + 2 * y + 6))
438 665c255d 2023-08-04 jrmu (test-case (make-sum (make-product 5 'x 'y)
439 665c255d 2023-08-04 jrmu (make-product 4 'a 'b 'c))
440 665c255d 2023-08-04 jrmu '(5 * x * y + 4 * a * b * c))
