SICP 読み (80) 2.5.3 例: 記号代数
この_SICP 読み_というシリーズ、回数カウントしてるんですが、きちんと継続できれば 3 桁いくのは間違いないな。それは良いとして 2.89 の続きを。
問題 2.89
これ、もの凄く紆余曲折しています。読みづらいかもしれませんが、時系列で。
まず、直前エントリのソレを整理
- empty-termlist?
- リストの要素が全部 0 なら #t
- 空リストだったら #t
- それ以外は #f
- first-term
- リストの length - 1 とリストの car をリストにして返す
- rest-terms
- order
- coeff
- 同じでよい
- make-term
- 第二引数をそのまま返却
- adjoin-term
- (cons 第一引数 第二引数)
- the-empty-termlist
- '() を返せばよい (同じ)
- =zero?
- これもそのままで OK
という事でまず試験を検討。結構直接的な表現してる試験が多い。
term-list の理解が間違ってるかもしれませんが、以下に試験を。
#!/usr/bin/env gosh
(use test.unit)
(require "2.5.3")
(define-test-suite "2.5.3"
("2-88"
(setup (lambda ()
(install-scheme-number-package)
(install-polynomial-package)))
("first (1x - 1x = 0)"
(assert-true (=zero? (add (make-polynomial 'x '(1 0))
(neg (make-polynomial 'x '(1 0))))))
)
("2nd (1x - 0 = 1x)"
(let ((p (make-polynomial 'x '(1 0))))
(assert-equal p (add p (neg (make-polynomial 'x '())))))
)
("3rd (1x - 0x = 1x"
(let ((p1 (make-polynomial 'x '(1 0)))
(p0 (make-polynomial 'x '(0 0))))
(assert-equal p1 (add p1 (neg p0))))
)
("4th polynomial neg"
(let ((p1 (make-polynomial 'x '(1 2 3 4)))
(p2 (make-polynomial 'x '(-1 -2 -3 -4))))
(assert-equal p1 (neg p2))
(assert-equal p2 (neg p1)))
)
)
("2-87"
(setup (lambda ()
(install-scheme-number-package)
(install-polynomial-package)))
("() is zero"
(assert-true (=zero? (make-polynomial 'x '())))
)
("() is zero (2)"
(assert-true (=zero? '(polynomial x)))
)
("(0 0 0 0) is zero"
(assert-true (=zero? '(polynomial x 0 0 0 0)))
)
("(y + 1)x + (-y - 1)x is zero"
(let ((py1 (make-polynomial 'y '(1 1)))
(py2 (make-polynomial 'y '(-1 -1))))
(assert-true (=zero? (add (make-polynomial 'x (list py1 0))
(make-polynomial 'x (list py2 0))))))
)
)
("make-polynomial test"
(setup (lambda ()
(install-polynomial-package)))
("car is 'polynomial"
(assert-equal 'polynomial (car (make-polynomial 'var 'terms)))
)
("cadr is var"
(assert-equal 'var (cadr (make-polynomial 'var 'terms)))
)
("cddr is terms"
(assert-equal 'terms (cddr (make-polynomial 'var 'terms)))
)
)
("add test (1)"
(setup (lambda ()
(install-scheme-number-package)
(install-polynomial-package)))
("different variable"
(assert-error (lambda () (add (make-polynomial 'x '(0 5))
(make-polynomial 'y '(0 5)))))
)
("add constant"
(let ((test (add (make-polynomial 'x '(1))
(make-polynomial 'x '(2)))))
(assert-equal 'polynomial (car test))
(assert-equal 'x (cadr test))
(assert-equal '(3) (cddr test)))
)
("result 0"
(let ((test (add (make-polynomial 'x '(0))
(make-polynomial 'x '(0)))))
(assert-equal 'polynomial (car test))
(assert-equal 'x (cadr test))
(assert-equal '(0) (cddr test)))
)
("add 0 to 5 (1)"
(let ((test (add (make-polynomial 'x '(0))
(make-polynomial 'x '(5)))))
(assert-equal 'polynomial (car test))
(assert-equal 'x (cadr test))
(assert-equal '(5) (cddr test)))
)
("add 0 to 5 (2)"
(let ((test (add (make-polynomial 'x '())
(make-polynomial 'x '(5)))))
(assert-equal 'polynomial (car test))
(assert-equal 'x (cadr test))
(assert-equal '(5) (cddr test)))
)
("add 5 to 0 (1)"
(let ((test (add (make-polynomial 'x '(5))
(make-polynomial 'x '(0)))))
(assert-equal 'polynomial (car test))
(assert-equal 'x (cadr test))
(assert-equal '(5) (cddr test)))
)
("add 5 to 0 (2)"
(let ((test (add (make-polynomial 'x '(5))
(make-polynomial 'x '()))))
(assert-equal 'polynomial (car test))
(assert-equal 'x (cadr test))
(assert-equal '(5) (cddr test)))
)
("normal (2x + 3) + (x^2 + x + 2) -> x^2 + 3x + 5"
(let ((test (add (make-polynomial 'x '(2 3))
(make-polynomial 'x '(1 1 2)))))
(assert-equal 'polynomial (car test))
(assert-equal 'x (cadr test))
(assert-equal '(1 3 5) (cddr test)))
)
)
("mul test"
(setup (lambda ()
(install-scheme-number-package)
(install-polynomial-package)))
("different variable"
(assert-error (lambda () (mul (make-polynomial 'x '(5))
(make-polynomial 'y '(5)))))
)
("p1 is not variable"
(assert-error (lambda () (mul (make-polynomial 1 '(5))
(make-polynomial 'x '(5)))))
)
("p2 is not variable"
(assert-error (lambda () (mul (make-polynomial 'x '(5))
(make-polynomial 2 '(5)))))
)
("0 times 5 (1)"
(let ((test (mul (make-polynomial 'x '())
(make-polynomial 'x '(5)))))
(assert-equal 'polynomial (car test))
(assert-equal 'x (cadr test))
(assert-equal '(0) (cddr test)))
)
("0 times 5 (2)"
(let ((test (mul (make-polynomial 'x '(0))
(make-polynomial 'x '(5)))))
(assert-equal 'polynomial (car test))
(assert-equal 'x (cadr test))
(assert-equal '(0) (cddr test)))
)
("5 times 0 (1)"
(let ((test (mul (make-polynomial 'x '(5))
(make-polynomial 'x '()))))
(assert-equal 'polynomial (car test))
(assert-equal 'x (cadr test))
(assert-equal '(0) (cddr test)))
)
("5 times 0 (2)"
(let ((test (mul (make-polynomial 'x '(5))
(make-polynomial 'x '(0)))))
(assert-equal 'polynomial (car test))
(assert-equal 'x (cadr test))
(assert-equal '(0) (cddr test)))
)
("mul constant"
(let ((test (mul (make-polynomial 'x '(5))
(make-polynomial 'x '(5)))))
(assert-equal 'polynomial (car test))
(assert-equal 'x (cadr test))
(assert-equal '(25) (cddr test)))
)
("normal (6x + 5) * (2x^2 + 3) -> 12x^3 + 10x^2 + 18x + 15"
(let ((test (mul (make-polynomial 'x '(6 5))
(make-polynomial 'x '(2 0 3)))))
(assert-equal 'polynomial (car test))
(assert-equal 'x (cadr test))
(assert-equal '(12 10 18 15) (cddr test)))
)
)
)上記の整理事項含め、バグが沢山。
まず、empty-termlist? は同じでよいはず。がしかし "first (1x - 1x = 0)" な試験にパスしない。=zero? 付近な模様。
あ、違う。neg-terms 付近か。問題 2.88 の書き方が微妙なんだな。empty-termlist? だの the-empty-termlist とかを使ってはイケナイのか。neg-terms での意味としてはリストの末端かどうか、という判定で末端だったら空リストを、という事だし。
という事で neg-terms を以下のように修正。
(define (neg-terms L)
(if (null? L)
'()
(let ((t (first-term L)))
(adjoin-term
(make-term (order t) (- (coeff t)))
(neg-terms (rest-terms L)))))
)で、empty-termlist? は上記の整理事項の通りに。
(define (empty-termlist? term-list)
(define (all-zero? term-list)
(cond ((null? term-list) #t)
((not (= 0 (car term-list))) #f)
(else
(all-zero? (cdr term-list))))
)
(or (null? term-list) (all-zero? term-list)))試験に失敗しているのは乗算の試験のみになりました。コードを見るに 0 な乗算は結果が空リストになりますな。
("0 times 5 (1)"
(let ((test (mul (make-polynomial 'x '())
(make-polynomial 'x '(5)))))
(assert-equal 'polynomial (car test))
(assert-equal 'x (cadr test))
(assert-equal '() (cddr test)))
)
("0 times 5 (2)"
(let ((test (mul (make-polynomial 'x '(0))
(make-polynomial 'x '(5)))))
(assert-equal 'polynomial (car test))
(assert-equal 'x (cadr test))
(assert-equal '() (cddr test)))
)
("5 times 0 (1)"
(let ((test (mul (make-polynomial 'x '(5))
(make-polynomial 'x '()))))
(assert-equal 'polynomial (car test))
(assert-equal 'x (cadr test))
(assert-equal '() (cddr test)))
)
("5 times 0 (2)"
(let ((test (mul (make-polynomial 'x '(5))
(make-polynomial 'x '(0)))))
(assert-equal 'polynomial (car test))
(assert-equal 'x (cadr test))
(assert-equal '() (cddr test)))
)あ、違う。これも通ってない。
("(y + 1)x + (-y - 1)x is zero"
(let ((py1 (make-polynomial 'y '(1 1)))
(py2 (make-polynomial 'y '(-1 -1))))
(assert-true (=zero? (add (make-polynomial 'x (list py1 0))
(make-polynomial 'x (list py2 0))))))
)って現状の実装をリストしてねぇからワケワカだぞ。(とほほ
adjoin-term がクサいか、と思ってたら empty-termlist? だった。
(define (empty-termlist? term-list)
(define (all-zero? term-list)
(cond ((null? term-list) #t)
((not (=zero? (car term-list))) #f)
(else
(all-zero? (cdr term-list))))
)
(or (null? term-list) (all-zero? term-list)))all-zero? ん中のゼロ判定を = でやっとりました。
で、残りが多項式な乗算。
("normal (6x + 5) * (2x^2 + 3) -> 12x^3 + 10x^2 + 18x + 15"
(let ((test (mul (make-polynomial 'x '(6 5))
(make-polynomial 'x '(2 0 3)))))
(assert-equal 'polynomial (car test))
(assert-equal 'x (cadr test))
(assert-equal '(12 10 18 15) (cddr test)))
)(cddr test) が (22 0 33) になっている、との事。うーん、なんとなく
((+ (* 6 2) (* 5 2)) (+ (* 6 0) (* 5 0)) (+ (* 6 3) (* 5 3)))
みたい。加算なソレでしか検討してないからなぁ。adjoin-term がアヤシげ。cons しかしてないし。ここでの乗算の考え方は上記の式をサンプルとすると
(* ((1 6) (0 5)) ((2 2) (0 3))) (+ (f (1 6) ((2 2) (0 3))) (* ((0 5)) ((2 2) (0 3)))) (+ (((1+2) (6*2)) ((1+0) (6*3))) (* ((0 5)) ((2 2) (0 3)))) (+ ((3 12) (1 18)) (* ((0 5)) ((2 2) (0 3))))
adjoin-term で次数を考慮したリストを作るようになってりゃ良いのかな? 上記の
((3 12) (1 18))
なリストは
(12 0 18 0)
にしてくれれば良い。んですがどうすりゃ良いかね。あるいは上記サンプルによるもう一つの乗算は
(* ((0 5)) ((2 2) (0 3))) (((0+2) (5*2)) ((0+0) (5*3))) ((2 10) (0 15)) (10 0 15)
という形に adjoin-term が整形してくれればシアワセ。
その後 (解決)
mul なソレを置き換えながら整理。置き換え大切。
- adjoin-term には同じ次数のソレは渡されないだろう、という勝手読み
- term-list の次数より大きい次数な term が渡されるはず
- 単純に cons ではなく、次数を意識すれば良い
という事で adjoin-term を以下のように修正。試験パス。
(define (adjoin-term term term-list)
(let f ((term term) (term-list term-list))
(if (> (order term) (length term-list))
(f term (cons 0 term-list))
(cons (coeff term) term-list))))最初、条件式を (> (order term) (+ 1 (length term-list))) とかやってました。というか、scheme ってどうやるんだろうか、と思いつつコードを書いてると簡潔に書けてしまうのでいつもびっくりする。上記ももっと簡潔に書けるんじゃなかろうか。
このエントリ、投入するの嫌だなぁ。(とほほほ
ちなみにダウトだったのは
- adjoin-term
- (cons 第一引数 第二引数)
で、ここが一番キモなのに mul なソレをスルーして実装にかかったのが敗因。
一応、試験と実装を以下に。
追記
簡潔に書けそげ。
(define (adjoin-term term term-list)
(let f ((term-list term-list))
(if (> (order term) (length term-list))
(f (cons 0 term-list))
(cons (coeff term) term-list))))動作は確認してません。(を
試験 (test-2.5.3.scm)
#!/usr/bin/env gosh
(use test.unit)
(require "2.5.3")
(define-test-suite "2.5.3"
("2-88"
(setup (lambda ()
(install-scheme-number-package)
(install-polynomial-package)))
("first (1x - 1x = 0)"
(assert-true (=zero? (add (make-polynomial 'x '(1 0))
(neg (make-polynomial 'x '(1 0))))))
)
("2nd (1x - 0 = 1x)"
(let ((p (make-polynomial 'x '(1 0))))
(assert-equal p (add p (neg (make-polynomial 'x '())))))
)
("3rd (1x - 0x = 1x"
(let ((p1 (make-polynomial 'x '(1 0)))
(p0 (make-polynomial 'x '(0 0))))
(assert-equal p1 (add p1 (neg p0))))
)
("4th polynomial neg"
(let ((p1 (make-polynomial 'x '(1 2 3 4)))
(p2 (make-polynomial 'x '(-1 -2 -3 -4))))
(assert-equal p1 (neg p2))
(assert-equal p2 (neg p1)))
)
)
("2-87"
(setup (lambda ()
(install-scheme-number-package)
(install-polynomial-package)))
("() is zero"
(assert-true (=zero? (make-polynomial 'x '())))
)
("() is zero (2)"
(assert-true (=zero? '(polynomial x)))
)
("(0 0 0 0) is zero"
(assert-true (=zero? '(polynomial x 0 0 0 0)))
)
("(y + 1)x + (-y - 1)x is zero"
(let ((py1 (make-polynomial 'y '(1 1)))
(py2 (make-polynomial 'y '(-1 -1))))
(assert-true (=zero? (add (make-polynomial 'x (list py1 0))
(make-polynomial 'x (list py2 0))))))
)
)
("make-polynomial test"
(setup (lambda ()
(install-polynomial-package)))
("car is 'polynomial"
(assert-equal 'polynomial (car (make-polynomial 'var 'terms)))
)
("cadr is var"
(assert-equal 'var (cadr (make-polynomial 'var 'terms)))
)
("cddr is terms"
(assert-equal 'terms (cddr (make-polynomial 'var 'terms)))
)
)
("add test (1)"
(setup (lambda ()
(install-scheme-number-package)
(install-polynomial-package)))
("different variable"
(assert-error (lambda () (add (make-polynomial 'x '(0 5))
(make-polynomial 'y '(0 5)))))
)
("add constant"
(let ((test (add (make-polynomial 'x '(1))
(make-polynomial 'x '(2)))))
(assert-equal 'polynomial (car test))
(assert-equal 'x (cadr test))
(assert-equal '(3) (cddr test)))
)
("result 0"
(let ((test (add (make-polynomial 'x '(0))
(make-polynomial 'x '(0)))))
(assert-equal 'polynomial (car test))
(assert-equal 'x (cadr test))
(assert-equal '(0) (cddr test)))
)
("add 0 to 5 (1)"
(let ((test (add (make-polynomial 'x '(0))
(make-polynomial 'x '(5)))))
(assert-equal 'polynomial (car test))
(assert-equal 'x (cadr test))
(assert-equal '(5) (cddr test)))
)
("add 0 to 5 (2)"
(let ((test (add (make-polynomial 'x '())
(make-polynomial 'x '(5)))))
(assert-equal 'polynomial (car test))
(assert-equal 'x (cadr test))
(assert-equal '(5) (cddr test)))
)
("add 5 to 0 (1)"
(let ((test (add (make-polynomial 'x '(5))
(make-polynomial 'x '(0)))))
(assert-equal 'polynomial (car test))
(assert-equal 'x (cadr test))
(assert-equal '(5) (cddr test)))
)
("add 5 to 0 (2)"
(let ((test (add (make-polynomial 'x '(5))
(make-polynomial 'x '()))))
(assert-equal 'polynomial (car test))
(assert-equal 'x (cadr test))
(assert-equal '(5) (cddr test)))
)
("normal (2x + 3) + (x^2 + x + 2) -> x^2 + 3x + 5"
(let ((test (add (make-polynomial 'x '(2 3))
(make-polynomial 'x '(1 1 2)))))
(assert-equal 'polynomial (car test))
(assert-equal 'x (cadr test))
(assert-equal '(1 3 5) (cddr test)))
)
)
("mul test"
(setup (lambda ()
(install-scheme-number-package)
(install-polynomial-package)))
("different variable"
(assert-error (lambda () (mul (make-polynomial 'x '(5))
(make-polynomial 'y '(5)))))
)
("p1 is not variable"
(assert-error (lambda () (mul (make-polynomial 1 '(5))
(make-polynomial 'x '(5)))))
)
("p2 is not variable"
(assert-error (lambda () (mul (make-polynomial 'x '(5))
(make-polynomial 2 '(5)))))
)
("0 times 5 (1)"
(let ((test (mul (make-polynomial 'x '())
(make-polynomial 'x '(5)))))
(assert-equal 'polynomial (car test))
(assert-equal 'x (cadr test))
(assert-equal '() (cddr test)))
)
("0 times 5 (2)"
(let ((test (mul (make-polynomial 'x '(0))
(make-polynomial 'x '(5)))))
(assert-equal 'polynomial (car test))
(assert-equal 'x (cadr test))
(assert-equal '() (cddr test)))
)
("5 times 0 (1)"
(let ((test (mul (make-polynomial 'x '(5))
(make-polynomial 'x '()))))
(assert-equal 'polynomial (car test))
(assert-equal 'x (cadr test))
(assert-equal '() (cddr test)))
)
("5 times 0 (2)"
(let ((test (mul (make-polynomial 'x '(5))
(make-polynomial 'x '(0)))))
(assert-equal 'polynomial (car test))
(assert-equal 'x (cadr test))
(assert-equal '() (cddr test)))
)
("mul constant"
(let ((test (mul (make-polynomial 'x '(5))
(make-polynomial 'x '(5)))))
(assert-equal 'polynomial (car test))
(assert-equal 'x (cadr test))
(assert-equal '(25) (cddr test)))
)
("normal (6x + 5) * (2x^2 + 3) -> 12x^3 + 10x^2 + 18x + 15"
(let ((test (mul (make-polynomial 'x '(6 5))
(make-polynomial 'x '(2 0 3)))))
(assert-equal 'polynomial (car test))
(assert-equal 'x (cadr test))
(assert-equal '(12 10 18 15) (cddr test)))
)
)
)
実装 (2.5.3.scm)
(define (install-polynomial-package)
(define (adjoin-term term term-list)
(let f ((term term) (term-list term-list))
(if (> (order term) (length term-list))
(f term (cons 0 term-list))
(cons (coeff term) term-list))))
(define (the-empty-termlist) '())
(define (first-term term-list)
(if (null? term-list)
term-list
(list (- (length term-list) 1) (car term-list))))
(define (rest-terms term-list) (cdr term-list))
(define (empty-termlist? term-list)
(define (all-zero? term-list)
(cond ((null? term-list) #t)
((not (=zero? (car term-list))) #f)
(else
(all-zero? (cdr term-list))))
)
(or (null? term-list) (all-zero? term-list)))
(define (make-term order coeff) (list order coeff))
(define (order term) (car term))
(define (coeff term) (cadr term))
(define (make-poly variable term-list)
(cons variable term-list))
(define (variable p) (car p))
(define (term-list p) (cdr p))
(define (variable? x) (symbol? x))
(define (same-variable? v1 v2)
(and (variable? v1) (variable? v2) (eq? v1 v2)))
(define (add-poly p1 p2)
(if (same-variable? (variable p1) (variable p2))
(make-poly (variable p1)
(add-terms (term-list p1)
(term-list p2)))
(error "Polys not in same var --- ADD-POLY"
(list p1 p2))))
(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
t1 (add-terms (rest-terms L1) L2)))
((< (order t1) (order t2))
(adjoin-term
t2 (add-terms L1 (rest-terms L2))))
(else
(adjoin-term
(make-term (order t1)
(add (coeff t1) (coeff t2)))
(add-terms (rest-terms L1)
(rest-terms L2)))))))))
(define (mul-poly p1 p2)
(if (same-variable? (variable p1) (variable p2))
(make-poly (variable p1)
(mul-terms (term-list p1)
(term-list p2)))
(error "Polys not in same var --- MUL-POLY"
(list p1 p2))))
(define (mul-terms L1 L2)
(if (empty-termlist? L1)
(the-empty-termlist)
(add-terms (mul-term-by-all-terms (first-term L1) L2)
(mul-terms (rest-terms L1) L2))))
(define (mul-term-by-all-terms t1 L)
(if (empty-termlist? L)
(the-empty-termlist)
(let ((t2 (first-term L)))
(adjoin-term
(make-term (+ (order t1) (order t2))
(mul (coeff t1) (coeff t2)))
(mul-term-by-all-terms t1 (rest-terms L))))))
(define (neg-poly p)
(make-poly (variable p)
(neg-terms (term-list p))))
(define (neg-terms L)
(if (null? L)
'()
(let ((t (first-term L)))
(adjoin-term
(make-term (order t) (- (coeff t)))
(neg-terms (rest-terms L)))))
)
(define (tag p) (attach-tag 'polynomial p))
(put '=zero? '(polynomial)
(lambda (p) (empty-termlist? (term-list p))))
(put 'neg '(polynomial)
(lambda (p) (tag (neg-poly p))))
(put 'add '(polynomial polynomial)
(lambda (p1 p2) (tag (add-poly p1 p2))))
(put 'mul '(polynomial polynomial)
(lambda (p1 p2) (tag (mul-poly p1 p2))))
(put 'make 'polynomial
(lambda (var terms) (tag (make-poly var terms))))
'done)
(define (make-polynomial var terms)
((get 'make 'polynomial) var terms))
(define (neg x) (apply-generic 'neg x))上記実装は scheme-number-package 等の記述を略しています。
