問題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

ということで、たぶん正しく動いているはず。