Derivative finder. Inspired by SICP.

derivative.ss

; -*- scheme -*-


(define (derivative expr var)
  (cond
   ((number? expr) 0)
   ((variable? expr) (if (eq? expr var) 1 0))
   ((sum? expr)
    (make-sum (derivative (addend expr) var)
              (derivative (augend expr) var)))
   ((product? expr)
    (let ((u (multiplier expr))
          (v (multiplicant expr)))
      (make-sum (make-product u (derivative v var))
                (make-product v (derivative u var)))))
   ((exponent? expr)
    (let ((b (base expr))
          (exp (exponent expr)))
      (make-product exp
                    (make-exponent b (- exp 1)))))))

(define (make-sum a b)
  (cond
   ((equal? a b) (make-product 2 a))
   ((equal? a 0) b)
   ((equal? b 0) a)
   ((and (number? a) (number? b)) (+ a b))
   (else (list '+ a b))))

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

(define (make-exponent a b)
  (cond
   ((equal? b 1) a)
   (else (list '^ a b))))

(define (make-sin expr)
  (cond
   ((number? expr) (sin expr))
   (else (list 'sin expr))))
(define (make-cos expr)
  (cond
   ((number? expr) (cos expr))
   (else (list 'cos expr))))


(define (variable? expr)
  (symbol? expr))
(define (sum? expr)
  (and (pair? expr) (eq? '+ (car expr))))
(define (product? expr)
  (and (pair? expr) (eq? '* (car expr))))
(define (exponent? expr)
  (and (pair? expr) (eq? '^ (car expr))))
(define (sin? expr)
  (and (pair? expr) (eq? 'sin (car expr))))



(define (addend expr) (car (cdr expr)))
(define (augend expr) (car (cdr (cdr expr))))
(define (multiplier expr) (car (cdr expr)))
(define (multiplicant expr) (car (cdr (cdr expr))))
(define (base expr) (car (cdr expr)))
(define (exponent expr) (car (cdr (cdr expr))))


(display (derivative '(* x x) 'x))
(newline)
(display (derivative '(+ (* 2 x) 1) 'x))
(newline)
(display (derivative '(* x y) 'x))
(newline)
(display (derivative '(* 2 (^ x 2)) 'x))
(newline)
(display (derivative '(* (* x y) (+ x 3)) 'x))
(newline)