SICP 読み (89) 2.5.3 例: 記号代数

引き続き 2.94 な reminder-terms 実装と gcd-terms 実装ですか。

問題 2.94

まず、div-terms を盛り込まねば。って手元に 2.91 な解がない。4/14 のエントリから無理矢理ひっこ抜く。div-terms だけでええかなぁ。

 (define (div-terms L1 L2)
   (if (empty-termlist? L1)
       (list (the-empty-termlist) (the-empty-termlist))
       (let ((t1 (first-term L1))
             (t2 (first-term L2)))
         (if (> (order t2) (order t1))
             (list (the-empty-termlist) L1)
             (let ((new-c (div (coeff t1) (coeff t2)))
                   (new-o (- (order t1) (order t2))))
               (let ((rest-of-result (div-terms
                                      (add-terms
                                       (neg-terms
                                        (mul-term-by-all-terms
                                         (make-term new-o new-c)
                                         L2))
                                       L1)
                                      L2)))
                 (list (cons (make-term new-o new-c) (car rest-of-result))
                       (cadr rest-of-result))
                 ))))))

ああ、なんかキッタナいなぁ。let 使えばもう少し綺麗になる気がしてきた。こんな感じ??

 (define (div-terms L1 L2)
   (if (empty-termlist? L1)
       (list (the-empty-termlist) (the-empty-termlist))
       (let ((t1 (first-term L1))
             (t2 (first-term L2)))
         (if (> (order t2) (order t1))
             (list (the-empty-termlist) L1)
             (let ((new-c (div (coeff t1) (coeff t2)))
                   (new-o (- (order t1) (order t2))))
               (let ((mul-result-by-divisor (mul-term-by-all-terms
                                             (make-term new-o new-c)
                                             L2)))
                 (let ((negate (neg-terms mul-result-by-divisor)))
                   (let ((substract (add-terms negate L1)))
                     (let ((rest-of-result (div-terms substract L2)))
                       (list (cons (make-term new-o new-c)
                                   (car rest-of-result))
                             (cadr rest-of-result)))))))))))

うむ。見事な右下り。(謎

がしかし、このままでは試験不能。2.91 に盛り込んで試験してみるか。
# ってこっちに環境無いし ... (鬱

仕方が無いんで特別 put しといて試験書くか。

これと (これは polynomial-package の中)

;; for test
 (put 'div-t 'polynomial
     (lambda (t1 t2) (div-terms t1 t2)))
;; for test

これを追加して (これはトップレベル)

;; for test
(define (div-t t1 t2)
 ((get 'div-t 'polynomial) t1 t2))
;; for test

こんな試験を

 ("2-94"
  (setup (lambda ()
           (install-rational-package)
           (install-scheme-number-package)
           (install-polynomial-package)))

  ("example"
   (assert-equal '(((3 1) (1 1)) ((1 1) (0 -1)))
                 (div-t '((5 1) (0 -1))
                        '((2 1) (0 -1))))
   )

  )

一応試験はパス。
がしかし、これは TDD でセイフな範疇を超えてるように思う。こーゆー形で手続きが隠蔽されてる場合、どうやって試験するんだろ。
この問題のケースで言えば gcd-poly の試験でカバーするのかなぁ。ちょっと微妙。

とりあえず以下のような試験で動作確認を。
# これが合ってるのかどうかも微妙なんですが ... (を

  ("gcd-poly (1)"
   (let ((p1 (make-polynomial 'x '((2 1) (1 2) (0 1))))
         (p2 (make-polynomial 'x '((1 1) (0 1)))))
     (assert-equal p2 (gcd p1 p2)))
   )

一応試験はパス。で、問題に出ているソレですが、結果を手計算??
置き換えでやるしかない。手計算の方法なんて分からんしー。

えーと

(gcd '(polynomial x (4 1) (3 -1) (2 -2) (1 2))
     '(polynomial x (3 1) (1 -1)))

 (make-poly 'x (gcd-terms '((4 1) (3 -1) (2 -2) (1 2))
			  '((3 1) (1 -1))))

  (gcd-terms '((3 1) (1 -1)) (reminder-terms '((4 1) (3 -1) (2 -2) (1 2))
					     '((3 1) (1 -1))))

   (cadr (div-terms '((4 1) (3 -1) (2 -2) (1 2))
		    '((3 1) (1 -1))))

えーと、div-terms をどうやって置き換えたものか。
# ってか、気を失いそう ...

(div-terms '((4 1) (3 -1) (2 -2) (1 2)) '((3 1) (1 -1)))

 ;; new-c is 1 new-o is 1
 ;; (mul-term-by-all-terms '(1 1) '((3 1) (1 -1)))
 ;; is '((4 1) (2 -1))
 ;; neg -> '((4 -1) (2 1))
 ;; (add-terms '((4 1) (3 -1) (2 -2) (1 2)) '((4 -1) (2 1)))
 ;; is '((3 -1) (2 -1) (1 2))

 (div-terms '((3 -1) (2 -1) (1 2)) '((3 1) (1 -1)))

 ;; new-c is -1 new-o is 0
 ;; (mul-term-by-all-terms '(0 -1) '((3 1) (1 -1)))
 ;; is '((3 -1) (1 1))
 ;; neg -> '((3 1) (1 -1))
 ;; (add-terms '((3 -1) (2 -1) (1 2)) '((3 1) (1 -1)))
 ;; is '((2 -1) (1 1))

  (div-terms '((2 -1) (1 1)) '((3 1) (1 -1)))

   ;; return (list (the-empty-termlist) '((2 -1) (1 1)))

 ;; return (list (cons (0 -1) '()) '((2 -1) (1 1)))

 ;; return (list (cons (1 1) '((0 -1))) '((2 -1) (1 1)))
 ;; return '(((1 1) (0 -1)) ((2 -1) (1 1)))
 ;; reminder is '((2 -1) (1 1))

で、

(gcd-terms '((3 1) (1 -1)) '((2 -1) (1 1)))

 (gcd-terms '((2 -1) (1 1)) (reminder-terms '((3 1) (1 -1)) '((2 -1) (1 1))))

 (cadr (div-terms '((3 1) (1 -1)) '((2 -1) (1 1))))

div-terms か ...

(div-terms '((3 1) (1 -1)) '((2 -1) (1 1)))

 ;; new-c is -1 new-o is 1
 ;; (mul-term-by-all-terms '(1 -1) '((2 -1) (1 1)))
 ;; is '((3 1) (2 -1))
 ;; neg -> '((3 -1) (2 1))
 ;; (add-terms '((3 1) (1 -1)) '((3 -1) (2 1)))
 ;; is '((2 1) (1 -1))

 (div-terms '((2 1) (1 -1)) '((2 -1) (1 1)))

 ;; new-c is -1 new-o is 0
 ;; (mul-term-by-all-terms '(0 -1) '((2 -1) (1 1)))
 ;; is '((2 1) (1 -1))
 ;; neg -> '((2 -1) (1 1))
 ;; (add-terms '((2 1) (1 -1)) '((2 -1) (1 1)))
 ;; is '()

  (div-terms '() '((2 -1) (1 1)))

  ;; return (list '() '())

 ;; return (list (cons '(0 -1) '()) '())

 ;; return (list (cons '(1 -1) '((0 -1))) '())
 ;; '(((1 -1) (0 -1)) '())
 ;; reminder is '()

で、

(gcd-terms '((2 -1) (1 1)) '())

は、'((2 -1) (1 1)) を返却ですか。で、ドコに戻るんだろうか。(を
あ、これが gcd になるの??
# (make-poly 'x '((2 -1) (1 1))) ってカンジですか。

なんか置き換えしても全然微妙。一応試験に盛り込んでみる。

  ("gcd-poly (2)"
   (let ((p1 (make-polynomial 'x '((4 1) (3 -1) (2 -2) (1 2))))
         (p2 (make-polynomial 'x '((3 1) (1 -1)))))
     (assert-equal '(polynomial x (2 -1) (1 1))
                   (gcd p1 p2)))
   )

通った。うーん ...
理屈として、何故に上記が成り立つのか分からんぞー。