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))
