SICP 読み (111) 3.3.3 表の表現

稼働が取れず、rails なソレの作業は進捗せず。長い会議に局所表なソースを印刷して眺めてたら問題 3.25 の解が出てきた。紙の上で考える、という部分で scheme って良い道具だなぁ、と。
で、とりあえず例示されている局所表なソレの試験を書いてみる。

とりあえずでっち上げてみたのが以下。

#!/usr/bin/env gosh

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

(define-test-suite "3.3.3"

  ("get & put"
   ("get no elements"
    (assert-false (get 'math '+))
    )
   )

)

当たり前ですがパスします。どんどん書く。

   ("put & get"
    (put 'math '+ 3)
    (assert-equal 3 (get 'math '+))
    )

   ("get invalid"
    (put 'math '+ 3)
    (assert-false (get 'math '-))
    )

図 3.23 のソレを用意してみる。

   ("Figure 3.23"
    (put 'letters 'b 98)
    (put 'letters 'a 97)
    (put 'math '* 42)
    (put 'math '- 45)
    (put 'math '+ 43)
    (assert-equal 98 (get 'letters 'b))
    (assert-equal 97 (get 'letters 'a))
    (assert-equal 42 (get 'math '*))
    (assert-equal 45 (get 'math '-))
    (assert-equal 43 (get 'math '+))
    (assert-false (get 'xxx 'yyy))
    (assert-false (get 'letters 'c))
    (assert-false (get 'math '/))
    )

こんなカンジで勘弁して下さひ。あ、エラーなソレもあるな。

   ("error"
    (assert-error (lambda () ((operation-table 'xxx))))
    )

問題 3.24

で、上記のソレを元に解を検討。基本的に上記の試験は通用しないな。(を
仕方無いんで get だの put だのを使わない方向で試験を検討するか。と言いつつ、なるべく試験を変えない方向で上記な試験を以下のように修正。

#!/usr/bin/env gosh

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

(define-test-suite "3.3.3"

  ("get & put"
   ("error"
    (let ((p (make-table equal?)))
      (let ((get (p 'lookup)))
	(assert-error (lambda () (get 'xxx)))))
    )

   ("get no elements"
    (let ((p (make-table equal?)))
      (let ((get (p 'lookup)))
	(assert-false (get 'math))))
    )

   ("put & get"
    (let ((p (make-table equal?)))
      (let ((put (p 'insert-proc!))
	    (get (p 'lookup)))
	(put 'math '+ 3)
	(assert-equal 3 ((p 'lookup) 'math '+))))
    )

   ("get invalid"
    (let ((p (make-table equal?)))
      (let ((put (p 'insert-proc!))
	    (get (p 'lookup)))
	(put 'math '+ 3)
	(assert-false (get 'math '-))))
    )

   ("Figure 3.23"
    (let ((p (make-table equal?)))
      (let ((put (p 'insert-proc!))
	    (get (p 'lookup)))
	(put 'letters 'b 98)
	(put 'letters 'a 97)
	(put 'math '* 42)
	(put 'math '- 45)
	(put 'math '+ 43)
	(assert-equal 98 (get 'letters 'b))
	(assert-equal 97 (get 'letters 'a))
	(assert-equal 42 (get 'math '*))
	(assert-equal 45 (get 'math '-))
	(assert-equal 43 (get 'math '+))
	(assert-false (get 'xxx 'yyy))
	(assert-false (get 'letters 'c))
	(assert-false (get 'math '/))))
    )
   )
)

で、試験に通らない。なんでかね、と頭をヒネっていた。make-table への手続きの渡し方が悪いんだとばかり思ってたら、assoc が以下のようになっていた。

    (define (assoc key records)
      (cond ((null? records) #f)
	    ((same-key? key (cdr records)) (car records))
	    (else
	     (assoc key (cdr records)))))

これで随分時間を喰った。なんか力抜けた。どんな試験書けばええのかも微妙。あ、なんかソレっぽい手続きで判定すればええのか。で、でっち上がったのが以下の試験。

  ("3.24"
   ("get no elements"
    (let ((same-key? (lambda (x y)
		       (cond ((equal? x y) #t)
			     ((and (number? x) (number? y))
			      (cond ((and (<= (- x 5) y) (>= (+ x 5) y)) #t)
				    (else #f)))
			     (else #f)))))
      (let ((p (make-table same-key?)))
	(let ((put (p 'insert-proc!))
	      (get (p 'lookup-proc)))
	  (assert-error (lambda () ((p 'xxx))))
	  (assert-false (get 'math '+))
	  (assert-equal 'ok (put 'xxx 1 5))
	  (assert-equal 'ok (put 'xxx 13 10))
	  (assert-equal 'ok (put 'yyy 28 50))
	  (assert-equal 5 (get 'xxx 1))
	  (assert-equal 5 (get 'xxx 2))
	  (assert-equal 5 (get 'xxx 3))
	  (assert-equal 5 (get 'xxx 4))
	  (assert-equal 5 (get 'xxx 5))
	  (assert-equal 5 (get 'xxx 6))
	  (assert-false (get 'xxx 7))
	  (assert-equal 10 (get 'xxx 8))
	  (assert-equal 10 (get 'xxx 9))
	  (assert-equal 10 (get 'xxx 10))
	  (assert-equal 10 (get 'xxx 11))
	  (assert-equal 10 (get 'xxx 12))
	  (assert-equal 10 (get 'xxx 13))
	  (assert-equal 10 (get 'xxx 14))
	  (assert-equal 10 (get 'xxx 15))
	  (assert-equal 10 (get 'xxx 16))
	  (assert-equal 10 (get 'xxx 17))
	  (assert-equal 10 (get 'xxx 18))
	  (assert-false (get 'xxx 19))
	  (assert-false (get 'yyy 22))
	  (assert-equal 50 (get 'yyy 23))
	  (assert-equal 50 (get 'yyy 24))
	  (assert-equal 50 (get 'yyy 25))
	  (assert-equal 50 (get 'yyy 26))
	  (assert-equal 50 (get 'yyy 27))
	  (assert-equal 50 (get 'yyy 28))
	  (assert-equal 50 (get 'yyy 29))
	  (assert-equal 50 (get 'yyy 30))
	  (assert-equal 50 (get 'yyy 31))
	  (assert-equal 50 (get 'yyy 32))
	  (assert-equal 50 (get 'yyy 33))
	  (assert-false (get 'yyy 34))
	  )))
    )
   )

たぶんこれであってると思う。で、会議中にできた手続きは別エントリにて。試験をさくっと書ければ良いのですが ...
# 上記のような試験しか書けんのでは微妙と言わざるを得ません。

DRY 則完全違反。(とほほほほ

追記

何故境界のみ試験、ってソレではないのか、自分で作っておきながら不思議。