オンラインSICP読書女子会 #28 (2.3.3)

オンラインSICP読書女子会 #28 (2.3.3)

練習問題 2.62 - 2.65

二分木としての集合

       7             3                5
     ／ ＼         ／ ＼            ／ ＼
    3     9       1     7          3     9
  ／ ＼    ＼         ／ ＼       ／   ／ ＼
 1     5     11      5     9     1    7     11
                            ＼
                              11

 図 2.16: 集合 {1, 3, 5, 7, 9, 11} を表現するさまざまな二分木

実装

; [sec-2.3.3-c.scm]
;
(define (sec-2.3.3-c)
    (for-each
        (lambda (list)
            (print "(list-to-tree " (cons 'list list) ")")
            (print ";==> " (list-to-tree list)))
        (sample-sources))
    #t)


(define (sample-sources)
    (list
        (list 7 3 9 1 5 11)
        (list 3 1 7 5 9 11)
        (list 5 3 9 1 7 11)
        (list 1 2 3 4 5 6 7)))


(define (list-to-tree list)
    (fold adjoin-set () list))


(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 (element-of-set? x set)
    (cond
        ((null? set) #f)
        ((= x (entry set)) #t)
        ((< x (entry set)) (element-of-set? x (left-branch set)))
        ((> x (entry set)) (element-of-set? x (right-branch set)))))

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

実行結果

gosh> (sec-2.3.3-c)
(list-to-tree (list 7 3 9 1 5 11))
;==> (7 (3 (1 () ()) (5 () ())) (9 () (11 () ())))
(list-to-tree (list 3 1 7 5 9 11))
;==> (3 (1 () ()) (7 (5 () ()) (9 () (11 () ()))))
(list-to-tree (list 5 3 9 1 7 11))
;==> (5 (3 (1 () ()) ()) (9 (7 () ()) (11 () ())))
(list-to-tree (list 1 2 3 4 5 6 7))
;==> (1 () (2 () (3 () (4 () (5 () (6 () (7 () ())))))))
#t

ex-2.63. tree->list の 2 つの実装

問 a. 結果に違いはあるか.

なさそう.

問 b. バランスの取れた木を変換する際のオーダー

tree->list-2 は cons のみで連結しているため, 全要素をたどる処理のみの影響のため $O(n)$ のオーダーとなる.

一方で tree->list-1 は, 全要素をたどる処理の $O(n)$ に加えて, left-branch の処理の際に append で連結していっているために left-branch 分はその枝の要素個数分の追加の繰り返しが必要になり, $O(n * \log n)$ の時間がかかる.

このことから tree->list-1 のほうが遅く, tree->list2 のほうが速くなる.

実装

; [ex-2.63.scm]
;
(define (ex-2.63)
    (for-each
        (lambda (tree)
            (print "---");
            (print "tree = " tree)
            (print "tree->list-1 = " (tree->list-1 tree))
            (print "tree->list-2 = " (tree->list-2 tree)))
        (map list-to-tree (sample-sources)))
    #t)


(load "./sec-2.3.3-c")


(define (tree->list-1 tree)
    (if
        (null? tree)
        '()
        (append
            (tree->list-1 (left-branch tree))
            (cons
                (entry tree)
                (tree->list-1 (right-branch tree))))))


(define (tree->list-2 tree)
    (define (copy-to-list tree result-list)
        (if
            (null? tree)
            result-list
            (copy-to-list
                (left-branch tree)
                (cons
                    (entry tree)
                    (copy-to-list (right-branch tree) result-list)))))

    (copy-to-list tree '()))

実行結果

gosh> (ex-2.63)
---
tree = (7 (3 (1 () ()) (5 () ())) (9 () (11 () ())))
tree->list-1 = (1 3 5 7 9 11)
tree->list-2 = (1 3 5 7 9 11)
---
tree = (3 (1 () ()) (7 (5 () ()) (9 () (11 () ()))))
tree->list-1 = (1 3 5 7 9 11)
tree->list-2 = (1 3 5 7 9 11)
---
tree = (5 (3 (1 () ()) ()) (9 (7 () ()) (11 () ())))
tree->list-1 = (1 3 5 7 9 11)
tree->list-2 = (1 3 5 7 9 11)
---
tree = (1 () (2 () (3 () (4 () (5 () (6 () (7 () ())))))))
tree->list-1 = (1 2 3 4 5 6 7)
tree->list-2 = (1 2 3 4 5 6 7)
#t

ex-2.64. list->tree

実行するところまで＞＜。

実装

; [ex-2.64.scm]
;
(define (ex-2.64)
    (for-each
        (lambda (list)
            (print "---");
            (print "list = " list)
            (print "list->tree = " (list->tree list)))
        (map sort (sample-sources)))
    #t)


(load "./sec-2.3.3-c")


(define (list->tree elements)
    (car (partial-tree elements (length elements))))


(define (partial-tree elts n)
    (if
        (= n 0)
        (cons '() elts)
        (let ((left-size (quotient (- n 1) 2)))
            (let ((left-result (partial-tree elts left-size)))
                (let
                    (
                        (left-tree     (car left-result))
                        (non-left-elts (cdr left-result))
                        (right-size    (- n (+ left-size 1)))
                    )
                    (let (
                            (this-entry   (car non-left-elts))
                            (right-result (partial-tree (cdr non-left-elts) right-size))
                        )
                        (let (
                                (right-tree      (car right-result))
                                (remaining-elts (cdr right-result))
                            )
                            (cons
                                (make-tree this-entry left-tree right-tree)
                                remaining-elts))))))))

実行結果

gosh> (ex-2.64)
---
list = (1 3 5 7 9 11)
list->tree = (5 (1 () (3 () ())) (9 (7 () ()) (11 () ())))
---
list = (1 3 5 7 9 11)
list->tree = (5 (1 () (3 () ())) (9 (7 () ()) (11 () ())))
---
list = (1 3 5 7 9 11)
list->tree = (5 (1 () (3 () ())) (9 (7 () ()) (11 () ())))
---
list = (1 2 3 4 5 6 7)
list->tree = (4 (2 (1 () ()) (3 () ())) (6 (5 () ()) (7 () ()