Scheme - 表の表現(二次元の表、局所表の作り方)

計算機プログラムの構造と解釈
Gerald Jay Sussman, Julie Sussman
Harold Abelson (原著) 和田 英一 (翻訳)

開発環境

• OS X Lion - Apple(OS)
• Emacs、BBEdit - Bare Bones Software, Inc. (Text Editor)
• プログラミング言語: MIT/GNU Scheme

計算機プログラムの構造と解釈(Gerald Jay Sussman(原著)、Julie Sussman(原著)、Harold Abelson(原著)、和田 英一(翻訳)、ピアソンエデュケーション、原書: Structure and Interpretation of Computer Programs (MIT Electrical Engineering and Computer Science)(SICP))の3(標準部品化力, オブジェクトおよび状態)、3.3(可変データでのモデル化)、3.3.3(表の表現)、二次元の表、局所表の作り方の問題 3.24を解いてみる。

その他参考書籍

• Instructor's Manual to Accompany Structure & Interpretation of Computer Programs

問題3.24

コード(BBEdit)

sample.scm

(define (make-table same-key?)
  (define (assoc key records)
    (cond ((null? records) false)
          ((same-key? key (caar records)) (car records))
          (else (assoc key (cdr records)))))
  (let ((local-table (list '*table*)))
    (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))
            false)))
    (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 (same-key? key-1 key-2)
  (and (< key-1
          (+ key-2 0.5))
       (>= key-1
           (- key-2 0.5))))

(define t (make-table same-key?))

入出力結果(Terminal, REPL(Read, Eval, Print, Loop))

1 ]=> ((t 'insert-proc!) 10 0 'a)

;Value: ok

1 ]=> ((t 'insert-proc!) 10 1 'b)

;Value: ok

1 ]=> ((t 'insert-proc!) 10 2 'c)

;Value: ok

1 ]=> ((t 'insert-proc!) 10 3 'd)

;Value: ok

1 ]=> ((t 'insert-proc!) 10 4 'e)

;Value: ok

1 ]=> ((t 'lookup-proc) 10 0.4)

;Value: a

1 ]=> ((t 'lookup-proc) 10 0.5)

;Value: b

1 ]=> ((t 'lookup-proc) 10 1.4)

;Value: b

1 ]=> ((t 'lookup-proc) 10 1.5)

;Value: c

1 ]=> ((t 'lookup-proc) 10 2.4)

;Value: c

1 ]=> ((t 'lookup-proc) 10 2.5)

;Value: d

1 ]=> ((t 'lookup-proc) 10 4)

;Value: e

1 ]=> ((t 'lookup-proc) 10 4.4)

;Value: e

1 ]=> ((t 'lookup-proc) 10 4.5)

;Value: #f

1 ]=> ((t 'insert-proc!) 10 1.1 'f)

;Value: ok

1 ]=> ((t 'lookup-proc) 10 0.5)

;Value: f

1 ]=> ((t 'lookup-proc) 10 0.6)

;Value: f

1 ]=> ((t 'lookup-proc) 10 1.5)

;Value: c