;; The following symbolic differentiation routine is an extension of a routine from Section 2.3.2 of Abelson and Sussman's Structure and Interpretation of Computer Programs.
(define deriv
  (lambda (expr var)
    (cond ((number? expr) 0)
	  ((variable? expr)
	   (if (same-variable? expr var) 1 0))
	  ((sum? expr)
	   (make-sum (deriv (addend expr) var)
		     (deriv (augend expr) var)))
	  ((product? expr)
	   (make-sum
	    (make-product (multiplier expr)
			  (deriv (multiplicand expr) var))
	    (make-product (multiplicand expr)
			  (deriv (multiplier expr) var))))
	  ((sin? expr)
	   (make-product (make-cos (argument expr))
			 (deriv (argument expr) var)))
	  ((cos? expr)
	   (make-product
	     -1
	     (make-product (make-sin (argument expr))
			   (deriv (argument expr) var))))

	  (else
	   (error "deriv: unknown expression type in" expr)))))

(define make-sin
  (lambda (x)
    (cond ((=number? x 0) 0)
	  (else
	   (list 'sin x)))))

(define make-cos
  (lambda (x)
    (cond ((=number? x 0) 1)
	  (else
	   (list 'cos x)))))

(define sin?
  (lambda (x)
    (and (pair? x) (eq? (car x) 'sin))))

(define cos?
  (lambda (x)
    (and (pair? x) (eq? (car x) 'cos))))

(define argument
  (lambda (u)
    (cadr u)))

(define variable?
  (lambda (x)
    (symbol? x)))

(define same-variable?
  (lambda (v1 v2)
    (and (variable? v1) (variable? v2) (eq? v1 v2))))

(define sum?
  (lambda (x)
    (and (pair? x) (eq? (car x) '+))))

(define addend
  (lambda (s)
    (cadr s)))

(define augend
  (lambda (s)
    (caddr s)))

(define product?
  (lambda (x)
    (and (pair? x) (eq? (car x) '*))))

(define multiplier
  (lambda (p)
    (cadr p)))

(define multiplicand
  (lambda (p)
    (caddr p)))

(define =number?
  (lambda (x num)
    (and (number? x) (= x num))))

(define make-sum
  (lambda (a1 a2)
    (cond ((=number? a1 0) a2)
	  ((=number? a2 0) a1)
	  ((and (number? a1) (number? a2))
	   (+ a1 a2))
	  (else
	   (list '+ a1 a2)))))

(define make-product
  (lambda (m1 m2)
    (cond ((or (=number? m1 0) (=number? m2 0)) 0)
	  ((=number? m1 1) m2)
	  ((=number? m2 1) m1)
	  ((and (number? m1) (number? m2))
	   (* m1 m2))
	  (else
	   (list '* m1 m2)))))