src/sicp/ex2_58a.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 (cdr exp)) '+)))
  37
  38 (define (product? exp)
  39   (and (pair? exp)
  40        (eq? (car (cdr exp)) '*)))
  41
  42 (define (addend exp) (car exp))
  43 (define (augend exp) (car (cdr (cdr exp))))
  44
  45 (define (multiplicant exp) (car exp))
  46 (define (multiplier exp) (car (cdr (cdr exp))))
  47
  48 ;; test
  49 (deriv '(x + (3 * (x + (y + 2)))) 'x)
  50 (deriv '(x + (3 * (x + (y + 2)))) 'y)