計算機程序的構造和解釋 練習題2.73

先整理導數操作表

-		類型
操作	+	*	**
deriv	deriv -sum	deriv -product	deriv -exponentiation

#lang racket
;put get實現
(define *op-table* (make-hash))

(define (put op type proc)
  (hash-set! *op-table* (list op type) proc))

(define (get op type)
  (hash-ref *op-table* (list op type) #f))


(define (deriv exp var)
  (cond ((number? exp) 0)
        ((variable? exp) (if (same-variable? exp var) 1 0))
        (else ((get 'deriv (operator exp)) (operands exp)
                                           var))))
(define (operator exp) (car exp))
(define (operands exp) (cdr exp))


(define (make-sum 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 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))))

(define (make-exponentiation e1 e2)
  (cond ((=number? e2 0) 1)
        ((=number? e2 1) e1)
        ((and (number? e1) (number? e2)) (exp e1 e2))
        (else (list '** e1 e2))))

(define (variable? x) (symbol? x))
(define (=number? exp num)
  (and (number? exp) (= exp num)))
(define (same-variable? v1 v2)
  (and (variable? v1) (variable? v2) (eq? v1 v2)))

(define (install-deriv-sum-package)
  (define (addend args) (car args))
  (define (augend args) (cadr args))
  (define (deriv-sum args var)
    (make-sum (deriv (addend args) var)
              (deriv (augend args) var)))
  (put 'deriv '+ deriv-sum))

(define (install-deriv-product-package)
  (define (multiplier args) (car args))
  (define (multiplicand args) (cadr args))
  (define (deriv-product args var)
    (make-sum
          (make-product (multiplier args)
                        (deriv (multiplicand args) var))
          (make-product (deriv (multiplier args) var)
                        (multiplicand args))))
  (put 'deriv '* deriv-product))

(define (install-deriv-exponentiation-package)
  (define (base s) (car s))
  (define (exponent s) (cadr s))
  (define (deriv-exponentiation args var)
    (make-product
          (make-product (exponent args)
                        (make-exponentiation (base args)
                                             (make-sum (exponent args) -1)))
          (deriv (base args) var)))
  (put 'deriv '** deriv-exponentiation))

(install-deriv-sum-package)
(install-deriv-product-package)
(install-deriv-exponentiation-package)

(deriv '(+ x 1) 'x)
(deriv '(* x y) 'x)
(deriv '(** x y) 'x)
(deriv '(* (+ (* x y) (* x 3)) (* x y)) 'x)

運行結果

1
'y
'(* y (** x (+ y -1)))
'(+ (* (+ (* x y) (* x 3)) y) (* (+ y 3) (* x y)))

a）構建了一個求導操作和運算類型的操作表，operator就是取得運算類型，operands是取出兩個參數表達式的，然後通過運算類型得到相應的運算過程進行運算。number？和same-variable？都是對於構成表達式的參數進行判斷，本身不包含運算符，所以加入不到數據分派中去。
b、c）詳細代碼見上面
d）將原代碼中的put過程的兩個參數調換位置就可以

(put 'deriv deriv-sum '+ )
(put 'deriv deriv-product '* )
(put 'deriv deriv-exponentiation '** )