テーブル、連想リスト。
3.24 (same-key?を指定できるテーブル)
(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))
3.25
(define (make-table) (let ((*table* '())) (define (lookup key) (let ((pair (assoc key *table*))) (and pair (cdr pair)))) (define (insert! key value) (let ((pair (assoc key *table*))) (if pair (set-cdr! pair value) (set! *table* (cons (cons key value) *table*))))) (define (dispatch m) (cond ((eq? m 'lookup-proc) lookup) ((eq? m 'insert-proc!) insert!) (else (error "Unknown operation -- TABLE" m)))) dispatch))
以上、試してない。
3.26 (木構造でテーブルを実装)
(define (tree-content t) (list-ref t 0)) (define (tree-left t) (list-ref t 1)) (define (tree-right t) (list-ref t 2)) (define (make-tree t) (list t '() '())) (define (tree-set-left! t l) (set-car! (cdr t) l)) (define (tree-set-right! t r) (set-car! (cddr t) r)) (define (make-table) (let ((*tree* '())) (define (tree-assoc key tree) (cond ((null? tree) #f) ((< key (car (tree-content tree))) (tree-assoc key (tree-left tree))) ((> key (car (tree-content tree))) (tree-assoc key (tree-right tree))) (else (tree-content tree)))) (define (tree-insert! item tree) (cond ((null? tree) (error "tree is null")) ((< (car item) (car (tree-content tree))) (if (null? (tree-left tree)) (tree-set-left! tree (make-tree item)) (tree-insert! item (tree-left tree)))) ((> (car item) (car (tree-content tree))) (if (null? (tree-right tree)) (tree-set-right! tree (make-tree item)) (tree-insert! item (tree-right tree)))) (else (error "key exists")))) (define (lookup key) (let ((pair (tree-assoc key *tree*))) (and pair (cdr pair)))) (define (insert! key value) (let ((pair (tree-assoc key *tree*))) (cond (pair (set-cdr! pair value)) ((null? *tree*) (set! *tree* (make-tree (cons key value)))) (else (tree-insert! (cons key value) *tree*))))) (define (dispatch m) (cond ((eq? m 'lookup-proc) lookup) ((eq? m 'insert-proc!) insert!) (else (error "Unknown operation -- TABLE" m)))) dispatch))
3.27
関数のメモ化とか。
うーん、雑だ。