テーブルを作成するところです!
テーブルといっても,perl でいう 2 次元ハッシュですね.
その実装は SICP にはっきりばっちり書いてあるんですけど,問題 3-24 はそのテーブルに,c++ とか java みたく,キーの比較関数を与えられるようにしてねーって問題です.
中で,assoc を再定義してみた.
(define (make-table same-key?) (let ((local-table (list '*table*))) (define (assoc key records) (cond ((null? records) #f) ((same-key? key (caar records)) (car records)) (else (assoc key (cdr records))))) (define (lookup key-1 key-2) (let ((subtable (assoc key-1 (cdr local-table)))) (if subtable (let ((record (assoc key-2 (cdr subtable)))) (if record (cdr record) #f)) #f))) (define (insert! key-1 key-2 value) (let ((subtable (assoc key-1 (cdr local-table)))) (if subtable (let ((record (assoc 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 (dispatch m) (cond ((eq? m 'lookup-proc) lookup) ((eq? m 'insert-proc!) insert!) (else (error "Unknown operation -- TABLE" m)))) dispatch))
四捨五入したあと比較を行う比較関数を作って,テストしてみる.
(define (round-equal? x y) (= (round x) (round y))) (define table (make-table round-equal?)) (define lookup (table 'lookup-proc)) (define insert! (table 'insert-proc!)) (insert! 1.1 1.11 111) (insert! 2.2 2.22 222) (insert! 3.3 3.33 333) (lookup 1.4 1.46) ; 111 (lookup 2.1 2.55) ; #f