Hatena::Groupsicp

SICP in the blanket

2008-10-24

2.3.3 集合の表現

00:58 | はてなブックマーク -  2.3.3 集合の表現 - SICP in the blanket  2.3.3 集合の表現 - SICP in the blanket のブックマークコメント

abstract data type としてまず操作を定義する: union-set, intersection-set, element-of-set? adjoin-set.

ここでは Red Black Tree や AVL Tree は無し.

Unordered List

;; 重複なしリスト
(define empty-set '())

(define (element-of-set? x set)
  (cond [(null? set) #f]
        [(equal? x (car set)) #t]
        [else (element-of-set? x (cdr set))]))

(define (adjoin-set x set)
  (if (element-of-set? x set)
      set
      (cons x set)))

(define (intersection-set s1 s2)
  (cond [(or (null? s1) (null? s2)) empty-set]
        [(element-of-set? (car s1) s2)
         (cons (car s1)
               (intersection-set (cdr s1) s2))]
        [else
         (intersection-set (cdr s1) s2)]))

;; ex2.59
(define (union-set s1 s2)
  (cond [(null? s1) s2]
        [(null? s2) s1]
        [(element-of-set? (car s1) s2)
         (union-set (cdr s1) s2)]
        [else
         (cons (car s1)
               (union-set (cdr s1) s2))]))
;; ex2.60
;; 重複ありリスト
(define adjoin-set cons)
(define union-set append)

ほとんど重複が起こりえないような状況なら重複あり使ってもいいかも.

Ordered List

(define empty-set '())

(define (element-of-set? x set)
  (cond [(null? set) #f]
        [(= x (car set)) #t]
        [(< x (car set)) #f]
        [else (element-of-set? x (cdr set))]))

(define (intersection-set s1 s2)
  (if (or (null? s1) (null? s2))
      empty-set
      (let ((x1 (car s1)) (x2 (car s2)))
        (cond [(= x1 x2)
               (cons x1 (intersection-set (cdr s1) (cdr s2)))]
              [(< x1 x2)
               (intersection-set (cdr s1) s2)]
              [else
               (intersection-set s1 (cdr s2))]))))

;; ex2.61
(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)))]))

;; ex2.62
(define (union-set s1 s2)
  (cond [(null? s1) s2]
        [(null? s2) s1]
        [else
         (let ((x1 (car s1)) (x2 (car s2)))
           (cond [(= x1 x2)
                  (cons x1 (union-set (cdr s1) (cdr s2)))]
                 [(< x1 x2)
                  (cons x1 (union-set (cdr s1) s2))]
                 [else
                  (cons x2 (union-set s1 (cdr s2)))]))]))

Binary Search Tree

ex2.63

この種の書き換えは頻出.(例: shows使ってshowを実装とか in Haskell)

なんか名前ついてないのかな?

  • a. 結果は同じ.木の構造に関する帰納法で簡単に示せる.
  • b. 引数に結果を溜めていくと線形で済むのに対し,append使うと毎回中間リストを生成するのでΘ(n^2)になるのでは.
ex2.64
;; ex2.64
(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))
             (left-result (partial-tree elts left-size))
             (left-tree (car left-result))
             (non-left-elts (cdr left-result))
             (right-size (- n (+ left-size 1)))
             (this-entry (car non-left-elts))
             (right-result (partial-tree (cdr non-left-elts)
                                         right-size))
             (right-tree (car right-result))
             (remaining-elts (cdr right-result)))
        (cons (make-tree this-entry left-tree right-tree)
              remaining-elts))))

partial-tree は

  • (take elts n)をbalanced tree にしたもの
  • (drop elts n)

のペアを返す (多値を返す方が自然).

this-entry 以外の(n-1)個を左右に半分ずつ分けて再帰的に balanced tree を構成する.

線形時間でできる.

ex2.65

Ordered List 表現に直して計算してやればΘ(n)でできる.

(define (union-set s1 s2)
  (list->tree (union-olist (tree->list-2 s1)
                           (tree->list-2 s2))))

(define (intersection-set s1 s2)
  (list->tree (intersection-olist (tree->list-2 s1)
                                  (tree->list-2 s2))))
ex2.66

そのまんま.

(define (lookup given-key set-of-records)
  (cond [(null? set-of-records) #f]
        [(= given-key (car (entry set-of-records)))
         (entry set-of-records)]
        [(< given-key (car (entry set-of-records)))
         (lookup given-key (left-branch set-of-records))]
        [else
         (lookup given-key (right-branch set-of-records))]))

2.3.2 記号微分

00:58 | はてなブックマーク -  2.3.2 記号微分 - SICP in the blanket  2.3.2 記号微分 - SICP in the blanket のブックマークコメント

操作対象が普通のS式なところが美しい.

note:[differentiation:微分, derivative:導関数]

ex2.56

(define (make-exponentiation b e)
  (cond [(=number? e 0) 1]
        [(=number? e 1) b]
        [else (list '** b e)]))

(define (exponentiation? e)
  (and (pair? e) (eq? '** (car e))))

(define base cadr)
(define exponent caddr)
(define ** expt)
  ;; in deriv
  ;; assume (exponent exp) doesn't contain var
  [(exponentiation? exp)
   (make-product
      (make-product (exponent exp)
                    (make-exponentiation (base exp)
                                         (make-sum (exponent exp) -1)))
      (deriv (base exp) var))]

ex2.57

;; ex2.57
(define (augend e)
  (cond [(or (null? e)
             (null? (cdr e))
             (null? (cddr e))) 0]
        [(null? (cdddr e)) (caddr e)]
        [else (cons '+ (cddr e))]))

(define (multiplicand e)
  (cond [(or (null? e)
             (null? (cdr e))
             (null? (cddr e))) 1]
        [(null? (cdddr e)) (caddr e)]
        [else (cons '* (cddr e))]))

ex2.58

a. 常に括弧がついているなら sum?, addend, augend, product? multiplier, multiplicand あたりをいじるだけで deriv はそのままでいけると思う.

b. S式をいじって括弧を補ってやればいいんじゃないかしら.演算子の優先順位とか面倒そうだけど.


Debugging in Gauche

00:49 | はてなブックマーク -  Debugging in Gauche - SICP in the blanket  Debugging in Gauche - SICP in the blanket のブックマークコメント

Gauche はエラーメッセージがしょぼすぎる.

最適化しなくていいからデバッグ情報多くするようなオプションないのかな.


メモ

http://d.hatena.ne.jp/higepon/20080213/1202919364

format, debug-print(#?=), trace, d

個人的には #?= をよく使う.デバッガも欲しいなー.

HoucineHoucine2012/10/06 22:17Plseiang you should think of something like that

scdmxiscdmxi2012/10/07 17:44UvO1X4 <a href="http://bxtsehkomsbt.com/">bxtsehkomsbt</a>

tdrwemytxctdrwemytxc2012/10/08 04:12U2wCMK , [url=http://jhezyygxtbyo.com/]jhezyygxtbyo[/url], [link=http://xdhegniqrtgf.com/]xdhegniqrtgf[/link], http://sflnpaysxukf.com/

twexqimtwexqim2012/10/08 17:50kdHYHT <a href="http://dpttfgutirib.com/">dpttfgutirib</a>

ngvyqyangvyqya2012/10/10 02:10f2XUxa , [url=http://wlgfrcxnxlgk.com/]wlgfrcxnxlgk[/url], [link=http://lenfvpaehlzv.com/]lenfvpaehlzv[/link], http://ousbumzwrtaq.com/

トラックバック - http://sicp.g.hatena.ne.jp/blanketsky/20081024