src/sicp/ex2_56.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         ((exponentiation? exp) (let ((u (base exp))
  13                                      (n (exponent exp)))
  14                                  (make-product n
  15                                                (make-product (make-exponentiation u (make-sum n -1))
  16                                                              (deriv u var)))))
  17         (else (error "unknown type of expression - deriv" exp))))
  18
  19 (define (variable? x) (symbol? x))
  20
  21 (define (same-variable? x y)
  22   (and (variable? x) (variable? y) (eq? x y)))
  23
  24 ;; sum
  25 (define (make-sum x y)
  26   (cond ((equal? x 0) y)
  27         ((equal? y 0) x)
  28         ((and (number? x) (number? y)) (+ x y))
  29         ((equal? x y) (make-product 2 x))
  30         (else (list '+ x y))))
  31
  32 (define (make-product x y)
  33   (cond ((equal? x 1) y)
  34         ((equal? y 1) x)
  35         ((equal? x 0) 0)
  36         ((equal? y 0) 0)
  37         (else (list '* x y))))
  38
  39 (define (sum? exp)
  40   (and (pair? exp)
  41        (eq? (car exp) '+)))
  42
  43 (define (product? exp)
  44   (and (pair? exp)
  45        (eq? (car exp) '*)))
  46
  47 (define (addend exp) (car (cdr exp)))
  48 (define (augend exp) (car (cdr (cdr exp))))
  49
  50 (define (multiplicant exp) (car (cdr exp)))
  51 (define (multiplier exp) (car (cdr (cdr exp))))
  52
  53 ;; exponentiation
  54 (define (exponentiation? exp) (eq? (car exp) '**))
  55 (define (base exp) (car (cdr exp)))
  56 (define (exponent exp) (car (cdr (cdr exp))))
  57 (define (make-exponentiation base exp)
  58   (cond ((and (number? exp) (zero? exp)) 1)
  59         ((and (number? exp) (= exp 1)) base)
  60         (else (list '** base exp))))
  61