問題3.24-3.25
二次元表、多次元表の実装です。
3.24
(define (make-table same-key?) (let ((local-table (list '*table*))) (define (assoc key records) (cond ((null? records) false) ((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) false)) flase))) (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) lookup) ((eq? m 'insert) insert!) (else (error "Unknown operation -- TABLE" m)))) dispatch)) > (define t1 (make-table (lambda (x y) (cond ((pair? x) (equal? x y)) ((symbol? x) (eq? x y)) ((and (number? x) (number? y)) (and (<= (- y 0.5) x) (< x (+ y 0.5)))) (else false))))) > ((t1 'insert) 'food 0 'apple) ok > ((t1 'insert) 'food 1 'orange) ok > ((t1 'lookup) 'food 0.5) orange > ((t1 'lookup) 'food 0.4999999) apple
与えられたkeyが数値なら、四捨五入して同じ値なら同じとみなす場合。
3.25
ややこしいけど、keyをリストとしてとり、insert!とlookup!を再帰的な手続きにがんばってする。
(define (make-table) (let ((local-table (list '*table*))) (define (assoc key records) (cond ((null? records) false) ((equal? key (caar records)) (car records)) (else (assoc key (cdr records))))) (define (lookup key-list) (define (iter key-list table) (let ((subtable (assoc (car key-list) table))) (if subtable (if (null? (cdr key-list)) (cdr subtable) (iter (cdr key-list) (cdr subtable))) false))) (if (null? key-list) false (iter key-list (cdr local-table)))) (define (insert! key-list value) (define (iter2 key-list table) (cond ((null? key-list) (set-cdr! table value)) (else (set-cdr! table (cons (list (car key-list)) (cdr table))) (iter2 (cdr key-list) (cadr table))))) (define (iter key-list table) (let ((subtable (assoc (car key-list) (cdr table)))) (if (not (eq? subtable false)) (cond ((null? (cdr key-list)) (set-cdr! subtable value)) (else (iter (cdr key-list) subtable))) (iter2 key-list table)))) (iter key-list local-table) 'ok) (define (disp) local-table) (define (dispatch m) (cond ((eq? m 'lookup) lookup) ((eq? m 'insert) insert!) ((eq? m 'disp) disp) (else (error "Unknown operation -- TABLE" m)))) dispatch)) > (define t (make-table)) > ((t 'insert) '(a b c) 3) ok > ((t 'disp)) (*table* (a (b (c . 3)))) > ((t 'lookup) '(a b c)) 3
これでokのように思えるが、
> (define t (make-table)) > ((t 'insert) '(a b c) 3) ok > ((t 'insert) '(a b) 2) ok > ((t 'disp)) (*table* (a (b . 2)))
のように、リストの前半部が一致するようなもので、現在保持されているものより短いリストをキーリストとして与えると、以前のものが上書きされてしまう。
これを回避するため、キーリストの長さによって表を分けることを考えてみる。
これの簡単な実現としては、key-listのlengthをkey-listの先頭要素に内部で追加すればよい。
つまり、(key-list : '(a b c))なら、内部表現を(key-list : '(3 a b c))にする。
この手順を上のmake-tableに入れれば、任意個数のキーで値を格納する多次元表ができるはず。
以下では、insert!及びlookup!手続きでkey-listを渡す際に(add-dimention key-list)とすることでkey-listの先頭に次元を付加している。
(define (make-table) (let ((local-table (list '*table*))) (define (assoc key records) (cond ((null? records) false) ((equal? key (caar records)) (car records)) (else (assoc key (cdr records))))) (define (add-dimention key-list) (cons (length key-list) key-list)) (define (lookup key-list) (define (iter key-list table) (let ((subtable (assoc (car key-list) table))) (if subtable (if (null? (cdr key-list)) (cdr subtable) (iter (cdr key-list) (cdr subtable))) false))) (if (null? key-list) false (iter (add-dimention key-list) (cdr local-table)))) (define (insert! key-list value) (define (iter2 key-list table) (cond ((null? key-list) (set-cdr! table value)) (else (set-cdr! table (cons (list (car key-list)) (cdr table))) (iter2 (cdr key-list) (cadr table))))) (define (iter key-list table) (let ((subtable (assoc (car key-list) (cdr table)))) (if (not (eq? subtable false)) (cond ((null? (cdr key-list)) (set-cdr! subtable value)) (else (iter (cdr key-list) subtable))) (iter2 key-list table)))) (iter (add-dimention key-list) local-table) 'ok) (define (disp) local-table) (define (dispatch m) (cond ((eq? m 'lookup) lookup) ((eq? m 'insert) insert!) ((eq? m 'disp) disp) (else (error "Unknown operation -- TABLE" m)))) dispatch)) > (define t (make-table)) > ((t 'insert) '(a b c) 3) ok > ((t 'insert) '(a b) 2) ok > ((t 'disp)) (*table* (2 (a (b . 2))) (3 (a (b (c . 3))))) > ((t 'insert) '(a) 1) ok > ((t 'lookup) '(a)) 1 > ((t 'lookup) '(a b)) 2 > ((t 'lookup) '(a b c)) 3 > ((t 'lookup) '(a b c d)) #f
ということで、たぶん正しく動いているはず。