SICP 読み (112) 3.3.3 表の表現
ついこちら方面に手を伸ばしてしまう、月曜朝イチ。(を
問題 3.25
とは言え、前回エントリにて書いた通り、解はなんとなく出てきてます。多分何らかの修正が必要なんでしょうが、とりあえず試験を書かないと話にならない。
確認事項としては以下でしょうか。
- 3.3.3 にて例示されていた局所表としての機能を満足している事
- 同じ式で一次元の表にも二次元の表にもアクセス可能である事
- 任意個数のキーが混在している表の動作の確認
で、前回エントリにてでっちあげた試験を流用。一応キー二つで equal? 使うヤツでは以下の試験にパスしています。
#!/usr/bin/env gosh
(use test.unit)
(require "3.25")
(define-test-suite "3.25"
("get & put"
("error"
(let ((p (make-table)))
(let ((get (p 'lookup-proc)))
(assert-error (lambda () (get 'xxx)))))
)
("get no elements"
(let ((p (make-table)))
(let ((get (p 'lookup-proc)))
(assert-false (get 'math '+))))
)
("put & get"
(let ((p (make-table)))
(let ((put (p 'insert-proc!))
(get (p 'lookup-proc)))
(put 'math '+ 3)
(assert-equal 3 ((p 'lookup-proc) 'math '+))))
)
("get invalid"
(let ((p (make-table)))
(let ((put (p 'insert-proc!))
(get (p 'lookup-proc)))
(put 'math '+ 3)
(assert-false (get 'math '-))))
)
("Figure 3.23"
(let ((p (make-table)))
(let ((put (p 'insert-proc!))
(get (p 'lookup-proc)))
(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 がいくつか。検索キーが list になるんだった。(ため息
つづき
あ、駄目だ。insert! なソレが全然ダメ。こんなコトしてる
(set-cdr! t (cons (begin (set-cdr! k value) k) (cdr t)))
ってか最初はもっと酷かった。assoc で偽が戻っているはずの subtable に set-cdr! してました。やっぱりあまりきちんと検討できてませんな。
セボネに挿入、なのは分かってるんですが easy に考えスギ。
さらにつづき
で、insert! なソレをなんとか修正して試験してみたんですが、まだダメ。lookup も微妙らしい。で色々見てると再帰呼び出しのトコで
(f (cdr k) (cdr subtable)))
なコトしていた。とほほ。これでようやく上記な試験が通った。リファクタリングな余地十分ですが、とりあえず以下が実装。
(define (make-table)
(let ((local-table (list '*table*)))
(define (assoc key records)
(cond ((null? records) #f)
((equal? key (caar records)) (car records))
(else
(assoc key (cdr records)))))
(define (lookup keylist)
(let f ((k keylist) (t local-table))
(let ((subtable (assoc (car k) (cdr t))))
(if subtable
(if (null? (cdr k))
(cdr subtable)
(f (cdr k) subtable))
#f))))
(define (make-insert-backbone keylist v)
(define (make-insert-backbone-iter k v)
(let ((ret (cons '() '())))
(set-car! ret (car k))
(if (null? (cdr k))
(begin (set-cdr! ret v)
ret)
(begin (set-cdr! ret (cons '() '()))
(set-car! (cdr ret)
(make-insert-backbone-iter (cdr k) v))
ret))))
(make-insert-backbone-iter keylist v)
)
(define (insert! keylist value)
(let f ((k keylist) (t local-table))
(let ((subtable (assoc (car k) (cdr t))))
(if subtable
(if (null? (cdr k))
(set-cdr! subtable value)
(f (cdr k) (cdr subtable)))
(set-cdr! t
(cons (make-insert-backbone k value)
(cdr t))))))
'ok)
(define (dispatch m)
(cond ((eq? m 'lookup-proc) lookup)
((eq? m 'insert-proc!) insert!)
(else (error "Unknown operation -- TABLE" m))))
dispatch))もう少し追加な試験が必要。一応試験は全部サラしときます。
#!/usr/bin/env gosh
(use test.unit)
(require "3.25")
(define-test-suite "3.25"
("get & put"
("error"
(let ((p (make-table)))
(assert-error (lambda () (p 'xxxxx))))
)
("get no elements"
(let ((p (make-table)))
(let ((get (p 'lookup-proc)))
(assert-false (get '(math +)))))
)
("put & get"
(let ((p (make-table)))
(let ((put (p 'insert-proc!))
(get (p 'lookup-proc)))
(put '(math +) 3)
(assert-equal 3 (get '(math +)))))
)
("get invalid"
(let ((p (make-table)))
(let ((put (p 'insert-proc!))
(get (p 'lookup-proc)))
(put '(math +) 3)
(assert-false (get '(math -)))))
)
("Figure 3.23"
(let ((p (make-table)))
(let ((put (p 'insert-proc!))
(get (p 'lookup-proc)))
(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 /)))))
)
)
("Exercise 3.25"
("one dimensional"
(let ((p (make-table)))
(let ((put (p 'insert-proc!))
(get (p 'lookup-proc)))
(put '(a) 1)
(put '(b) 2)
(put '(c) 3)
(assert-equal 1 (get '(a)))
(assert-equal 2 (get '(b)))
(assert-equal 3 (get '(c)))
(assert-false (get '(d)))))
)
("tow-dimensional"
;; Figure 3.23
)
("mixed"
(let ((p (make-table)))
(let ((put (p 'insert-proc!))
(get (p 'lookup-proc)))
(put '(a) 1)
(put '(b) 2)
(put '(c) 3)
(put '(letters b) 98)
(put '(letters a) 97)
(put '(math *) 42)
(put '(math -) 45)
(put '(math +) 43)
(assert-equal 1 (get '(a)))
(assert-equal 43 (get '(math +)))
(assert-equal 97 (get '(letters a)))
(assert-equal 42 (get '(math *)))
(assert-equal 2 (get '(b)))
(assert-equal 98 (get '(letters b)))
(assert-equal 45 (get '(math -)))
(assert-equal 3 (get '(c)))
(assert-false (get '(d)))
(assert-false (get '(math /)))
(assert-false (get '(letters c)))))
)
)
)もう少し insert! なソレを見直す必要あり。
# ちなみに月曜朝イチから今までずっとこれにかかりきり、な訳では (以下略
さらにさらに
と言いつつ、エントリを入れかけて、以下の試験を追加してみたら通らん。
(put '(a b c) 50) (put '(a b d) 51) (put '(a c b) 60) (put '(a b c d) 70) (assert-equal 70 (get '(a b c d))) (assert-equal 51 (get '(a b d))) (assert-equal 60 (get '(a c b))) (assert-equal 50 (get '(a b c)))
むむ、と言いつつ gosh で見てみるとキーの並びが同じにも関わらず、集約されていないのを発見。まさか、と思いつつ insert! を見ると lookup と同じ間違いが残っていた。(とほほほほ
insert! は正しくは以下。
(define (insert! keylist value)
(let f ((k keylist) (t local-table))
(let ((subtable (assoc (car k) (cdr t))))
(if subtable
(if (null? (cdr k))
(set-cdr! subtable value)
(f (cdr k) subtable))
(set-cdr! t
(cons (make-insert-backbone k value)
(cdr t))))))
'ok)まだまだ試験が足らないとか、リファクタリングがナニ、という部分満載な気がしています。この 3.3.3 あたりの問題はじっくり時間をかけておきたいな、と。
む
エントリの実装をコピッて試験してみたらパスしない。おかしいな、と言いつつ見てみると追加してみた試験の記述が微妙な事が分かる。確かにあれでは駄目ッス。追加な記述のソレを以下に。
(put '(e b c) 50) (put '(e b d) 51) (put '(e c b) 60) (put '(f b c d) 70) (assert-equal 70 (get '(f b c d))) (assert-equal 51 (get '(e b d))) (assert-equal 60 (get '(e c b))) (assert-equal 50 (get '(e b c)))
で、ようやく見直し着手。
