SICP 読み (83) 2.5.3 例: 記号代数
昨晩ハマってしまった件 (問題 2.90)
何が悪いのかワケが分からない。add-terms の実装は以下。
(define (add-terms L1 L2)
(cond ((empty-termlist? L1) L2)
((empty-termlist? L2) L1)
(else
(let ((t1 (first-term L1)) (t2 (first-term L2)))
(cond ((> (order t1) (order t2))
((adjoin-term (add-terms (rest-terms L1) L2)) t1))
((< (order t1) (order t2))
((adjoin-term (add-terms L1 (rest-terms L2))) t2))
(else
((adjoin-term (add-terms (rest-terms L1)
(rest-terms L2)))
(make-term (order t1)
(add (coeff t1) (coeff t2))))))))))む。(trace apply-generic) したら (一部のみ)
CALL apply-generic order (term 0 2)
RETN apply-generic 0
CALL apply-generic order (term 0 1)
RETN apply-generic 0
CALL apply-generic order (term 0 2)
RETN apply-generic 0
CALL apply-generic order (term 0 1)
RETN apply-generic 0
CALL apply-generic coeff (term 0 1)
RETN apply-generic 1
CALL apply-generic coeff (term 0 2)
RETN apply-generic 2
CALL add 1 2
CALL apply-generic add 1 2
RETN apply-generic 3
RETN add 3
CALL apply-generic first-term (sparse 1)
RETN apply-generic (term 0 1)
CALL apply-generic first-term (sparse 2)
RETN apply-generic (term 0 2)
CALL apply-generic empty-termlist? (term 0 1)上記は (add '(polynomial x sparse 1) '(polynomial x sparse 2)) のソレ。あるいは以下。
gosh> (add '(polynomial x sparse 1 0) '(polynomial x sparse 1))
CALL add (pol... x sparse 1 0) (polynomial x sparse 1)
CALL apply-generic add (pol... x sp... 1 ...) (poly... x sparse 1)
CALL apply-generic empty-termlist? (sparse 1 0)
CALL apply-generic =zero? 1
RETN apply-generic #f
RETN apply-generic #f
CALL apply-generic empty-termlist? (sparse 1)
CALL apply-generic =zero? 1
RETN apply-generic #f
RETN apply-generic #f
CALL apply-generic first-term (sparse 1 0)
RETN apply-generic (term 1 1)
CALL apply-generic first-term (sparse 1)
RETN apply-generic (term 0 1)
CALL apply-generic order (term 1 1)
RETN apply-generic 1
CALL apply-generic order (term 0 1)
RETN apply-generic 0
CALL apply-generic first-term (sparse 1 0)
RETN apply-generic (term 1 1)
CALL apply-generic empty-termlist? (term 1 1)ドコで first-term を取り出して empty-termlist? に渡してる? stack trace も出てるんですが以下。
*** ERROR: No method for these types -- APPLY-GENERIC (empty-termlist? (term))
Stack Trace:
_______________________________________
0 (apply function args)
At line 77 of "/usr/share/slib/trace.scm"
1 (empty-termlist? L1)
At line 170 of "(stdin)"
2 (add-terms (rest-terms L1) (rest-terms L2))
At line 179 of "(stdin)"
3 (adjoin-term (add-terms (rest-terms L1) (rest-terms L2)))
At line 179 of "(stdin)"
4 (add-terms (term-list p1) (term-list p2))
At line 164 of "(stdin)"
5 (add-poly p1 p2)
At line 225 of "(stdin)"
6 (apply function args)
At line 77 of "/usr/share/slib/trace.scm"
7 (apply function args)
At line 77 of "/usr/share/slib/trace.scm"何故なんだー、と言ってたんですが M-x occur で発見。
23: (define (first-term term-list)
45: (put 'first-term '(sparse)
46: (lambda (t) (first-term t)))
62: (define (first-term term-list) (apply-generic 'first-term term-list))
63: (define (rest-terms term-list) (apply-generic 'first-term term-list))
90: (let ((t1 (first-term L1)) (t2 (first-term L2)))
112: (add-terms (mul-term-by-all-terms (first-term L1) L2)
118: (let ((t2 (first-term L)))
130: (let ((t (first-term L)))とほほほ。rest-terms ...
# って直前エントリ確認したら bug 混入の跡がしっかり残ってますな。
で、修正したら動いたんですが、今度は
*** ERROR: No method for these types -- APPLY-GENERIC (adjoin-term (4))
だそうな。
これは置きかえで調べているトキに検出してた bug なんですが、adjoin-term した後のリストにタグが付いていない。とりあえず、adjoin-term を以下のように
(define (adjoin-term term-list)
(lambda (term)
(let f ((term-list term-list))
(if (> (order term) (length term-list))
(f (cons 0 term-list))
(tag (cons (coeff term) term-list))))))で、試験したら演算な試験は通しだったのですが、adjoin-term の試験で NG
expected:<(2 3 4)> but was:<(sparse 2 3 4)> in adjoin-term F expected:<(2 0 0)> but was:<(sparse 2 0 0)> in adjoin-term F expected:<(2 0 1 0)> but was:<(sparse 2 0 1 0)> in adjoin-term
試験は以下のように書いてある。
("adjoin-term"
(assert-equal '(2 3 4)
((apply-generic 'adjoin-term '(sparse 3 4)) '(term 2 2)))
(assert-equal '(2 0 0)
((apply-generic 'adjoin-term '(sparse)) '(term 2 2)))
(assert-equal '(2 0 1 0)
((apply-generic 'adjoin-term '(sparse 1 0)) '(term 3 2)))
)当たり前と言えば当たり前。ってか試験を先に直せよ、ってカンジ。以下のように修正。
("adjoin-term"
(assert-equal '(sparse 2 3 4)
((apply-generic 'adjoin-term '(sparse 3 4)) '(term 2 2)))
(assert-equal '(sparse 2 0 0)
((apply-generic 'adjoin-term '(sparse)) '(term 2 2)))
(assert-equal '(sparse 2 0 1 0)
((apply-generic 'adjoin-term '(sparse 1 0)) '(term 3 2)))
)とりあえず、対処完了、ってコトで。(を