Geek-Side

Resource > SICP Exersise 2_73
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)