SICP 問題 2.57(同一演算の項(2項以上)をまとめて記述する書式に変更した場合の構成子、選択子について)

なんかものすごく時間がかかってしまった。。
気が乗らなかったなぁこの問題。だって面倒くさそうだったんだもん。。

問題

微分プログラムを拡張し、(2かそれを超える)任意個の項の和と積が扱えるようにせよ。上の最後の例は

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

と表現できる。和と積の表現だけを変更し、deriv の手続は全く変更せずに試みよ。例えば和の addend は第1項、augend は残りの項の和とする。

解答

まずは和の表現を可変引数対応してみようか。

;====================
;共通
;====================
;モジュール?読み込み
(use srfi-1) ;filter 手続を使うため。

;累計器
(define (accumulate proc init lis)
  (if (null? lis)
      init
      (accumulate proc (proc init (car lis)) (cdr lis))))

;====================
;和に関する手続
;====================
;述語
(define (sum? exp)
  (and (pair? exp)
       (eq? (car exp) '+)))

;選択子(加数)
(define (addend exp)
  (cadr exp))

;選択子(被加算)
(define (augend exp)
  (let ((lis (cddr exp)))
    (if (= 1 (length lis))
	(car lis)
	(apply make-sum lis))))

;構成子
(define (make-sum a1 . a2)
  ;処理対象のリストを生成
  (let* ((lis (cons a1 a2))
  	 (vars (filter (lambda (x) (not (number? x))) lis))
  	 (num (accumulate + 0 (filter number? lis))))
    (cond ((=number? num 0)
    	   (if (= 1 (length vars))
    	       (car vars)
    	       (cons '+ vars)))
    	  (else
    	   (if (null? vars)
    	       num
    	       (cons '+ (reverse (cons num (reverse vars)))))))))

(define (=number? exp num)
  (and (number? exp) (= exp num)))

一応これで動くっぽい。但し、簡約化がダメダメ。。もっとうまくできねーかな。。
とりあえず実験結果を貼っ付けとこう。


gosh> (deriv '(+ 2 x 4 (** x 5) y x 5 z) 'x)
(+ (+ (* 5 (** x 4)) (+ (+) 1)) 1)
gosh>
う〜ん。。(+)って何だよ、(+)って。。
まぁ簡約化は難しいって言ってたし、これでいいにしておこう。

とりあえず次。今度は積。

;選択子(被乗数。積の式の第2項)
(define (multiplicand p)
  (let ((lis (cddr p)))
    (if (= 1 (length lis))
	(car lis)
	(apply make-product lis))))

;構成子
(define (make-product m1 . m2)
  (let* ((lis (cons m1 m2))
	 (vars (filter (lambda (x) (not (number? x))) lis))
	 (num (accumulate * 1 (filter number? lis))))
    (cond ((= 0 num) 0) ;数値の全積が 0 だったら 0 を返す
	  ((= 1 num)    ;数値の全積が 1 だったら
	   (if (= 1 (length vars)) ;変数のリストが単項ならばそれだけを返却
	       (car vars)
	       (cons '* vars)))    ;そうでなければ先頭に * をつけたリストを返却
	  (else
	   ;いずれの条件にも合致しなかった場合は、
	   ;変数と定数を組み合わせ、先頭に * をつけたリストを返却
	   (cons '* (reverse (cons num (reverse vars))))))))

こんな感じか〜?


gosh> (deriv '(* x y 5 (+ x 4) (+ 2 x z) z) 'x)
(+ (* x (* y (+ (* #0=(+ x 4) (+ (* #1=(+ 2 x z) (+)) (* z 5))) (* #1# z 5)))) (* y #0# #1# z 5))
長っ!しかも同一オブジェクトを指し示してる(#番号=で始まってる要素)が多くて分かり辛い。。
displayでごまかそう。

gosh> (display (deriv '(* x y 5 (+ x 4) (+ 2 x z) z) 'x))
(+ (* x (* y (+ (* (+ x 4) (+ (* (+ 2 x z) (+)) (* z 5))) (* (+ 2 x z) z 5)))) (* y (+ x 4) (+ 2 x z) z 5))#
gosh>
面倒くさいけどちゃんと確認はしてみよう。数式としては、

5yz・x (x+4)・(x+z+2)
= 5yz・(x^2 + 4x)・(x+z+2)
= 5yz・(x^3 + 4x^2 + (z+2)x^2 + 4(z+2)x)
= 5yz・(x^3 + (z+6)x^2 + 4(z+2)x)


これが元の式を見やすくしたやつ。微分すると・・・

→ 5yz・(3・x^2 + 2(z+6)x + 4(z+2))
さて、じゃ deriv でx微分したものを整理してみよう。すんごい面倒くさいけど。。

(+ (* x (* y (+ (* (+ x 4) (+ (* (+ 2 x z) (+)) (* z 5))) (* (+ 2 x z) z 5)))) (* y (+ x 4) (+ 2 x z) z 5))

・・・(中置記法に変換する。頑張って。途中で (+) ってのがでてくるけども、これは 0 とみなす。)

= (5yzx(2x+z+6)) + (5yz(x+4)(x+z+2))
= 5yzx(2x+z+6) + 5yz(x+4)(x+z+2)
= 5yz・(2x^2 + (z+6)x + x^2 + (z+2)x + 4x + 4(z+2))
= 5yz・(3x^2 + (2z + 12)x + 4(z+2))
= 5yz・(3x^2 + 2(z+6)x + 4(z+2))

あ・・・合ってた。。疲れた。
もう一つ単純なやつでやってみよう。

gosh> (deriv '(* x x x) 'x)
(+ (* x (+ x x)) (* x x))
gosh>
うん、暗算でも 3x^2 になることが分かるね。