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.26を解いてみる。

その他参考書籍

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

問題3.26

コード(BBEdit)

sample.scm

(define (entry tree) (car tree))
(define (left-branch tree) (cadr tree))
(define (right-branch tree) (caddr tree))
(define (make-tree entry left right)
  (list entry left right))

(define (make-table)
  (let ((local-table '()))
    (define (lookup keys)
      (define (inner keys table)
        (if (null? table)
            false
            (let ((x (entry table))
                  (key (car keys)))
              (let ((entry-key (car x)))
                (cond ((= key entry-key)
                       (if (null? (cdr keys))
                           (let ((value (caddr x)))
                             (if (null? value)
                                 false
                                 value))
                           (inner (cdr keys) (cadr x))))
                      ((< key entry-key)
                       (inner keys (left-branch table)))
                      ((> key entry-key)
                       (inner keys (right-branch table))))))))
      (inner keys local-table))
    (define (insert! keys value)
      (define (inner keys value table)
        (let ((key (car keys))
              (subkeys (cdr keys)))
          (if (null? table)
              (if (null? subkeys)
                  (make-tree (list key 
                                   '() 
                                   value)
                             '()
                             '())
                  (make-tree (list key
                                   (inner subkeys value '())
                                   '())
                             '()
                             '()))
              (let ((x (entry table)))
                (cond ((= key (car x))
                       (if (null? subkeys)
                           (begin (set-car! (cddr x) value)
                                  (make-tree x
                                             (left-branch table)
                                             (right-branch table)))
                           (make-tree (list key
                                            (inner subkeys value (cadr x))
                                            (caddr x))
                                      (left-branch table)
                                      (right-branch table))))
                      ((< key (car x))
                       (make-tree x
                                  (inner keys
                                         value 
                                         (left-branch table))
                                  (right-branch table)))
                      ((> key (car x))
                       (make-tree x
                                  (left-branch table)
                                  (inner keys 
                                         value 
                                         (right-branch table)))))))))
      (set! local-table (inner keys value 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 operation-table (make-table))
(define get (operation-table 'lookup-proc))
(define put (operation-table 'insert-proc!))

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

1 ]=> (put (list 1) 'a)

;Value: ok

1 ]=> (put (list 1 2) 'b)

;Value: ok

1 ]=> (put (list 1 2 3) 'c)

;Value: ok

1 ]=> (put (list 2 3 4) 'd)

;Value: ok

1 ]=> (get (list 1))

;Value: a

1 ]=> (get (list 1 2))

;Value: b

1 ]=> (get (list 1 2 3))

;Value: c

1 ]=> (get (list 2 3 4))

;Value: d

1 ]=> (put (list 1 2 3) 'z)

;Value: ok

1 ]=> (get (list 1 2 3)) 

;Value: z

前問での問題を解決しつつコードを書けた。