src/sicp/ch2_3_deriv.rkt

   1 #lang racket
   2
   3 (define (deriv exp var)
   4   (cond ((number? exp) 0)
   5         ((variable? exp) (if (same-variable? exp var) 1 0))
   6         ((sum? exp) (make-sum (deriv (addend exp) var)
   7                               (deriv (augend exp) var)))
   8         ((product? exp) (make-sum (make-product (multiplier exp)
   9                                                 (deriv (multiplicant exp) var))
  10                                   (make-product (multiplicant exp)
  11                                                 (deriv (multiplier exp) var))))
  12         (else (error "unknown type of expression - deriv" exp))))
  13
  14 (define (variable? x) (symbol? x))
  15
  16 (define (same-variable? x y)
  17   (and (variable? x) (variable? y) (eq? x y)))
  18
  19 ;; sum
  20 (define (make-sum x y)
  21   (cond ((equal? x 0) y)
  22         ((equal? y 0) x)
  23         ((and (number? x) (number? y)) (+ x y))
  24         ((equal? x y) (make-product 2 x))
  25         (else (list '+ x y))))
  26
  27 (define (make-product x y)
  28   (cond ((equal? x 1) y)
  29         ((equal? y 1) x)
  30         ((equal? x 0) 0)
  31         ((equal? y 0) 0)
  32         (else (list '* x y))))
  33
  34 (define (sum? exp)
  35   (and (pair? exp)
  36        (eq? (car exp) '+)))
  37
  38 (define (product? exp)
  39   (and (pair? exp)
  40        (eq? (car exp) '*)))
  41
  42 (define (addend exp) (car (cdr exp)))
  43 (define (augend exp) (car (cdr (cdr exp))))
  44
  45 (define (multiplicant exp) (car (cdr exp)))
  46 (define (multiplier exp) (car (cdr (cdr exp))))
  47
  48
  49 ;; tests
  50 (deriv '(+ x 3) 'x)
  51 (deriv '(* x y) 'x)
  52 (deriv '(* (* x y) (+ x 3)) 'x)