SICP 読み (93) 2.5.3 例: 記号代数
一応 reduce-poly と reduce-terms な手続きを実装できたんですが、特に reduce-terms は個別に試験をしておきたい。個別にディレクトリを掘ってトップレベルな定義でもって試験を書いてみる。
お陰で小さいバグがいくつか取れた。最初はこうしてたんですが、
(define (reduce-terms L1 L2)
(let ((gcd-n-d (gcd-terms L1 L2)))
(let ((first-L1 (first-term L1))
(first-L2 (first-term L2)))
(let ((max-order (if (> (order first-L1) (order first-L2))
(order first-L1)
(order first-L2))))
(let ((int-fct (make-term
0
(expt (coeff (first-term gcd-n-d))
(+ 1 (- (order (first-term gcd-n-d))
max-order))))))
(let ((pL1 (mul-term-by-all-terms int-fct L1))
(pL2 (mul-term-by-all-terms int-fct L2)))
(let ((div-pL1 (car (div-terms pL1 gcd-n-d)))
(div-pL2 (car (div-terms pL2 gcd-n-d))))
(let ((gcd-L1-L2 (gcd-terms div-pL1 div-pL2)))
(let ((result-L1 (div-terms div-pL1 gcd-L1-L2))
(result-L2 (div-terms div-pL2 gcd-L1-L2)))
(list result-L1 result-L2)))))))))
)試験ができたお陰で以下に。
(define (reduce-terms L1 L2)
(let ((gcd-n-d (gcd-terms L1 L2)))
(let ((first-L1 (first-term L1))
(first-L2 (first-term L2)))
(let ((max-order (if (> (order first-L1) (order first-L2))
(order first-L1)
(order first-L2))))
(let ((int-fct (make-term
0
(expt (coeff (first-term gcd-n-d))
(+ 1 (- max-order
(order (first-term gcd-n-d))))))))
(let ((pL1 (mul-term-by-all-terms int-fct L1))
(pL2 (mul-term-by-all-terms int-fct L2)))
(let ((div-pL1 (car (div-terms pL1 gcd-n-d)))
(div-pL2 (car (div-terms pL2 gcd-n-d))))
(let ((gcd-L1-L2 (gcd-terms div-pL1 div-pL2)))
(let ((result-L1 (car (div-terms div-pL1 gcd-L1-L2)))
(result-L2 (car (div-terms div-pL2 gcd-L1-L2))))
(list result-L1 result-L2)))))))))
)修正点は以下二点。
- 整数化因子の計算において (1+O2-O1) していた
- div-terms が戻すのは商と剰余のリストなので car で商を取り出す必要がある
let の順に試験を書いてみました。以下。
#!/usr/bin/env gosh
(use test.unit)
(require "2.5.3")
(define-test-suite "2.5.3"
("gcd-terms"
(setup (lambda () (install-scheme-number-package)))
("(gcd-terms '((2 1) (1 2) (0 1)) '((1 1) (0 1)))"
(let ((L1 '((2 1) (1 2) (0 1)))
(L2 '((1 1) (0 1))))
(assert-equal '((1 1) (0 1))
(gcd-terms '((2 1) (1 2) (0 1))
'((1 1) (0 1)))))
)
)
("first-term"
("first-term L1 & L2"
(let ((L1 '((2 1) (1 2) (0 1)))
(L2 '((1 1) (0 1))))
(assert-equal '(2 1) (first-term L1))
(assert-equal '(1 1) (first-term L2)))
)
)
("max-order"
("max-order is 2"
(let ((L1 '((2 1) (1 2) (0 1)))
(L2 '((1 1) (0 1))))
(assert-equal 2 (if (> (order (first-term L1)) (order (first-term L2)))
(order (first-term L1))
(order (first-term L2)))))
)
)
("int-fct is 1?"
("(make-term 0 (expt 1 (+ 1 (- 2 1))))"
(let ((L1 '((2 1) (1 2) (0 1)))
(L2 '((1 1) (0 1))))
(let ((gcd-n-d (gcd-terms L1 L2)))
(assert-equal '(0 1)
(make-term 0 (expt
(coeff (first-term gcd-n-d))
(+ 1 (- 2
(order (first-term gcd-n-d)))))))))
)
)
("mul-term-by-all-terms"
("L1"
(let ((L1 '((2 1) (1 2) (0 1)))
(L2 '((1 1) (0 1))))
(let ((gcd-n-d (gcd-terms L1 L2)))
(assert-equal L1 (mul-term-by-all-terms '(0 1) L1))
(assert-equal L2 (mul-term-by-all-terms '(0 1) L2))))
)
)
("div-terms"
("L1/gcd-n-d"
(let ((L1 '((2 1) (1 2) (0 1)))
(L2 '((1 1) (0 1))))
(let ((gcd-n-d (gcd-terms L1 L2)))
(assert-equal '((1 1) (0 1))
(car (div-terms L1 gcd-n-d)))
(assert-equal '((0 1))
(car (div-terms L2 gcd-n-d)))))
)
)
("result's GCD"
("gcd-L1-L2"
(let ((div-pL1 '((1 1) (0 1)))
(div-pL2 '((0 1))))
(assert-equal '((0 1)) (gcd-terms div-pL1 div-pL2)))
)
)
("result"
("result-L1, result-L2"
(let ((div-pL1 '((1 1) (0 1)))
(div-pL2 '((0 1))))
(let ((gcd-L1-L2 (gcd-terms div-pL1 div-pL2)))
(assert-equal div-pL1 (car (div-terms div-pL1 gcd-L1-L2)))
(assert-equal div-pL2 (car (div-terms div-pL2 gcd-L1-L2)))))
)
)
("retuce-terms"
("(reduce-terms '((2 1) (1 2) (0 1)) '((1 1) (0 1)))"
(assert-equal '((1 1) (0 1))
(car (reduce-terms '((2 1) (1 2) (0 1))
'((1 1) (0 1)))))
(assert-equal '((0 1))
(cadr (reduce-terms '((2 1) (1 2) (0 1))
'((1 1) (0 1)))))
(assert-equal '(((1 1) (0 1)) ((0 1)))
(reduce-terms '((2 1) (1 2) (0 1))
'((1 1) (0 1))))
)
)
)こんなやり方しないと微妙な位に脳がイッてしまっていたりします。(を
この修正を本体に盛り込んだ上 (これをしなきゃいかん位なら単体試験なソレはリンクにしておきゃよかった、と今更思っても遅い) で reduce-poly な試験を検討。
ってその前に一応、reduce-integers とか汎用演算手続きなソレも盛り込みを。reduce-integers も reduce-poly もリストで戻すんで一度バラして tag 付けなきゃダメ、と勝手読み。
で、色々やってみてとりあえず gosh 上で確認。
gosh> (define p1 (make-polynomial 'x '((1 1) (0 1)))) p1 gosh> (define p2 (make-polynomial 'x '((3 1) (0 -1)))) p2 gosh> (define rf1 (make-rational p1 p2)) rf1 gosh> rf1 (rational (polynomial x (1 -1) (0 -1)) polynomial x (3 -1) (0 1)) gosh> (define p3 (make-polynomial 'x '((1 1)))) p3 gosh> (define p4 (make-polynomial 'x '((2 1) (0 -1)))) p4 gosh> (define rf2 (make-rational p3 p4)) rf2 gosh> rf2 (rational (polynomial x (1 -1)) polynomial x (2 -1) (0 1)) gosh> (add rf1 rf2) (rational (polynomial x (3 -1) (2 -2) (1 -3) (0 -1)) polynomial x (4 -1) (3 -1) (1 1) (0 1)) gosh>
うむむ。ワケワカ。ちなみに reduce したらどうなるか、というと。
gosh> (reduce '(polynomial x (5 1) (3 -1) (2 -1) (0 1)) '(polynomial x (4 1) (3 1) (2 1) (1 -2) (0 -1))) ((polynomial x (4 -1) (3 -1) (1 1) (0 1)) (polynomial x (3 -1) (2 -2) (1 -3) (0 -1))) gosh>
あ、逆だ。でもなんか p.123 の例とは違うぞ。ってか試験はこれで書けるのか。多分パスしないと思うけど書いてみる。
で、試験の結果を見てみるに
- 符号が逆
- デグレしている
という不具合が出現。
上記のソレを見るに reduce が微妙。見事に符号が逆転している。(絶句
でも分母と分子に -1 が掛けられてるから式の意味合い的には変わりはないんだけど、どこでこーゆー事になってるのか。問題解析は別途の楽しみに (というか今からヤる
