src/sicp/ex2_73.rkt

   1 #lang racket
   2
   3 (define (deriv exp var)
   4   (cond
   5     [(number? exp) 0]
   6     [(variable? exp) (if (same-variable? exp var) 1 0)]
   7     [else ((get 'deriv (operator exp)) (operands exp)
   8                                        var)]))
   9
  10 (define (operator exp) (car exp))
  11 (define (operands exp) (cdr exp))
  12
  13 ;; part a
  14 #|
  15
  16 The 'get' procedure fetches from the table, an appropriate lambda
  17 function which takes as input, the operands and the variable. The
  18 function will return the appropriate expressions for addition and
  19 multiplication.
  20
  21 In theory we can define dispatch functions for number? and variable?.
  22 But for those functions, the dispatch functions will return a
  23 constant regardless of the input operands.
  24 |#
  25
  26 ;; part b
  27 (define deriv-sum
  28   (lambda (exp var)
  29     (make-sum (deriv (addend exp) var)
  30               (deriv (augend exp) var))))
  31
  32 (define deriv-prod
  33   (lambda (exp var)
  34     (make-sum (make-product (multiplier exp)
  35                             (deriv (multiplicand exp) var))
  36               (make-product (deriv (multiplier exp) var)
  37                             (multiplicand exp)))))
  38
  39 (define (install-deriv-package)
  40   ;; internal procedures
  41   (define (make-sum a1 a2) (list '+ a1 a2))
  42   (define (make-product m1 m2) (list '* m1 m2))
  43   (define (addend s) (car s))
  44   (define (augend s) (cadr s))
  45   (define (multiplier p) (car p))
  46   (define (multiplicand p) (cadr p))
  47   ;; public procedures
  48   (define (variable? x) (symbol? x))
  49   (define (same-variable? v1 v2)
  50     (and (variable? v1) (variable? v2) (eq? v1 v2)))
  51   (put 'deriv '+ deriv-sum)
  52   (put 'deriv '* deriv-prod))
  53
  54 ;; part c
  55 (define deriv-exponentiation
  56   (lambda (exp var)
  57     (make-product (exponent exp)
  58                   (make-product (make-exponentiation (base exp)
  59                                                      (- (exponent exp) 1))
  60                                 (deriv (base exp) var)))))
  61
  62 (define (make-exponent base exp)
  63   (list '** base exp))
  64 (define (base x) (car x))
  65 (define (exponent x) (cadr x))
  66 (put 'deriv '** deriv-exponentiation)
  67
  68 ;; part d.
  69 #|
  70 If we modify get, we just modify put and nothing else.
  71 |#