プログラミング再入門

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

SICP 2.3.3 Example: Representing Sets

Scheme手習い』だったか『Scheme修行』だったかで出て来たリストを使った集合演算の話。

ノート

union-set、intersection-set、element-of-set?、adjoin-setを実装出来るデータ構造を作る。

Sets as unordered lists

順不同リスト(?)で表現した集合。
element-of-set?は

  1. setが空ならfalse
  2. setの先頭要素がxと等しければtrue
  3. それ以外の場合はsetの2番目の要素以降の集合にxが含まれているかの結果

adjoin-setは

  1. xがsetに含まれていれば、setはそのまま
  2. 含まれていなければconsで追加

intersection-setはset1の各要素についてset2に含まれているかを調べる。

  1. set1かset2が空であれば空
  2. set1の先頭要素がset2に含まれていれば、set1の2番目以降の要素とset2の積集合にset1の先頭要素を足した集合
  3. そうでなければset1の2番目以降の要素とset2の積集合

計算量の部分は、set2の要素数だけelement-of-set?はset2の要素数に依存し、set1の要素数だけelement-of-set?を呼び出すので、set2の要素数×set1の要素数がここで言うステップ数と捉えられる。

Exercise 2.59

union-set(和集合)の実装。
集合aとbがあって、aには有ってbには無い要素をbに足す事を考える。

  1. aが空ならb
  2. bが空ならa
  3. aの先頭要素がbに含まれていたら、aの残り要素とbの和集合
  4. aの先頭要素がbに含まれていなかったら、aの残り要素とbの和集合にaの先頭要素を足した集合
(define (union-set a b)
  (cond ((null? a) b)
        ((null? b) a)
        ((element-of-set? (car a) b)
         (union-set (cdr a) b))
        (else
         (cons (car a)
               (union-set (cdr a) b)))))

動作確認

> (union-set (list 1 2 3) (list 2 3 4))
(1 2 3 4)
> (union-set '() (list 1 2 3))
(1 2 3)
> (union-set (list 1 2 3) '())
(1 2 3)
> (union-set (list 1 3 5 6) (list 2 4 5 6))
(1 3 2 4 5 6)
> 
Exercise 2.60

Multiset(多重集合)の問題。
element-of-set?は変わらない。

adjoin-setは既にリストに存在するか否かに関わらず集合に足してしまえば良いので、

(define (adjoin-set x set)
      (cons x set))

となる。また単純に

(define adjoin-set
      cons)

でも良い。
union-setは「多重集合の和演算」であり、双方の集合の全ての要素なので単に二つのリストの和と定義出来る。

(define (union-set a b)
      (append a b))

これも

(define union-set
      append)

とも定義出来る。
多重集合ではそれぞれの要素に対して重複度が定義出来、和集合ではそれぞれの要素について多重度も和となる。

intersection-setもまた「多重集合の積演算」であり、二つの集合に共通の要素から成る集合で、それぞれの多重度はどちらかの集合における多重度の小さい方と定義出来る。
基本的な考え方は、

  1. 集合aのある要素xが集合bの中に見つかれば、aの残りの要素と、bから最初に見つかったxを除いた集合の積集合にxを加えた集合
  2. 集合aのある要素xが集合bの中に見つからなければ、aの残りの要素とbの積集合。

と考える。
多重度を考慮する為に集合から有る要素を削除する演算が必要。

(define (sub set x)
  (cond ((null? set) '())
        ((equal? (car set) x) (cdr set))
        (else
         (cons (car set) (sub (cdr set) x)))))

(define (intersection-set a b)
  (cond ((or (null? a) (null? b)) '())
        ((element-of-set? (car a) b)
         (cons (car a) (intersection-set (cdr a) (sub b (car a)))))
        (else
         (intersection-set (cdr a) b))))

動作確認

> (adjoin-set 4 (list 1 2 3 4 5))
(4 1 2 3 4 5)
> (union-set (list 1 2 3 4) (list 2 3 4 5))
(1 2 3 4 2 3 4 5)
> (sub (list 1 2 3 4) 3)
(1 2 4)
> (intersection-set (list 1 2 3 4) (list 2 3 4 5))
(2 3 4)
> 

多重集合は値の種類に加えて重複度の情報も保存されるので、例えばヒストグラムを取る様なデータや、そもそも重複を含んだデータをそのまま(出現順序はともかく)保存する用途に使える。

Sets as ordered lists

順序リストで表現した集合。
検索の効率を上げるひとつの方法としてある規則に従って並べておく方法がある。この方法には値の大小を決める為の比較演算が必要。
順番に並んでいればelement-of-set?が早くなる。と言っても二分検索等の話ではなかった。xとの比較の途中でそれ以上比較の必要が無くなると言うだけ。ワーストケースでは順序無しと同じ。期待値としては要素数の半分に比例と言う事になる。

intersection-setでは二つの集合の最小要素を比較し、それらが等しければそれはintersectionに含まれるが、等しくない場合は小さい方の要素はもう片方の集合の他の要素とは全く比較する必要はなくintersectionには含まれない事が確定する。ポイントは二つの要素を比較するだけで集合全体を検索する事は決してない所。実際のコードはそうではないが二つの要素の大小比較を1ステップと数えるなら、最大でも二つの集合の要素数の合計(片方の最大要素がもう片方の最小要素よりも小さい時)であり、ステップの増加は要素数に比例。

Exercise 2.61

element-of-set?と同じ様に組み立てると

(define (adjoin-set x set)
  (cond ((null? set) (list x))
        ((= x (car set)) set)
        ((< x (car set)) (cons x set))
        (else (cons (car set) (adjoin-set x (cdr set))))))

動作確認

> (adjoin-set 1 '(2 3))
(1 2 3)
> (adjoin-set 1 '(1 2 3))
(1 2 3)
> (adjoin-set 4 '(1 2 3))
(1 2 3 4)
> (adjoin-set 6 '(1 2 3 7 8 9))
(1 2 3 6 7 8 9)
> 

xが既にsetに含まれている場合は走査ステップの期待値は順序ありでも順序無しでもn/2だが、含まれていない場合は順序無しの集合では最後まで比較しきる必要があるので必ずnステップとなるのに対し、順序ありの場合は途中で比較を打ち切る事が出来るので期待値としてはn/2ステップで済む事になる。

Exercise 2.62

Θ(n)で済むunion-setを書く。普通にadjoin-setを使うと片方の集合の要素数分adjoin-setを呼び出すのでn/2×nだからΘ(n2)となってしまい、各要素を取り出す方の集合が順序ありである利点が生かされない。従ってadjoin-setは使わずに各々の集合の先頭要素を比較しながら和集合を形成する事にする。

(define (union-set set1 set2)
  (cond ((null? set1) set2)
        ((null? set2) set1)
        ((= (car set1) (car set2)) (cons (car set1) (union-set (cdr set1) (cdr set2))))
        ((< (car set1) (car set2)) (cons (car set1) (union-set (cdr set1) set2)))
        (else (cons (car set2) (union-set set1 (cdr set2))))))

動作確認

> (union-set '() '(1 2 3))
(1 2 3)
> (union-set '(1 2 3) '())
(1 2 3)
> (union-set '(1 2 3) '(2 3 4))
(1 2 3 4)
> (union-set '(1 2 3) '(4 5 6))
(1 2 3 4 5 6)
> 

carを何回も呼び出すとか、比較演算を何度か行ってしまう事は度外視すると、再帰の回数では最大で二つの集合の要素数の合計なのでΘ(n)である。

Sets as binary trees

二分木による集合。
まずはノードを表すオブジェクトと言うかコンストラクタとアクセッサを定義して、それを使って各メソッドを定義する。element-of-set?はtreeに変更を加えないので簡単。
adjoin-setは追加する場所を木の末端まで探して、帰り道で木全体を再構築する。

Exercise 2.63

a.
どちらの定義も結果は同じ筈。二つの違いはtree->list-1は左を展開、右を展開、繋げると言う手順なのに対し、tree->list-2は右を展開、右が無くなったら結果に足して1段左に行ってまた右側から展開して行く。
図2.16の木を以下の様に定義し

(define tree1 (make-tree 7
                         (make-tree 3
                                    (make-tree 1 '() '())
                                    (make-tree 5 '() '()))
                         (make-tree 9
                                    '()
                                    (make-tree 11 '() '()))))
(define tree2 (make-tree 3
                         (make-tree 1 '() '())
                         (make-tree 7
                                    (make-tree 5 '() '())
                                    (make-tree 9
                                               '()
                                               (make-tree 11 '() '())))))
(define tree3 (make-tree 5
                         (make-tree 3
                                    (make-tree 1 '() '())
                                    '())
                         (make-tree 9
                                    (make-tree 7 '() '())
                                    (make-tree 11 '() '()))))

実行してみる。

> (tree->list-1 tree1)
(1 3 5 7 9 11)
> (tree->list-2 tree1)
(1 3 5 7 9 11)
> (tree->list-1 tree2)
(1 3 5 7 9 11)
> (tree->list-2 tree2)
(1 3 5 7 9 11)
> (tree->list-1 tree3)
(1 3 5 7 9 11)
> (tree->list-2 tree3)
(1 3 5 7 9 11)
> 

結果に違いは無い。
b.
再帰呼び出しの回数を見ると、どちらも枝の数だけ呼び出すので基本的にはΘ(n)。ただしtree->list-1はconsだけではなくappendを使うので、これを考慮しなければならない。appendは各ノードの左側だけにしか使わないが逆に同じリストを何度も走査するので正確には良く分からない。大雑把にappendのΘ(n)の操作をノードの数に比例した回数行うのでΘ(n2)と言えるのかな。

次のExercise 2.64に登場するlist->treeを利用して実験してみる。
単に数列を作るsequenceを作って、これをlist->treeで木に変換してそれをまたリストに戻す。プロファイラがappendの呼び出し回数は表示してくれないので自前のmyappendに差し替えて動かす。

(define (sequence a b)
  (if (= a b)
      (list a)
      (cons a (sequence (+ a 1) b))))
(define (myappend a b)
  (if (null? a)
      b
      (cons (car a) (myappend (cdr a) b))))

これで10個の要素で実行する。

> (tree->list-1 (list->tree (sequence 1 10)))
(1 2 3 4 5 6 7 8 9 10)
> 

プロファイラを見るとtree->list-1の呼び出し回数は21回。myappendは17回。一方

> (tree->list-1 (list->tree (sequence 1 100)))
(1
 2
 …中略
 99
 100)
> 

この時のtree->list-1の呼び出し回数は201回。myappendは319回。まぁオーダーとしてはmyappendを呼び出す回数がnに比例していると言えそうで、myappendがΘ(n)なのでΘ(n2)で良さそう。
ちなみに、tree->list-2の方はcopy-to-listの呼び出し回数が、n=10の時に21回、n=100の時に201回。予想通り。

Exercise 2.64

a.
基本的には真ん中の要素を取り出し、それより前を木に変換したものと後ろを木に変換したものを引数にmake-treeで木を構成して行く。左右それぞれ側の呼び出しでも、それぞれのリストを半分にしながら木を構成して行く。
(1 3 5 7 9 11)の場合、5を真ん中として(1 3)と(7 9 11)でそれぞれ木構造に変換したものを5を中心に木とする。(1 3)の場合は1を中心として左は空、右が3となる。(7 9 11)の場合は当然9が中心で7と11が左右にぶら下がる木となる。
予想は

   5
 / \
1      9
 \   /  \
  3  7     11

実行してみると

> (list->tree '(1 3 5 7 9 11))
(5 (1 () (3 () ())) (9 (7 () ()) (11 () ())))
> 

その通りになっていそう。
ここでremaining-eltsが分かりにくい。考え方としてはリストを半分に分割しているが実際に分割したリストを使っている訳ではないので、partial-treeに渡されるeltsの全ての要素を変換対象としている訳ではない。なのでleft-size、right-sizeを計算して対象範囲内のみを木に変換して残りは呼び出し元に返す必要がある。実際carを使って与えられたリストの最初の要素から取り出しながら木に変換しているので、変換の途中では必ず残りのリストが存在している。
b.
リストの各要素がそれぞれ1回ずつthis-entryとなるのでpartial-treeの呼び出し回数はリストの要素数と、末端の空リストを返すケースのみ。従ってΘ(n)と言えそう。
プロファイラの出力では要素数10でpartial-treeの呼び出し回数は21回。要素数100の場合201回。

Exercise 2.65

union-setのintersection-setも片方の集合の要素をひとつひとつ取り出して結果を作るので、片側の集合を一旦リストに直してunion、intersectionを計算してその結果を再び木に変換する。

(define (union-set set1 set2)
  (define (union-list+set l t)
    (cond ((null? l) t)
          ((null? t) (list->tree l))
          ((element-of-set? (car l) t)
           (union-list+set (cdr l) t))
          (else
           (adjoin-set (car l)
                       (union-list+set (cdr l) t)))))
  (union-list+set (tree->list set1) set2))

(define (intersection-set set1 set2)
  (define (intersection-list+set l t)
    (cond ((or (null? l) (null? t)) '())    
          ((element-of-set? (car l) t)
           (adjoin-set (car l)
                       (intersection-list+set (cdr l) t)))
          (else (intersection-list+set (cdr l) t))))
  (intersection-list+set (tree->list set1) set2))

動作確認

> (union-set (list->tree (list 1 2 3)) (list->tree (list 2 3 4)))
(3 (2 (1 () ()) ()) (4 () ()))
> (union-set '() (list->tree (list 1 2 3)))
(2 (1 () ()) (3 () ()))
> (union-set (list->tree (list 1 2 3)) '())
(2 (1 () ()) (3 () ()))
> (intersection-set '() (list->tree '(1 2 3)))
()
> (intersection-set (list->tree '(1 2 3)) '())
()
> (intersection-set (list->tree '(1 2 3 4)) (list->tree '(3 4 5 6)))
(4 (3 () ()) ())
> 
Sets and information retrieval

集合の演算はデータベースと本質的には同じ。

Exercise 2.66

element-of-set?は要素そのものを比較して探し単に要素の有無を返すだけだが、これを

  1. 要素のkeyの部分だけを比較して探す
  2. 見つかった要素を返す

ように改造する。

(define (lookup given-key set-of-records)
  (if (null? set-of-records)
      false
      (let ((k (key (entry set-of-records))))
        (cond ((= given-key k) (entry set-of-records))
              ((< given-key k) (lookup given-key (left-branch set-of-records)))
              ((> given-key k) (lookup given-key (right-branch set-of-records)))))))

簡単なオブジェクトrecordのメソッドを作成。

(define (make-record key value)
  (list key value))
(define (key record)
  (car record))
(define (value record)
  (cdr record))

既出の二分木用の関数はそのまま使うが、データベースを構築する為のadjoin-setだけはkeyを比較する為に以下の様に改造。

(define (adjoin-set x set)
  (if (null? set)
      (make-tree x '() '())
      (let ((key-x (key x))
            (key-entry (key (entry set))))
        (cond ((= key-x key-entry) set)
              ((< key-x key-entry)
               (make-tree (entry set) 
                          (adjoin-set x (left-branch set))
                          (right-branch set)))
              ((> key-x key-entry)
               (make-tree (entry set)
                          (left-branch set)
                          (adjoin-set x (right-branch set))))))))

実行結果はこんな感じ。

> (define db (list->tree (list (make-record 1 'John) (make-record 2 'Paul) (make-record 3 'George) (make-record 4 'Ringo))))
> (lookup 1 db)
(1 John)
> (lookup 2 db)
(2 Paul)
> (lookup 3 db)
(3 George)
> (lookup 4 db)
(4 Ringo)
>