プログラミング再入門

プログラミングをもう一度ちゃんと勉強する読書ノート

SICP 3.3.3 Representing Tables

キュー(待ち行列)に引き続き今度はテーブル(表)。2章で使ったテーブルがここで漸く登場。

ノート

1次元のテーブルとはキーでインデックス化された列の事。recordと呼んでいるセルのcarがキーを、cdrが値を指している。そのrecordのリスト(あるいはそのセル)をbackboneと呼んでいる。最初にダミーのバックボーンセルがある理由はここでは明確ではない。assocはキーと一致するレコートを返す。見つからなければfalse。lookupはassocで見つけたレコードの値部分を返す。insert!は既に存在しているキーであればデータを差し替える。新規のキーであれば新しいレコードとしてテーブルの先頭に挿入する。

Two-dimensional tables

2次元のテーブルとは1次元のテーブルを二つ含んだテーブル。どちらの(1次元の)テーブルかを示すキーと、そのテーブルのインデックスとしてのキーの二つのキーが存在する。1次元のテーブルの先頭にダミーのセルがあった理由がここで分かる。どちらの(1次元の)テーブルを指しているのかを探す為のキーとして働く。
assocはそのままだが、lookupは2次元に対応する為に拡張される。同様にinsert!も拡張される。

Creating local tables

1次元と2次元のテーブルが同時に存在する場合lookupとinsert!は名前の衝突を起こす。これをローカルなメソッドにして解決する。

Exercise 3.24

キーが数値と言う前提で一定の誤差範囲内は同じ値とみなすとの事。

重なりについてどう処理するのかはこの問題では特に触れていない。例えば±0.5を誤差範囲とした時に、まず1.0をキーとして登録。1.2とか1.4、一応1.5までは同じキーとみなされる。ここで1.6は別のキーとして登録される。そうすると1.1〜1.5の区間は重なってしまう。現状の実装では先に登録したキーが見つかりそうだが一般にそうとは限らない。そうすると本当は登録するキーと誤差範囲の両方を制御する必要があるが、ここではキーの方の制御には触れないと言う事か。

ここではキーが二つある必要は無いので1次元のテーブルとする。

#lang scheme
(require r5rs)

(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)
      (let ((record (assoc key (cdr local-table))))
        (if record
            (cdr record)
            false)))
    (define (insert! key value)
      (let ((record (assoc key (cdr local-table))))
        (if record
            (set-cdr! record value)
            (set-cdr! local-table
                      (cons (cons key 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 equal?))
> ((t1 'insert!) 1.0 'a)
ok
> ((t1 'insert!) 2.0 'b)
ok
> ((t1 'lookup) 1.6)
#f
> (define t2 (make-table (lambda (a b) (< (abs (- a b)) 0.5))))
> ((t2 'insert!) 1.0 'a)
ok
> ((t2 'insert!) 2.0 'b)
ok
> ((t2 'lookup) 1.6)
b
> (define t3 (make-table (lambda (a b) (< (abs (- a b)) 0.5))))
> ((t3 'insert!) 1.0 'a)
ok
> ((t3 'lookup) 0.6)
a
> ((t3 'insert!) 1.2 'b)
ok
> ((t3 'lookup) 0.6)
b
> 

一応期待通りに動いている。

t3に対する二回目のinsert!がややこしい部分。その前のlookupで0.6に対してaが返って来ているので、1.2を登録しても0.6の値に影響は無い筈だが、1.2は1.0と同じとみなされるので1.0としてbが登録される。従って0.6をlookupするとbが返って来る。

Exercise 3.25

lookup、insert!とも任意の数のキーを受け取る様にする。lookupは兎も角、insert!の方はvalueの位置をどうするかちょっと悩ましい。最低一つはキーが指定される事を前提とする。

#lang scheme
(require r5rs)

(define (make-table)
  (let ((local-table (list '*table*)))
    (define (lookup table . args)
      (let ((record (assoc (car args) (cdr table))))
        (if record
            (if (null? (cdr args))
                (cdr record)
                (apply lookup record (cdr args)))
            false)))
    (define (insert! table . args)
      (let ((record (assoc (car args) (cdr table))))
        (if record
            (if (null? (cddr args))
                (set-cdr! record (cadr args))
                (apply insert! record (cdr args)))
            (if (null? (cddr args))
                (set-cdr! table
                          (cons (cons (car args) (cadr args)) (cdr table)))
                (begin
                  (set-cdr! table (cons (list (car args)) (cdr table)))
                  (apply insert! (cadr table) (cdr args))))))
      'ok)
    (define (dispatch m)
      (cond ((eq? m 'lookup) (lambda (key . args) (apply lookup local-table (cons key args))))
            ((eq? m 'insert!) (lambda (key . args) (apply insert! local-table (cons key args))))
            (else (error "Unknown operation -- TABLE" m))))
    dispatch))

lambdaで可変長引数を受け取るのがちょっと難しいが、一応最低一つはkeyを指定する前提でkey . argとして受け取る。またこれを内部関数にやはり可変長引数として渡す為にはapplyを使う必要がありそうで、keyとargをもう一度consで括る必要がある。もう少しスマートな方法もあるかも知れない。
lookup、insert!とも一つ以上任意個のkeyとvalueを纏めてargsとして受け取る。最後の要素をvalueとする。keyが一つでvalueが一つの場合(cddr args)がnullとなるので、その場合初めて(cdr args)をvalueとして扱うが、そうでない場合は常にkeyのリストとして扱う。
lookupではkeyに一致するサブテーブルを順に再帰しながら追いかけてvalueに辿り着いたらその値を返す。途中で見つからなくなったらfalse。
insert!はvalueではない限りkeyが見つからなかったら新しいテーブルを作って、そこに対して再帰的にinsert!を呼び出す。
動作確認。

> (define t (make-table))
> ((t 'insert!) 'a 1)
ok
> ((t 'lookup) 'a)
1
> ((t 'insert!) 'b 'c 2)
ok
> ((t 'lookup) 'b 'c)
2
> ((t 'insert!) 'b 'd 3)
ok
> ((t 'lookup) 'b 'd)
3
> ((t 'insert!) 'e 'f 'g 'h 4)
ok
> ((t 'insert!) 'e 'f 'g 'i 5)
ok
> ((t 'lookup) 'e 'f 'g 'h)
4
> ((t 'lookup) 'e 'f 'g 'i)
5
> ((t 'lookup) 'e 'f 'h)
#f
> ((t 'lookup) 'e 'f 'i)
#f

最初に思いついたのが可変長引数だったのでこう実装したが、Webを調べるとkeyのリストとvalueを引数にしているのが多い様子。確かに目的は達成していると言えるが、それだとkeyのリストとvalueの1次元のテーブルにしているだけで、1次元のテーブル、2次元のテーブルと来てそのテーブルの次数を一般化したと言えるのかちょっと疑問。

Exercise 3.26

ここまでの流れからkeyは文字からなるシンボルと言う前提にしてアルファベット順の二分木にする。
シンボルの辞書順の二分木を作る。

(define (make-key-value-record key value)
  (cons key value))
(define (key key-value-record)
  (car key-value-record))
(define (value key-value-record)
  (cdr key-value-record))
(define (set-value! key-value-record value)
  (set-cdr! key-value-record value))

(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 (lookup-set given-key set-of-records)
  (if (null? set-of-records)
      false
      (let ((k (symbol->string (key (entry set-of-records))))
            (g (symbol->string given-key)))
        (cond ((string=? g k) (entry set-of-records))
              ((string<? g k) (lookup-set given-key (left-branch set-of-records)))
              ((string>? g k) (lookup-set given-key (right-branch set-of-records)))))))

(define (adjoin-set x set)
  (if (null? set)
      (make-tree x '() '())
      (let ((key-x (symbol->string (key x)))
            (key-entry (symbol->string (key (entry set)))))
        (cond ((string=? key-x key-entry)
               (begin (set-cdr! (entry set) (value x))
                      set))
              ((string<? key-x key-entry)
               (make-tree (entry set) 
                          (adjoin-set x (left-branch set))
                          (right-branch set)))
              ((string>? key-x key-entry)
               (make-tree (entry set)
                          (left-branch set)
                          (adjoin-set x (right-branch set))))))))

テーブルの部分は

(define (make-table)
  (let ((local-table (list '*table*)))
    (define (lookup table . args)
      (let ((record (lookup-set (car args) (cdr table))))
        (if record
            (if (null? (cdr args))
                (value record)
                (apply lookup record (cdr args)))
            false)))
    (define (insert! table . args)
      (let ((first (car args))
            (second (cadr args))
            (the-rest (cddr args)))
        (let ((record (lookup-set first (cdr table))))
          (if record
              (if (null? the-rest)
                  (set-value! record second)
                  (apply insert! record (cdr args)))
              (if (null? the-rest)
                  (set-cdr! table (adjoin-set (make-key-value-record first second) (cdr table)))
                  (begin
                    (set-cdr! table (cons (list first) (cdr table)))
                    (apply insert! (cadr table) (cdr args))))))
        'ok))
    (define (dispatch m)
      (cond ((eq? m 'lookup) (lambda (key . args) (apply lookup local-table (cons key args))))
            ((eq? m 'insert!) (lambda (key . args) (apply insert! local-table (cons key args))))
            (else (error "Unknown operation -- TABLE" m))))
    dispatch))

lookupの方はassocの代わりにlookup-setに変更するだけ。insert!の方はassocをlookup-setに返るのは同じだが、新しいエントリを作る部分をadjoin-setに任せる形に変更。
動作確認。

> (define t (make-table))
> ((t 'insert!) 'a 1)
ok
> ((t 'lookup) 'a)
1
> ((t 'insert!) 'a 2)
ok
> ((t 'lookup) 'a)
2
> ((t 'insert!) 'z 3)
ok
> ((t 'lookup) 'z)
3
> ((t 'insert!) 'b 'c 2)
ok
> ((t 'lookup) 'b 'c)
2
> ((t 'insert!) 'b 'd 3)
ok
> ((t 'lookup) 'b 'd)
3
> ((t 'insert!) 'e 'f 'g 'h 4)
ok
> ((t 'insert!) 'e 'f 'g 'i 5)
ok
> ((t 'lookup) 'e 'f 'g 'h)
4
> ((t 'lookup) 'e 'f 'g 'i)
5
> 
Exercise 3.27

ローカルテーブルを使ったメモ化。ここでは引数一つの関数のみを扱っているので1次元のテーブルで良さそう。

memoizeは呼ばれた時にtableを作りlambdaで関数を作って返す。この関数はtableが参照出来る環境でlambdaによって作られるので、呼び出される時にはtableが常に参照出来る事になる。一方memo-fibは一見手続きを定義する形になっていない。これはmemoizeを実行して返って来た関数に拘束される形になっている。

(define (fib n) ...

の様な関数定義は

(define fib (lambda (n) ...

と等価であり、memoizeはこのlambdaの代わりをしている。つまりmemo-fibを呼ぶ度にmemoizeが呼ばれてその度にtableが作られる訳ではなく、memoizeはmemo-fibを定義する時に1回呼ばれ、その時にtableが作られて、memo-fibを呼び出すと最初にmemoizeが返した関数が呼ばれる事になる。

memoizeは一つの引数xを受け取る関数を作る。その関数はxがtableに含まれているかを確認して、含まれていればその値を、含まれていなければxにmemoizeの引数であるfを適用し、その結果をtableに登録した上で関数値として返す。

memo-fibはmemoizeに関数fとしてfibと等価の関数を渡している。結果としてmemo-fibはmemoizeが返す、tableに結果を保存しながら関数f(fib相当)を呼び出す関数に拘束される事になる。

(memo-fib 3)を呼んだ時の動作:
まず(memo-fib 3)が呼ばれて、当然まだ何の結果もtableには無いので、(f 3)が呼ばれる。

(f 3)から(memo-fib 2)が呼ばれ、(f 2)が呼ばれる。

(f 2)から(memo-fib 1)が呼ばれ、(f 1)が呼ばれる。

(f 1)は直ぐに結果を返し、それがtableに登録される。

(f 2)から次に(memo-fib 0)が呼ばれ、(f 0)が呼ばれる。

(f 0)は直ぐに結果を返し、それがtableに登録される。

(f 2)が結果を返し、それがtableに登録される。

(f 3)から(memo-fib 1)が呼ばれるが、1に対する結果はtableに登録されている。

(f 3)が結果を返し、それがtableに登録される。

取り敢えずテーブルから値を取り出す事を度外視すれば、fが呼ばれる回数は各nに対して1回だけなので、この部分に関してはnに比例したステップ数と言える。

テーブルが大きくなると実際に計算するのとテーブルを検索するののどっちがお得かと言う話になる気がする。そうすると本当は線形のリストではちょっと不都合。

(define (fib n) ...)
(define memo-fib (memoize fib)

としてしまうと、memoizeの引数fは再帰呼び出してmemo-fibを呼ばなければならない所でfibを直接呼んでしまうのでメモ化は働かなくなる。
以下の様にテーブルに登録する時、fib(ここではmemo-fib)を呼んだ時に表示を入れて、

(define (insert! key value table)
  (display key)(display " => ")(display value)(newline)
  (let ((record (assoc key (cdr table))))
    (if record
        (set-cdr! record value)
        (set-cdr! table
                  (cons (cons key value) (cdr table)))))
  'ok)

(define memo-fib
  (memoize (lambda (n)
             (display "fib(")(display n)(display ")")(newline)
             (cond ((= n 0) 0)
                   ((= n 1) 1)
                   (else (+ (memo-fib (- n 1))
                            (memo-fib (- n 2))))))))

実行すると

> (memo-fib 3)
fib(3)
fib(2)
fib(1)
1 => 1
fib(0)
0 => 0
2 => 1
3 => 2
2
> 

memo-fibを単に

(define (fib n)
  (display "fib(")(display n)(display ")")(newline)
  (cond ((= n 0) 0)
        ((= n 1) 1)
        (else (+ (fib (- n 1))
                 (fib (- n 2))))))

(define memo-fib2 (memoize fib))

こう定義してしまうと

> (memo-fib2 3)
fib(3)
fib(2)
fib(1)
fib(0)
fib(1)
3 => 2
2
> 

再帰の部分でmemoizeの本体を通らないのでメモ化が効かずfib(1)を2回呼んでしまう。