問題3.26(前)

sicp

3.26(前)

3.24や3.25は順序づけられていないリストなので、表が巨大になると効率が悪いかもしれない。
キーが順序集合上の要素であるという条件のもとで、二進木を使って表を実装することを考える。


3.24や3.25の表では、各テーブルのcdrは表の先頭を指していたので、走査する際最大表の大きさ分のステップが必要。
だからn次の表で、それぞれの表の大きさがk1, k2, ...であるなら、最大k1*k2*...*knのステップが必要になる。


最大k1+k2+...+knのステップの間違いでした。すみません。(12/19 9:50)


各表を(釣り合った)二進木で構成し、各テーブルのcdrを二進木のルートを指すようにすると、それぞれの表へのアクセスが最大$\lfloor \log_{2}k_i + 1 \rfloor$になるので効率が上がるはず。
キーと値の対を一つのノードのラベルとしてもつ二進木を構成すればいい。


問題は実装法を述べるだけでいいと書いてあったんですが、がんばれば作れそうだったのでがんばって作ることにしました。
多次元の表を二進木で管理することを考えます。


今日やったところまで。

(define (make-table)
  (let ((local-table (cons '**table** '())))
    (define (make-local-table label) (cons label '()))
    (define (label table) (car table))
    (define (make-record key value) (cons key value))
    (define (make-b-tree left record right) (cons left (cons record right)))
    (define (left-branch tree) (car tree))
    (define (tree-record tree) (cadr tree))
    (define (right-branch tree) (cddr tree))
    (define (set-left-branch! tree new) (set-car! tree new))
    (define (set-tree-record tree new) (set-car! (cdr tree) new))
    (define (set-right-branch! tree new) (set-cdr! (cdr tree) new))
    (define (key record) (car record))
    (define (value record) (cdr record))
    
    (define small? <)
    (define big? >)
    (define same? =)
    
    (define (add-dimention key-list) (cons (length key-list) key-list))
    
    (define (make-new-record! key-list value table)
      (cond ((null? (cdr key-list))
             (set-cdr! table (make-b-tree '() (make-record (car key-list) value) '())))
            (else
             (set-cdr! table (make-b-tree '() 
                                          (make-local-table (car key-list))
                                          '()))
             (make-new-record! (cdr key-list) value (tree-record (cdr table))))))
    
    (define (insert-iter! key-list value tree)
      (cond ((small? (car key-list) (key (tree-record tree)))
             (if (null? (left-branch tree))
                 (set-left-branch! tree
                                   (make-b-tree '()
                                                (make-record (car key-list) value)
                                                '()))
                 (insert-iter! key-list value (left-branch tree))))
            ((big? (car key-list) (key (tree-record tree)))
             (if (null? (right-branch tree))
                 (set-right-branch! tree
                                    (make-b-tree '()
                                                 (make-record (car key-list) value)
                                                 '()))
                 (insert-iter! key-list value (right-branch tree))))
            ((same? (car key-list) (key (tree-record tree)))
             (set-tree-record! tree (make-record (car key-list) value)))
            (else
             (error "the key is not ordered, probably" (car key-list)))))
    
    (define (b-assoc! keyword tree)
      (cond ((small? keyword (key (tree-record tree)))
             (if (null? (left-branch tree))
                 (begin (set-left-branch! tree
                                          (make-b-tree '()
                                                       (make-local-table keyword)
                                                       '()))
                        (tree-record (left-branch tree)))
                 (b-assoc! keyword (left-branch tree))))
            ((big? keyword (key (tree-record tree)))
             (if (null? (right-branch tree))
                 (begin (set-right-branch! tree
                                           (make-b-tree '()
                                                        (make-local-table keyword)
                                                        '()))
                        (tree-record (right-branch tree)))
                 (b-assoc! keyword (right-branch tree))))
            ((same? keyword (key (tree-record tree)))
             (tree-record tree))
            (else
             (error "the keyword is not ordered, probably" keyword))))
    
    (define (insert! key-list value table)
      (cond ((null? (cdr table))
             (make-new-record! key-list value table)
             local-table)
            ((null? (cdr key-list))
             (insert-iter! key-list value (cdr table))
             local-table)
            (else
             (insert! (cdr key-list) value (b-assoc! (car key-list) (cdr table))))))
    
    (define (lookup key-list table)
      (cond ((null? (cdr key-list))
             (b-assoc! (car key-list) (cdr table)))
            ((null? (cdr table))
             false)
            (else
             (lookup (cdr key-list) (b-assoc! (car key-list) (cdr table))))))
    
    (define (disp) local-table)
    
    (define (dispatch m)
      (cond ((eq? m 'insert!)
             (lambda (x y) (insert! (add-dimention x) y local-table)))
            ((eq? m 'lookup)
             (lambda (x) (lookup (add-dimention x) local-table)))
            ((eq? m 'disp) disp)
            (else
             (error "Unknown operation -- LOCAL-TABLE" m))))
    dispatch))


> (define t (make-table))
> ((t 'insert!) '(1 2 3) 'a)
(**table** () (3 () (1 () (2 () (3 . a)))))
> ((t 'insert!) '(1 2) 'b)
(**table** (() (2 () (1 () (2 . b)))) (3 () (1 () (2 () (3 . a)))))
> ((t 'insert!) '(1 2 4) 'c)
(**table** (() (2 () (1 () (2 . b)))) (3 () (1 () (2 () (3 . a) () (4 . c)))))
> ((t 'insert!) '(1 2 3 4 5) 'd)
(**table** (() (2 () (1 () (2 . b)))) (3 () (1 () (2 () (3 . a) () (4 . c)))) () (5 () (1 () (2 () (3 () (4 () (5 . d)))))))
> ((t 'insert!) '(1 2 1) 'e)
(**table** (() (2 () (1 () (2 . b)))) (3 () (1 () (2 (() (1 . e)) (3 . a) () (4 . c)))) () (5 () (1 () (2 () (3 () (4 () (5 . d)))))))
> ((t 'lookup) '(1 2 1))
e
> ((t 'lookup) '(1 2 3 4 5))
d
> ((t 'lookup) '(1 2))
b


とりあえず、二進木の構造で管理することができる表を作成することができましたが、二進木がバランス木になっていないので次でそこを改良します。
b-assoc!がちゃんと抽象できてないので(代入なくしたい)、そこも直そうと思います。
lookupも妙におかしい挙動をする(たぶんb-assoc!のせい)ので、ちゃんと値が無い場合はfalseを出すようにします。
今回は順序集合として数値に限定したのですが(small?, big?, same?)、文字や文字列での辞書式順序による順序づけとかもやる気がでたらやりたいと思います。(schemeの基本手続きに文字比較するものってあるのかな)
後、一気にやったためコードがすごく雑なのでそこを整形しようと思います。