SICP 読み (82) 2.5.3 例: 記号代数

問題 2.90

試験を作りながら実装を組み立ててみる。試験ドリブンな現実トウヒ。

最初の試験

まず、以下の試験をでっち上げた。

#!/usr/bin/env gosh

(use test.unit)
(require "2.5.3")

(define-test-suite "2.5.3"
 ("install package"
  ("polynomial package"
   (assert-equal 'done (install-polynomial-package))
   )

  ("sparse termlist"
   (assert-equal 'done (install-sparse-termlist))
   )

  ("dense termlist"
   (assert-equal 'done (install-dense-termlist))
   )
  )
 )

という事は、実装に以下を追加、です。

(define (install-sparse-termlist)
 'done)

(define (install-dense-termlist)
 'done)

こんな試験、してなかったな。

make-poly ガラミ

次はどうするか。直前エントリで思いついた make-poly なソレか。手続きの名前は make-sparse-polynomial と make-dense-polynomial で良いか。項リストに付けるタグは sparse と dense として以下かな??
(追加分のみ)

 ("make polynomial"
  ("make-sparse-polynomial"
   (assert-equal '(polynomial x (sparse 1 2 3 4 5))
                 (make-sparse-polynomial 'x '(1 2 3 4 5)))
   )

  ("make-dense-polynomial"
   (assert-equal '(polynomial x (dense (10 1) (0 1)))
                 (make-dense-polynomial 'x '((10 1) (0 1))))
   )
  )

ちょっと間違えてるかも例えば sparse なソレだと

'(polynomial x sparse 1 2 3 4 5)

とかになるかなぁ。それっぽい気がする。dense だと

'(polynomial x dense (10 1) (0 1))

か。試験は上記の通り修正しておくとして、実装を検討。

こんな感じですか (一部のみ)

 (put 'make 'polynomial
      (lambda (var terms f) (tag (make-poly var (attach-tag f terms)))))
 'done)

(define (make-sparse-polynomial var terms)
 ((get 'make 'polynomial) var terms 'sparse)
 )
(define (make-dense-polynomial var terms)
 ((get 'make 'polynomial) var terms 'dense)
 )

を、通った。すげー。

って今気がついたんですが、試験のてっぺんで install な試験してると、それ以降の試験では setup で install-なんたら-package ってしなくて良いのか。端末上でも

$ test/run-test.scm -vv
- (test suite) 2.5.3
-- (test case) install package: ...
-- (test case) make polynomial: ..

5 tests, 5 assertions, 5 successes, 0 failures, 0 errors
Testing time: 6.609999999999999e-4
$

って出てるんで一番上が一番最初に評価されるんだろな。これはこれは。

termlist な試験

それは良いとして、make-poly が通ったという事は中身なソレを検討せねばいかんのね、と思ってたら、sparse-termlist だの dense-termlist だのというパケジについては、polynomial なパケジん中で定義されていれば良くって、別にトップレベルで定義されていなくて良いのかなぁ。トップレベルで定義されてた方が試験をし易くはあるんですが。
ま、いいか、とりあえずインターフェースは中で定義して試験し易くしておく。まず、直前エントリで_楽そげ_と書いた

  • first-term
  • rest-terms
  • empty-termlist?

からイキます。install-なんちゃら-package がトップレベルにあるので試験が楽。
試しに sparse な first-term を実装してみた。まず試験。

 ("sparse-termlist (1)"
  ("first-term"
   (assert-equal '(0 5)
                 (apply-generic 'first-term '(sparse 5)))
   (assert-equal '(5 3)
                 (apply-generic 'first-term '(sparse 3 4 5 6 7 8)))
   )

  ("rest-terms"
   )

  ("empty-termlist?"
   )
  )

試験として微妙なカンジ満載ですがスルー。実装が以下。

(define (install-sparse-termlist)
 (define (first-term term-list)
   (if (null? term-list)
       term-list
       (list (- (length term-list) 1) (car term-list))))
 (put 'first-term '(sparse)
      (lambda (t) (first-term t)))
 'done)

試験パス。一人 XP はまだまだ続く。次は sparse な rest-terms の試験。

  ("rest-terms"
   (assert-equal '(sparse) (apply-generic 'rest-terms '(sparse 5)))
   (assert-equal '(sparse 4 5 6 7 8)
                 (apply-generic 'rest-terms '(sparse 3 4 5 6 7 8)))
   )

もう一つ、sparse な empty-termlist? も。

  ("empty-termlist?"
   (assert-true (apply-generic 'empty-termlist? '(sparse)))
   (assert-true (apply-generic 'empty-termlist? '(sparse 0 0 0)))
   (assert-false (apply-generic 'empty-termlist? '(sparse 1)))
   )

実装が以下。(該当部分のみ)

 (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)))

 (put 'rest-terms '(sparse)
      (lambda (t) (tag (rest-terms t))))
 (put 'empty-termlist? '(sparse)
      (lambda (t) (empty-termlist? t)))

=zero? があるんで install-scheme-number-package しとかんと駄目だな。最初の test case な setup で install しとく事に。で、試験してみたのですが、define と put
の順番って守らないとイカンみたい。あと、tag な手続きを定義するの忘れてました。

 (define (tag t) (attach-tag 'sparse t))

という不具合を経て試験はパス。


term 関連は polynomial なパケジに纏めるとして、あとは the-empty-termlist と adjoin-term を盛り込めばデキ上がりっぽいな。先に試験か。って the-empty-termlist は微妙だなぁ。

  ("the-empty-termlist"
   (assert-true (apply-generic 'empty-termlist? (sparse-empty-termlist)))
   (assert-equal '(sparse) (sparse-empty-termlist))
   )

  ("adjoin-term"
   (assert-equal '(2 3 4)
                 ((apply-generic 'adjoin-term '(sparse 3 4)) '(2 2)))
   (assert-equal '(2 0 0)
                 ((apply-generic 'adjoin-term '(sparse)) '(2 2)))
   (assert-equal '(2 0 1 0)
                 ((apply-generic 'adjoin-term '(sparse 1 0)) '(3 2)))
   )

で、実装が以下 (例によって該当部分のみ)

 (define (the-empty-termlist)
   '()
   )
 (define (adjoin-term term term-list)
   (lambda (term)
     (let f ((term-list term-list))
       (if (> (order term) (length term-list))
           (f (cons 0 term-list))
           (cons (coeff term) term-list)))))

 (put 'the-empty-termlist 'sparse
      (lambda () (tag (the-empty-termlist))))
 (put 'adjoin-term '(sparse)
      (lambda (t) (adjoin-term t)))

で試験。エラーが 2 個。adjoin-term で失敗している模様。
order という手続きが定義されてない、と。そりゃそうだ。polynomial なソレん中だけで有効だものなぁ。上で書いた term 関連の手続きは云々はダウトですな。どうしたものか。対応としては

  • adjoin-term の中で定義する
  • パケジにしてしまう

二番目の方が正解な気がするんですがインパクトでかくないですか? あ、まだ作りかけですから大丈夫ですかそうですか。今まで書いた試験で term を使ってるのは

  • first-term
  • adjoin-term

くらいですか。最初の試験にも追加が必要ですな。

term 関連

install な試験

  ("term"
   (assert-equal 'done (install-term-package))
   )

実装

(define (install-term-package)
 'done)

パス。term 関連の試験。

 ("term"
  ("make-term"
   (assert-equal 'term (car (make-term 1 2)))
   (assert-equal 1 (cadr (make-term 1 2)))
   (assert-equal 2 (caddr (make-term 1 2)))
   )

  ("order"
   (assert-equal 2 (apply-generic 'order '(term 2 1)))
   )

  ("coeff"
   (assert-equal 1 (apply-generic 'coeff '(term 2 1)))
   )
  )

実装。

(define (install-term-package)
 (define (make-term order coeff) (list order coeff))
 (define (order term) (car term))
 (define (coeff term) (cadr term))
 (define (tag t) (attach-tag 'term t))

 (put 'make 'term
      (lambda (order coeff) (tag (make-term order coeff))))
 (put 'order '(term)
      (lambda (t) (order t)))
 (put 'coeff '(term)
      (lambda (t) (coeff t)))
 'done)
(define (make-term order coeff)
 ((get 'make 'term) order coeff))

こっちの試験はパスしました。sparse 側の不具合除去に着手。

リトライ

term ガラミがパケジになったので追従。あと sparse-empty-termlist な手続きも未定義なのでその対応も。まず、first-term の試験修正。assert いっこ追加。

  ("first-term"
   (assert-equal '()
                 (apply-generic 'first-term '(sparse)))
   (assert-equal '(term 0 5)
                 (apply-generic 'first-term '(sparse 5)))
   (assert-equal '(term 5 3)
                 (apply-generic 'first-term '(sparse 3 4 5 6 7 8)))
   )

空の term-list の first-term は '() で良いのだろうか。若干微妙。で実装が以下。

 (define (first-term term-list)
   (if (null? term-list)
       term-list
       (make-term (- (length term-list) 1) (car term-list))))

一応大丈夫なカンジです。次は sparse-empty-termlist の実装。トップレベルにて以下の定義を追加。

(define (sparse-empty-termlist)
 ((get 'the-empty-termlist 'sparse)))

括弧多いなぁ。試験はパスしてました。最後に 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)))
   )

で、試験したんですが失敗。order がネェ、と叱られる。トップレベルに以下の手続きを定義。

(define (order term) (apply-generic 'order term))
(define (coeff term) (apply-generic 'coeff term))

これでようやく試験パス。トップレベルに以下の定義も追加。これは polynomial にて使用なので試験は別途。

(define (first-term term-list) (apply-generic 'first-term term-list))
(define (rest-terms term-list) (apply-generic 'first-term term-list))
(define (empty-termlist? term-list) (apply-generic 'empty-termlist? term-list))
(define (adjoin-term term-list) (apply-generic 'adjoin-term term-list))

む。トップレベルじゃなくて polynomial なパケジの中で良いのかな。ちょっと修正。sparse-empty-termlist も polynomial なナニに隠蔽という事で試験を以下のように。

  ("the-empty-termlist"
   (assert-true (apply-generic 'empty-termlist? 
			       ((get 'the-empty-termlist 'sparse))))
   (assert-equal '(sparse) ((get 'the-empty-termlist 'sparse)))
   )

上記の手続き定義 (first-term 〜 adjoin-term) も polynomial なパケジの中に封印。

sparse な polynomial の試験

polynomial なソレに上記の手続き定義を盛り込んで、adjoin-term の呼び出しを修正する必要あり。てか、その前に試験か。って、簡単な試験を書いて動かしてみると、adjoin-term の引数が云々、と言われ動かん。先に直しといた方が良さげ。

と言いつつ以下のような試験を作成して動かしてみると通らなひ。

   ("add"
    (assert-equal '(polynomial x sparse 3 2 4)
		  (add (make-sparse-polynomial 'x '(2 1 2))
		       (make-sparse-polynomial 'x '(1 1 2))))
    )

端末に出力されるナニは以下のようなカンジ。

$ test/run-test.scm -vv
- (test suite) 2.5.3
-- (test case) install package: ....
-- (test case) term: ...
-- (test case) make polynomial: ..
-- (test case) sparse-termlist (1): .....
-- (test case) sparse polynomial operation: E
./lib/2.5.3.scm:65: (apply-generic 'empty-termlist? term-list)
Error occurred in add
*** ERROR: No method for these types -- APPLY-GENERIC (empty-termlist? (term))
./lib/2.5.3.scm:65: (apply-generic 'empty-termlist? term-list)
...

18 tests, 25 assertions, 24 successes, 0 failures, 1 errors
Testing time: 0.0029649999999999998
$

む。(term) って何?
ってか、何かやってる事が整合してない感満点。ちょっと正気に戻ってきちんと見直す必要ありです。スデに限界。(弱