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 則完全違反。(とほほほほ
追記
何故境界のみ試験、ってソレではないのか、自分で作っておきながら不思議。