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))) )
とりあえず、対処完了、ってコトで。(を