1 665c255d 2023-08-04 jrmu (defun make-exponentiation (base exp)
 2 665c255d 2023-08-04 jrmu   (cond ((=number? exp 0) 1)
 3 665c255d 2023-08-04 jrmu 	((=number? exp 1) base)
 4 665c255d 2023-08-04 jrmu 	((and (numberp base) (numberp exp))
 5 665c255d 2023-08-04 jrmu 	 (expt base exp))
 6 665c255d 2023-08-04 jrmu 	(t (list '** base exp))))
 7 665c255d 2023-08-04 jrmu 
 8 665c255d 2023-08-04 jrmu (defun exponentiation? (x)
 9 665c255d 2023-08-04 jrmu   (and (consp x) (eql (car x) '**)))
10 665c255d 2023-08-04 jrmu (defun base (x)
11 665c255d 2023-08-04 jrmu   (cadr s))
12 665c255d 2023-08-04 jrmu (defun exponent (s)
13 665c255d 2023-08-04 jrmu   (caddr s))
14 665c255d 2023-08-04 jrmu (defun deriv (expr var)
15 665c255d 2023-08-04 jrmu   (cond ((numberp expr) 0)
16 665c255d 2023-08-04 jrmu 	((variable? expr)
17 665c255d 2023-08-04 jrmu 	 (if (same-variable? expr var) 1 0))
18 665c255d 2023-08-04 jrmu 	((exponentiation? expr)
19 665c255d 2023-08-04 jrmu 	 (make-product
20 665c255d 2023-08-04 jrmu 	  (make-product
21 665c255d 2023-08-04 jrmu 	   (exponent expr)
22 665c255d 2023-08-04 jrmu 	   (make-exponentiation
23 665c255d 2023-08-04 jrmu 	    (base expr)
24 665c255d 2023-08-04 jrmu 	    (1- (exponent expr))))
25 665c255d 2023-08-04 jrmu 	  (deriv (base expr) var)))
26 665c255d 2023-08-04 jrmu 	((sum? expr)
27 665c255d 2023-08-04 jrmu 	 (make-sum (deriv (addend expr) var)
28 665c255d 2023-08-04 jrmu 		   (deriv (augend expr) var)))
29 665c255d 2023-08-04 jrmu 	((product? expr)
30 665c255d 2023-08-04 jrmu 	 (make-sum
31 665c255d 2023-08-04 jrmu 	  (make-product (multiplier expr)
32 665c255d 2023-08-04 jrmu 			(deriv (multiplicand expr) var))
33 665c255d 2023-08-04 jrmu 	  (make-product (deriv (multiplier expr) var)
34 665c255d 2023-08-04 jrmu 			(multiplicand expr))))
35 665c255d 2023-08-04 jrmu 	(t (error "unknown expression type -- DERIV ~A" expr))))
36 665c255d 2023-08-04 jrmu