符号求导

deriv.scm

(define (variable? x) (symbol? x))
(define (same-variable? a b) (and (variable? a) (variable? b) (eq? a b)))

(define (sum? e) (and (pair? e) (eq? (car e) '+)))
(define (added e) (cadr e))
(define (augend e) 
  (if (= (length e) 3) (caddr e) (append '(+) (cdr (cdr e)))))

(define (product? e) (and (pair? e) (eq? (car e) '*)))
(define (multiplier e) (cadr e))
(define (multiplicand e)
  (if (= (length e) 3) (caddr e) (append '(*) (cdr (cdr e)))))

(define (=number? a v) (and (number? a) (= a v)))

(define (exponent? e) (and (pair? e) (eq? (car e) '^)))
(define (base e) (cadr e))
(define (exponent e) (caddr e))

(define (subtract? e) (and (pair? e) (eq? (car e) '-)))
(define (minuend e) (cadr e))
(define (subtrahend) (caddr e))


(define (make-exponentiation base ex)
  (cond ((=number? ex 0) 1)
        ((=number? ex 1) base)
        (else 
          (list '^ base ex))))

(define (make-substraction a b)
  (cond ((and (number? a) (number? b)) (- a b))
        (else 
          (list '- a b))))

(define (make-sum a b)
  (cond ((null? b) a)
        ((and (number? a) (number? b)) (+ a b))
        ((=number? a 0) b)
        ((=number? b 0) a)
        (else (list '+ a b))))

(define (make-product a b)
  (cond ((and (number? a) (number? b)) (* a b))
        ((or (=number? a 0) (=number? b 0)) 0)
        ((=number? a 1) b)
        ((=number? b 1) a)
        (else (list '* a b))))

(define (deriv e var)
  (cond ((number? e) 0)
        ((variable? e)
         (if (same-variable? e var) 1 0))
        ((sum? e)
         (make-sum (deriv (added e) var) (deriv (augend e) var)))
        ((product? e)
         (make-sum
           (make-product (multiplier e) (deriv (multiplicand e) var))
           (make-product (multiplicand e) (deriv (multiplier e) var))
           ))
        ((exponent? e)
         (make-product
           (exponent e)
           (make-exponentiation (base e) (make-substraction (exponent e) 1))))
        (else
          (error "other causes"))))

;(display (deriv '(* (* x y) (+ x 3)) 'x))
;(display (deriv '(* 8 (^ x 2)) 'x))
;(display (deriv '(+ x x x x) 'x))
;(display (deriv '(* x x x) 'x))
(display (deriv '(* x y (+ x 3)) 'x))
;(display (augend '(+ x (+ x x))))