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))) )
通った。うーん ...
理屈として、何故に上記が成り立つのか分からんぞー。