SICP

SICP読書女子会 2.3.3 (#27, #28, #29)

More than 1 year has passed since last update.

順序なしリストとしての集合

; 2.3.3 集合を表現する

; 順序なしリストとしての集合

; 集合にxが含まれているか?
(define (element-of-set? x set)
    (cond 
        ((null? set) #f)
        ((equal? x (car set)) #t)
    (else (element-of-set? x (cdr set)))))


; 集合の積 intersection-set 
(define (intersection-set set1 set2)
    (cond 
        ((or (null? set1) (null? set2)) '())
        ((element-of-set? (car set1) set2)
            (cons (car set1) (intersection-set (cdr set1) set2)))
    (else (intersection-set (cdr set1) set2))))


; Test
(define s1 (list 1 2 3))
(define s2 (list 1 3 5))

(print "s1:" s1)
(print "s2:" s2)

(print "要素が含まれているか")
(print "(element-of-set? 1 s1):" (element-of-set? 1 s1))
(print "(element-of-set? 10 s1):" (element-of-set? 10 s1))
s1:(1 2 3)
s2:(1 3 5)
要素が含まれているか
(element-of-set? 1 s1):#t
(element-of-set? 10 s1):#f

Ex 2.59

(print "===Ex 2.59===")
;練習問題 2.59: 順序なしリストとして表現した集合に対する
;union-set 演算を実装せよ。

(define (union-set base target)
    ;(print "base: " base "target: " target)
    (cond 
        ((null? target) base)
        ((not (element-of-set? (car target) base)) 
            (union-set (cons (car target) base) (cdr target)))
    (else (union-set base (cdr target))))
)

(print "(union-set s1 s2):" (union-set s1 s2))
base: (1 2 3)target: (1 3 5)
base: (1 2 3)target: (3 5)
base: (1 2 3)target: (5)
base: ((1 2 3) . 5)target: ()
(union-set s1 s2):(5 1 2 3)

Ex 2.60

従来の重複なしのリストで表現した場合

名前 意味 計算量
element-of-set? 含むか O(n)
adjoin-set 要素の追加 O(n)
union-set 要素の論理和 O(n^2)
intersection-set 要素の論理積 O(n^2)

重複ありのリストで表現した場合

名前 意味 計算量
element-of-set? 含むか O(n)
adjoin-set 要素の追加 O(1)
union-set 要素の論理和 O(n)
intersection-set 要素の論理積 O(n^2)

※ただしnがドンドンおっきくなってくよね・・・

(print "===Ex 2.60===")
;上の例では、集合は重複のないリストとして表現す
;るよう規定した。ここで、重複を許す場合について考えてみよう。そ
;の場合、例えば {1, 2, 3} という集合は (2 3 2 1 3 2 2) というリス
;トとして表現することもできる。この表現に対して演算を行う手続
;き element-of-set?, adjoin-set, union-set, intersection-set
;を設計せよ。それぞれの効率は、重複なし表現に対する手続きで
;それに対応するものと比べてどうだろうか。重複なしの表現より
;もこの表現のほうが向いているような応用はあるだろうか。

;adjoin-set: 要素の追加
;intersection: 積
;union-set: 和

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

(define (union-set set1 set2)
    (append set1 set2)
)

(print "(adjoin-set 5 s1): " (adjoin-set 5 s1))
(print "(adjoin-set s2 s1): " (adjoin-set s2 s1))

(adjoin-set 5 s1): ((1 2 3) . 5)
(adjoin-set s2 s1): ((1 2 3) 1 3 5)

雑談メモ

> 重複みないの、手抜きっぽいのに処理量へるのなんだかふしぎ〜〜

計算量は減りますけど
set(集合)の目的として、「〜は含まれているか」 の element-of-setが (edited)
メインで使われるものだと思うので (edited)
期待できる時間としては圧倒的にのびますよね。
結局union, intersectionしても、つかわなかったら意味ないですし・・・。

> なるほど。

結局、どの処理を1番メインに使うか。メインで使う関数の計算量を減らせる実装にするのが大事ですね〜><

順序つきリストとしての集合

Ex 2.61

順序ありのリストで表現した場合

名前 意味 計算量
element-of-set? 含むか O(n)
adjoin-set 要素の追加 O(n)
union-set 要素の論理和 O(n)
intersection-set 要素の論理積 O(n)

element-of-set?

計算量としては変わらないけど
平均的には半分しか探索しないので、
実際の探索時間は半減が期待できる

論理和、論理積

順序付だと、element-of-setを使ってのチェックをしなくて済むので一気短くなる♪ O(n^2)-> O(n)

(print "===Ex2.61===")
;順序つき表現を使った adjoin-set を実装せよ。
;element-of-set? から類推して、順序つきであることの利点を生
;かして、順序なしの表現に比べて平均的に半分のステップを必要
;とする手続きを作るやり方を示せ。

; そもそもリストの真ん中に挿入はO(1)で出来る?
; 0~N までのリスト と N~Mまでのリストに分けられるっけ・・・


(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))))
    )
)


(define s1 (list 1 2 3 4 5))
(define s2 (list 1 3 5 7 9))
(print "s1:" s1)
(print "s2:" s2)
(print "(adjoin-set 5 s1):" (adjoin-set 5 s1))
(print "(adjoin-set 4 s2):" (adjoin-set 4 s2))


s1:(1 2 3 4 5)
s2:(1 3 5 7 9)
(adjoin-set 5 s1):(1 2 3 4 5)
(adjoin-set 4 s2):(1 3 4 5 7 9)

メモ

Pairで連結されたやつの間に要素を追加する方法

(define s1 (list 1 2 3 4 5))
(print (cons (car s1) (cons 100 (cdr s1))))

; (1 100 2 3 4 5)
; これで1個目の要素のあとに新しい要素を追加できるっ

Ex 2.62

(print "===Ex2.62===")
; 順序付リストO(n)でunion-setを実装

(define (union-set base target)
    (define (itr result l1 l2)
        ;(print result " " l1 (null? l1) " " l2 (null? l2))
        (cond
            ((and (null? l1) (null? l2)) result)
            ((or 
                (null? l2)
                (and (not (null? l1)) (<= (car l1) (car l2))))
             (itr (cons (car l1) result) (cdr l1) l2))
            ;((or 
            ;    (null? l1)
            ;    (and (not (null? l2)) (> (car l1) (car l2))))
            (else
             (itr (cons (car l2) result) l1 (cdr l2)))
        )
    )
(reverse (itr (list) base target)))

(define s1 (list 1 2 3 4 5))
(define s2 (list 1 3 5 7 9))
(print "s1:" s1)
(print "s2:" s2)
(print "(union-set s1 s2):" (union-set s1 s2))
===Ex2.62===
s1:(1 2 3 4 5)
s2:(1 3 5 7 9)
() (1 2 3 4 5)#f (1 3 5 7 9)#f
(1) (2 3 4 5)#f (1 3 5 7 9)#f
(1 1) (2 3 4 5)#f (3 5 7 9)#f
(2 1 1) (3 4 5)#f (3 5 7 9)#f
(3 2 1 1) (4 5)#f (3 5 7 9)#f
(3 3 2 1 1) (4 5)#f (5 7 9)#f
(4 3 3 2 1 1) (5)#f (5 7 9)#f
(5 4 3 3 2 1 1) ()#t (5 7 9)#f
(5 5 4 3 3 2 1 1) ()#t (7 9)#f
(7 5 5 4 3 3 2 1 1) ()#t (9)#f
(9 7 5 5 4 3 3 2 1 1) ()#t ()#t
(union-set s1 s2):(1 1 2 3 3 4 5 5 7 9)

hioさん別解
こっちのほうがしんぷるだ〜

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

二分木としての集合

Ex 2.63

(print "===Ex2.63===")
(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 '()))

(define s (adjoin-set 5 '()))
(define s2 (adjoin-set 10 s))
(define s3 (adjoin-set 3 s2))
(define s4 (adjoin-set 4 s3))   
(print s4)
;(5 (3 () (4 () ())) (10 () ()))

;     5
;    /\
;   3 10
;   \
;    4

(print (tree->list-1 s4))
(print (tree->list-2 s4))
;(3 4 5 10)
;(3 4 5 10)

(define s (adjoin-set 1 '()))  
(define s (adjoin-set 2 s))
(define s (adjoin-set 3 s))
(define s (adjoin-set 4 s))
(define s (adjoin-set 5 s))
(define s (adjoin-set 6 s))
(define s (adjoin-set 7 s))
(print s)

(print "tree->list-1: " (tree->list-1 s))
(print "tree->list-2: " (tree->list-2 s))
;tree->list-1: (1 2 3 4 5 6 7)
;tree->list-2: (1 2 3 4 5 6 7)

a.

おんなじ

b.

1: O(nlogn) 毎回半分ずつappendするので
2: O(n)

サンプルの作り方

サンプルの作り方はこっちの方がいい!

(define s (fold adjoin-set '() (list 1 2 3 4 5 6 7)))
; (1 () (2 () (3 () (4 () (5 () (6 () (7 () ())))))))


memo

長さn のlistに別の長さnのlistをappendするのってOrder的にn

log n 回 tree->list-1が呼び出されて
その中のappendがnだから
1は O(n log n)

Ex 2.64

Quotient: 余り

(print "===Ex2.64===")
(define (list->tree elements)
    (car (partial-tree elements (length elements))))


(define (partial-tree elts n)
    ;(print "partial-tree  elts:" elts " n:" n)
    (if (= n 0)
        (cons '() elts)
        (let
            (
                (left-size (quotient (- n 1) 2)); leftsize = n / 2
            ) 
            (let
                (
                    (left-result (partial-tree elts left-size)) ;leftresult = elementのleft-size分
                )
                (let 
                    (
                        (left-tree (car left-result))           ; left-tree         = left-resultの1こめ
                        (non-left-elts (cdr left-result))       ; non-left-elts     = leftresultののこり
                        (right-size (- n (+ left-size 1)))      ; right-size        = (n - leftsize) + 1
                    )
                    (let 
                        (
                            (this-entry (car non-left-elts))    ; this entry = non-left-eltsの1こめ
                            (right-result                       ; right-result = left-resultの3こめ以降の木
                                (partial-tree
                                    (cdr non-left-elts)
                                    right-size))
                        )
                        (let 
                            (
                                (right-tree (car right-result))     ; right-tree: right-resultの1番最初
                                (remaining-elts (cdr right-result)) ; のこり: right resultの2こ目以降
                            )

                            (cons
                                (make-tree
                                    this-entry
                                    left-tree
                                    right-tree)
                                remaining-elts )
                        )))))))

(define l (list 1 2 3 4 5 6 7))



;  2
; /\
;1  3  (4 5 6 7)

;  2                 5
; /\                /\
;1  3  と (4 ) と  6  7
; 
;     4
;    /\
;  2    5
; /\   /\
;1  3  6  7

挙動

#?="./2.3.3.scm":301:(cons (make-tree this-entry left-tree right-tree) remaining-elts)
#?-    ((1 () ()) 2 3 4 5 6 7)
#?="./2.3.3.scm":301:(cons (make-tree this-entry left-tree right-tree) remaining-elts)
#?-    ((3 () ()) 4 5 6 7)
#?="./2.3.3.scm":301:(cons (make-tree this-entry left-tree right-tree) remaining-elts)
#?-    ((2 (1 () ()) (3 () ())) 4 5 6 7)
#?="./2.3.3.scm":301:(cons (make-tree this-entry left-tree right-tree) remaining-elts)
#?-    ((5 () ()) 6 7)
#?="./2.3.3.scm":301:(cons (make-tree this-entry left-tree right-tree) remaining-elts)
#?-    ((7 () ()))
#?="./2.3.3.scm":301:(cons (make-tree this-entry left-tree right-tree) remaining-elts)
#?-    ((6 (5 () ()) (7 () ())))
#?="./2.3.3.scm":301:(cons (make-tree this-entry left-tree right-tree) remaining-elts)
#?-    ((4 (2 (1 () ()) (3 () ())) (6 (5 () ()) (7 () ()))))
(4 (2 (1 () ()) (3 () ())) (6 (5 () ()) (7 () ())))
;1-14
#?="./2.3.3.scm":301:(cons (make-tree this-entry left-tree right-tree) remaining-elts)
#?-    ((2 () ()) 3 4 5 6 7 8 9 10 11 12 13 14)
#?="./2.3.3.scm":301:(cons (make-tree this-entry left-tree right-tree) remaining-elts)
#?-    ((1 () (2 () ())) 3 4 5 6 7 8 9 10 11 12 13 14)
#?="./2.3.3.scm":301:(cons (make-tree this-entry left-tree right-tree) remaining-elts)
#?-    ((4 () ()) 5 6 7 8 9 10 11 12 13 14)
#?="./2.3.3.scm":301:(cons (make-tree this-entry left-tree right-tree) remaining-elts)
#?-    ((6 () ()) 7 8 9 10 11 12 13 14)
#?="./2.3.3.scm":301:(cons (make-tree this-entry left-tree right-tree) remaining-elts)
#?-    ((5 (4 () ()) (6 () ())) 7 8 9 10 11 12 13 14)
#?="./2.3.3.scm":301:(cons (make-tree this-entry left-tree right-tree) remaining-elts)
#?-    ((3 (1 () (2 () ())) (5 (4 () ()) (6 () ()))) 7 8 9 10 11 12  ...
#?="./2.3.3.scm":301:(cons (make-tree this-entry left-tree right-tree) remaining-elts)
#?-    ((8 () ()) 9 10 11 12 13 14)
#?="./2.3.3.scm":301:(cons (make-tree this-entry left-tree right-tree) remaining-elts)
#?-    ((10 () ()) 11 12 13 14)
#?="./2.3.3.scm":301:(cons (make-tree this-entry left-tree right-tree) remaining-elts)
#?-    ((9 (8 () ()) (10 () ())) 11 12 13 14)
#?="./2.3.3.scm":301:(cons (make-tree this-entry left-tree right-tree) remaining-elts)
#?-    ((12 () ()) 13 14)
#?="./2.3.3.scm":301:(cons (make-tree this-entry left-tree right-tree) remaining-elts)
#?-    ((14 () ()))
#?="./2.3.3.scm":301:(cons (make-tree this-entry left-tree right-tree) remaining-elts)
#?-    ((13 (12 () ()) (14 () ())))
#?="./2.3.3.scm":301:(cons (make-tree this-entry left-tree right-tree) remaining-elts)
#?-    ((11 (9 (8 () ()) (10 () ())) (13 (12 () ()) (14 () ()))))
#?="./2.3.3.scm":301:(cons (make-tree this-entry left-tree right-tree) remaining-elts)
#?-    ((7 (3 (1 () (2 () ())) (5 (4 () ()) (6 () ()))) (11 (9 (8 () ...
(7 (3 (1 () (2 () ())) (5 (4 () ()) (6 () ()))) (11 (9 (8 () ()) (10 () ())) (13 (12 () ()) (14 () ()))))
  1. リストの真ん中をとってきて
  2. そこから真ん中以外の左と右にわける
  3. 1.繰り返し

みたいないめーじ

a.

(print (list->tree l))
;     4
;    / \
;  2     6
; /\     /\
;1  3   5  7

b.
O (n)

Ex.2.65

(print "===Ex2.65===")

;(論理和)
(define (union-set set1 set2)
    (define (union-set-i set l)
        ;(print set l)
        (if 
            (null? l)
            set
            (let 
                (
                    (first (car l))
                    (lst (cdr l))) 
                (union-set-i (adjoin-set first set) lst)
            )
        )
    )
    (union-set-i set1 (tree->list-1 set2))
)

(define l1 (list 1 2 3 4 5 6 7))
(define l2 (list 1 3 5 7 9))
(print (union-set (list->tree l1) (list->tree l2)))

1個の要素追加にかかるコストがlog_n
なのでこれだと O(n log_n)

(print "===O(n)===")
;; ?
(define (union-set set1 set2)
    (define (union-list base target)
        ; 最後の要素が同じでなければ追加
        (define (add x l)
            (cond 
                ((null? l) (cons x l))
                ((= (car l) x) l)
                (else (cons x l))
            ))

        (define (itr result l1 l2)
            (print result " " l1 (null? l1) " " l2 (null? l2))
            (cond
                ((and (null? l1) (null? l2)) result)
                ;((null? l2) ())
                ((or 
                    (null? l2)
                    (and (not (null? l1)) (<= (car l1) (car l2))))
                 (itr (add (car l1) result) (cdr l1) l2))
                (else
                    (itr (add (car l2) result) l1 (cdr l2)))

            )
        )
    (reverse (itr (list) base target)))
    (list->tree (union-list (tree->list-1 set1) (tree->list-1 set2)))
)
(print (union-set (list->tree l1) (list->tree l2)))

;() (1 2 3 4 5 6 7)#f (1 3 5 7 9)#f
;(1) (2 3 4 5 6 7)#f (1 3 5 7 9)#f
;(1) (2 3 4 5 6 7)#f (3 5 7 9)#f
;(2 1) (3 4 5 6 7)#f (3 5 7 9)#f
;(3 2 1) (4 5 6 7)#f (3 5 7 9)#f
;(3 2 1) (4 5 6 7)#f (5 7 9)#f
;(4 3 2 1) (5 6 7)#f (5 7 9)#f
;(5 4 3 2 1) (6 7)#f (5 7 9)#f
;(5 4 3 2 1) (6 7)#f (7 9)#f
;(6 5 4 3 2 1) (7)#f (7 9)#f
;(7 6 5 4 3 2 1) ()#t (7 9)#f
;(7 6 5 4 3 2 1) ()#t (9)#f
;(9 7 6 5 4 3 2 1) ()#t ()#t
;(1 2 3 4 5 6 7 9)
;(4 (2 (1 () ()) (3 () ())) (6 (5 () ()) (7 () (9 () ()))))
(print "===intersection(積)===")
(define (intersection-set set1 set2)
    (define (intersection-list base target)
        (print base target)
        (if (or (null? base) (null? target))
            '()
            (let ((x1 (car base)) (x2 (car target)))
                (cond 
                    ((= x1 x2) (cons x1 (intersection-list (cdr base) (cdr target))))
                    ((< x1 x2) (intersection-list (cdr base) target))
                    ((< x2 x1) (intersection-list base (cdr target)))))
        )
    )
    (list->tree  (intersection-list (tree->list-1 set1) (tree->list-1 set2)))
)
(print (intersection-set (list->tree l1) (list->tree l2)))
;(1 2 3 4 5 6 7)(1 3 5 7 9)
;(2 3 4 5 6 7)(3 5 7 9)
;(3 4 5 6 7)(3 5 7 9)
;(4 5 6 7)(5 7 9)
;(5 6 7)(5 7 9)
;(6 7)(7 9)
;(7)(7 9)
;()(9)
;(3 (1 () ()) (5 () (7 () ())))

これだと2・nで実行できるので O(n) かな?

二分木で実装した場合の計算量

名前 意味 計算量(平均) 計算量(最悪)
element-of-set? 含むか O(log n) O(n)
adjoin-set 要素の追加 O(log n) O(n)
union-set 要素の論理和 O(n) O(n)
intersection-set 要素の論理積 O(n) O(n)

Ex.2.66

(print "===Ex2.66===")

(define (make-record k v) (list k v))
(define (key record) (car record))
(define (value record) (cadr record))

(define (lookup k records)
    ;(print records)
    (if 
        (null? records) 
        #f
        (let 
            ((record (entry records)))
            (cond 
                ((= k (key record)) (value record))
                ((< k (key record)) (lookup k (left-branch records)))
                ((> k (key record)) (lookup k (right-branch records)))
            ))
    )
)


(define _records
    (list->tree
    (list (make-record 1 "a") (make-record 2 "b") (make-record 3 "ab")))
)

(print (lookup 1 _records)) ;a
(print (lookup 3 _records)) ;ab