Chat (Lingr.com)
Informaiton
Daily
Column
- MySQL日本語の旅(5/1)
- アクセス向上秘伝(5/9)
- 一風変ったHaskellλ門(6/13)
- SICP Answer Book (5/31) 問題3.26追加
Zope Solution
Extra
アーカイブ
OSS案内所
Site Info
関連リンク
##(link2sicp "book-Z-H-22.html#%_thm_3.24" "Exercise 3.24")
解答例
(define (make-table same-key?)
(let ((local-table (list '*table*)))
(define (assok f key assoc-list)
(cond ((null? assoc-list) false)
((f key (caar assoc-list)) (car assoc-list))
(else (assok f key (cdr assoc-list)))))
(define (lookup key-1 key-2)
(let ((subtable (assok same-key? key-1 (cdr local-table))))
(if subtable
(let ((record (assok same-key? key-2 (cdr subtable))))
(if record
(cdr record)
false))
false)))
(define (insert! key-1 key-2 value)
(let ((subtable (assok same-key? key-1 (cdr local-table))))
(if subtable
(let ((record (assok same-key? key-2 (cdr subtable))))
(if record
(set-cdr! record value)
(set-cdr! subtable
(cons (cons key-2 value)
(cdr subtable)))))
(set-cdr! local-table
(cons (list key-1
(cons key-2 value))
(cdr local-table)))))
'ok)
(define (show-local-table) local-table)
(define (dispatch m)
(cond ((eq? m 'lookup-proc) lookup)
((eq? m 'insert-proc!) insert!)
((eq? m 'show-table-proc) show-local-table)
(else (error "Unknown operation -- TABLE" m))))
dispatch))
実行例
gosh> (define (almost-same? x y range) (>= range (abs (- x y)))) almost-same? gosh> (define (same-key? x y) (almost-same? x y 3)) same-key? gosh> (define q (make-table same-key?)) q gosh> (define lookup (q 'lookup-proc)) lookup gosh> (define insert! (q 'insert-proc!)) insert! gosh> (define show (q 'show-table-proc)) show gosh> (insert! 10 10 '10x10) ok gosh> (insert! 10 15 '10x15) ok gosh> (insert! 10 20 '10x20) ok gosh> (insert! 15 10 '15x10) ok gosh> (insert! 15 15 '15x15) ok gosh> (insert! 15 20 '15x20) ok gosh> (insert! 20 10 '20x10) ok gosh> (insert! 20 15 '20x20) ok gosh> (insert! 20 20 '20x20) ok gosh> (show) (*table* (20 (20 . |20x20|) (15 . |20x20|) (10 . |20x10|)) (15 (20 . |15x20|) (1 5 . |15x15|) (10 . |15x10|)) (10 (20 . |10x20|) (15 . |10x15|) (10 . |10x10|))) gosh> (lookup 12 9) |15x10| gosh> (lookup 9 17) |10x20| gosh> (lookup 23 17) |20x20| gosh> (lookup 24 25) #f gosh> (insert! 7 7 '7x7) ok gosh> (lookup 10 10) |7x7| gosh> (insert! 23 17 '23x17) ok gosh> (lookup 20 20) |23x17| gosh> (show) (*table* (20 (20 . |23x17|) (15 . |20x20|) (10 . |20x10|)) (15 (20 . |15x20|) (1 5 . |15x15|) (10 . |15x10|)) (10 (20 . |10x20|) (15 . |10x15|) (10 . |7x7|)))
--hidenao
コード
##(sicp-answer-code "ex-3.24.scm")
