1 (define (test-case actual expected)
2   (newline)
3   (display "Actual:   ")
4   (display actual)
5   (newline)
6   (display "Expected: ")
7   (display expected)
8   (newline))
9 
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))
15 (define (sum? x)
16   (and (pair? x) (eq? (car x) '+)))
17 (define (addend s) (cadr s))
18 (define (augend s) (caddr s))
19 (define (product? x)
20   (and (pair? x) (eq? (car x) '*)))
21 (define (multiplier p) (cadr p))
22 (define (multiplicand p) (caddr p))
23 
24 (define (make-sum a1 a2)
25   (cond ((=number? a1 0) a2)
26 	((=number? a2 0) a1)
27 	((and (number? a1) (number? a2)) (+ a1 a2))
28 	(else (list '+ a1 a2))))
29 (define (=number? exp num)
30   (and (number? exp) (= exp num)))
31 
32 (define (make-product m1 m2)
33   (cond ((or (=number? m1 0) (=number? m2 0)) 0)
34 	((=number? m1 1) m2)
35 	((=number? m2 1) m1)
36 	((and (number? m1) (number? m2)) (* m1 m2))
37 	(else (list '* m1 m2))))
38 
39 ;; Exercise 2.56.  Show how to extend the basic differentiator to handle more kinds of expressions. For instance, implement the differentiation rule
40 
41 ;; d(u^n)/dx = n*u^(n-1) * (du/dx)
42 
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. 
44 
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)
54 				       (multiplicand exp))))
55 	((and (exponentiation? exp) 
56 	      (number? (exponent exp)))
57 	 (make-product
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)))
64 
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. 
66 
67 (define (exponentiation? exp)
68   (and (pair? exp) (eq? (car exp) '**)))
69 (define (base exp)
70   (cadr exp))
71 (define (exponent exp)
72   (caddr exp))
73 
74 (define (make-exponentiation base exponent)
75   (cond ((and (=number? base 0) (=number? exponent 0)) (error "0^0 undefined"))
76 	((=number? exponent 0) 1)
77 	((=number? base 0) 0)
78 	((=number? base 1) 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
83 
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))
95 
96 (test-case (deriv (make-sum (make-sum (make-exponentiation 'x 3)
97 				      (make-product 3 (make-exponentiation 'x 2)))
98 			    (make-product 2 'x)) 
99 		  'x)
100 	   '(+ (+ (* 3 (** x 2))
101 		  (* 6 x))
102 	       2))
103