問題2-73 - TAKUYA’s CODE RECORDER

いよいよ｢2.4 抽象データの多重表現｣の節に入りました。いかにソフトウェアを設計/実装すべきかということに対する多くのヒントを得られそうな予感がしています。
早速、問題2-73の記号微分を行なうプログラムの改修に取り組みました。しかし、putやgetは自分で実装しなければならないことに気づき、いきなりつまずいてしまいました。ネットで調べたら、良さげなコードを見つけることができたので、今回はそのままそれを利用することにします(参照：http://sicp.naochan.com/memo.pl?p=put-get-gen)。ここに掲載されていたput-get-gen自体も非常に興味深いので、次回あたりに解読してみようと思っています。
以下は、お題として挙げられていた記号微分プログラムのインターフェイスです。

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

expの先頭項目である演算子を調べて、行なうべき処理を決めるというロジックです。number?やvariable?は先頭項目が演算子でないので、データ主導の振り分けを行なうことができません。
和や積の微分を行なえるようにするために、以下のようなパッケージを定義し、それをインストールして、実際に微分計算を実行してみます。

(define (install-sum-package)
  ;;inner-procedure
  (define (sum-proc exp var)
    (make-sum (deriv (car exp) var)
              (deriv (cadr exp) var)))
   ;;interface
  (put 'deriv '+ sum-proc)
  'done)

(define (install-product-package)
  ;;inner-procedure
  (define (product-proc exp var)
    (make-sum
     (make-product (car exp)
                   (deriv (cadr exp) var))
     (make-product (deriv (car exp) var)
                   (cadr exp))))
  ;;interface
  (put 'deriv '* product-proc)
  'done)

(install-sum-package)  ;=>done
(install-product-package)  ;=>done

(deriv '(+ x 3) 'x)  ;=>1
(deriv '(* x y) 'x)  ;=>y
(deriv '(* (* x y) (+ x 3)) 'x)  ;=>(+ (* x y) (* y (+ x 3)))

p88の例題と同じ答えが返ってきました。さらに、べき乗の計算を扱えるようにします。

(define (install-exponentiation-package)
  ;;inner-procedure
  (define (exponentiation-proc exp var)
    (make-product (make-product (cadr exp)
                                (make-exponentiation (car exp) (- (cadr exp) 1)))
                  (deriv (car exp) var)))    
  ;;interface
  (put 'deriv '** exponentiation-proc)
  'done)

(install-exponentiation-package)  ;=>done

(deriv '(** x 0) 'x)  ;=>0
(deriv '(** x 1) 'x)  ;=>1
(deriv '(** x 2) 'x)  ;=>(* 2 x)
(deriv '(** x 3) 'x)  ;=>(* 3 (** x 2))
(deriv '(* 2 (** x 3)) 'x)  ;=>(* 2 (* 3 (** x 2)))

こちらも、問題2-56と同じ結果になりました。derivメイン手続きに手を加えることなく、新しいロジックを組み込めたことになります。
また、'derivという記号の位置がderiv手続きの中で異なっていた場合、修正すべき箇所はどこかという問題ですが、以下のように、packageの中のputの中をちょっと変えるだけで、同じ結果が返ってきます。inner-procedureに手を加える必要はありません。

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

(define (install-another-sum-package)
  ;;inner-procedure
  (define (sum-proc exp var)
    (make-sum (deriv (car exp) var)
              (deriv (cadr exp) var)))
   ;;interface
  (put '+ 'deriv sum-proc)
  'done)

(install-another-sum-package)  ;=>done
(another-deriv '(+ x 3) 'x)  ;=>1

アキナイ有限責任会社の人事・給与システム設計については、一気に片付けてしまおうと思っていましたが、他の方のブログを見ると結構真剣に取り組んでいるみたいだったので、僕もじっくりやってみたいと考えています。