1
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 5 years have passed since last update.

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

Last updated at Posted at 2016-12-07

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

; 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
1
0
1

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
1
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?