WeBlowg Side

Exersise 2.73

 (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))

a. 上記は何をしているか。
"number?"や"same-variable?"は、なぜデータ手動方式に吸収されないか。

number?やsame-variable?にはTYPEに相当するものが存在しないから。

b,c. 加算や乗算の微分や必要な補助コードをテーブルに導入する手続きを書く。

 (define (make-table)
   (let ((local-table (list '*table*)))
     (define (lookup key-1 key-2)
       (let ((subtable (assoc key-1 (cdr local-table))))
      (if subtable
          (let ((record (assoc key-2 (cdr subtable))))
            (if record
            (cdr record)
            #f))
          #f)))
     (define (insert! key-1 key-2 value)
       (let ((subtable (assoc key-1 (cdr local-table))))
      (if subtable
          (let ((record (assoc key-2 (cdr subtable))))
            (if record
            (set-cdr! record value)
            (set-cdr! subtable
                  (cons (cons key-2 value)
                    (cdr subtable)))))
          (set-cdr! local-table
                (cons (list key-1
                    (cons key-2 value))
                  (cdr local-table)))))
       'ok)
     (define (dispatch m)
       (cond ((eq? m 'lookup-proc) lookup)
          ((eq? m 'insert-proc!) insert!)
          (else (error "Unknown operation -- TABLE" m))))
     dispatch))
 
 (define operation-table (make-table))
 (define get (operation-table 'lookup-proc))
 (define put (operation-table 'insert-proc!))
 
 ;; 微分の各手続きをテーブルにインストール
 (define (install-deriv-package)
   (define (addend s) (car s))
   (define (augend s)
     (if (null? (cddr s))
      (cadr s)
      (cons '+  (cdr s))))
   (define (multiplier p) (car p))
   (define (multiplicand p) 
     (if (null? (cddr p))
      (cadr p)
      (cons '*  (cdr p))))
   (define (base exp)
     (car exp))
   (define (exponent exp)
     (cadr exp))
   
   (define (make-sum x y)
     (cond [(and (number? x) (number? y)) (+ x y)]
       [(eq? x 0) y]
       [(eq? y 0) x]
       [else (list '+ x y)] ))
   (define (make-product x y)
     (cond [(and (number? x) (number? y)) (* x y)]
       [(eq? x 1) y]
       [(eq? y 1) x]
       [(or (eq? x 0) (eq? y 0)) 0]
       [else (list '* x y)]))
   (define (make-exponentation x y)
     (cond [(and (number? x) (number? y)) (expt x y)]
       [(or (eq? x 0) (eq? x 1)) x]
       [(eq? y 1) x]
       [(eq? y 0) 1]
       [else (list '** x y)]))
   
   (define (sum exp var)
     (make-sum 
      (deriv (addend exp) var)
      (deriv (augend exp) var)))
   (define (product exp var)
     (make-sum
      (make-product (multiplier exp)
             (deriv (multiplicand exp) var))
      (make-product (deriv (multiplier exp) var)
             (multiplicand exp))))
   (define (exponentation exp var)
     (make-product
      (make-product (exponent exp) 
             (make-exponentation (base exp) (- (exponent exp) 1)))
      (deriv (base exp) var)))
   (put 'deriv '+  sum)
   (put 'deriv '*  product)
   (put 'deriv '** exponentation)
   'done)
 (install-deriv-package)
 
 ;; 微分手続き
 (define (deriv exp var)
   (cond ((number? exp) 0)
       ((variable? exp) (if (eq? exp var) 1 0))
       (else ((get  'deriv (operator exp) ) (operands exp)
              var))))
 (define (variable? var)
   (not (pair? var)))
 (define (operator exp) (car exp))
 (define (operands exp) (cdr exp))

d. `deriv' 手続きが下記の場合、変更が必要な箇所は？
((get (operator exp) 'deriv) (operands exp) var)

put手続きの引数の順序

   (put '+ 'deriv  sum)
   (put '* 'deriv  product)
   (put '** 'deriv  exponentation)