Hatena::Groupsicp

SICP in the blanket

2008-11-22

2.3.4 Huffman符号化木

00:58 | はてなブックマーク -  2.3.4 Huffman符号化木 - SICP in the blanket  2.3.4 Huffman符号化木 - SICP in the blanket のブックマークコメント

ex2.68: エンコード

一文字ごとにDFSする実装.

最初に符号化表みたいなものを作ってからメッセージ全体を一気に符号化する方が素直だと思うけれど.

;; ex2.68
(define (encode message tree)
  (if (null? message)
      '()
      (append (encode-symbol (car message) tree)
              (encode (cdr message) tree))))

(define (encode-symbol sym tree)
  (define (dfs tree code)
    (if (leaf? tree)
        (if (eq? (symbol-leaf tree) sym)
            (reverse code)
            #f)
        (or (dfs (left-branch tree)  (cons 0 code))
            (dfs (right-branch tree) (cons 1 code)))))
  (or (dfs tree '())
      (error "symbol not found" sym)))

ex2.69: ハフマン木の構成

集合から重みの小さいの二個取って一つにまとめて再度つっ込む,の繰り返し.Priority Queue 使うと効率よく実装できる.

;; 2.69
(define (generate-huffman-tree pairs)
  (successive-merge (make-leaf-set pairs)))

(define (successive-merge trees)
  (cond [(null? trees) (error "empty tree")]
        [(null? (cdr trees)) (car trees)]
        [else
         (successive-merge
          (adjoin-set (make-code-tree (car trees)
                                      (cadr trees))
                      (cddr trees)))]))

ex2.70

;; 2.70
(define rock-tree
  (generate-huffman-tree
   '((A 2) (BOOM 1) (GET 2) (JOB 2)
     (NA 16) (SHA 3) (YIP 9) (WAH 1))))

(define (symbol-upcase sym)
  (use srfi-13)
  (string->symbol (string-upcase (symbol->string sym))))

(define rock-message
  (map symbol-upcase
       '(Get a job
         Sha na na na na na na na na
         Get a job
         Sha na na na na na na na na
         Wah yip yip yip yip yip yip yip yip yip
         Sha boom)))

; gosh> (encode rock-message rock-tree)
; (1 1 1 1 1 1 1 0 0 1 1 1 1 0 1 1 1 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 0 0 1 1 1 1 0 1 1 1 0 0 0 0 0 0 0 0 0 1 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 1 1 0 1 1 0 1 1)
; gosh> (length (encode rock-message rock-tree))
; 84
; gosh> (* 3 (length rock-message))
; 108

ex2.71

最も偏った二分木になる.

  • 最高頻度の記号: 1 bit
  • 最低頻度の記号: n-1 bits

ex2.72

Huffman木の葉の数(アルファベット数)をNとする.

上記の実装だと 2.71 のケースにおいて,generate-huffman-tree は左に偏った木を作り,encode時のdfsは左の枝から先に探すので

  • 最高頻度の記号が一番遅く,木の節数(2N) steps
  • 最低頻度の記号が一番早く,N steps

dfsの順番を逆にして右の枝から探索するようにすると,

  • 最高頻度の記号が一番早く,1 step
  • 最低頻度の記号が一番遅く,木の節数(2N) steps

DFSの探索ステップ数は平均的にはO(N).

RobbieRobbie2012/01/09 22:55Always a good job right here. Keep roillng on through.

ifuyjqzhueifuyjqzhue2012/01/10 17:19xo9nFb <a href="http://nuuzbpzyrbml.com/">nuuzbpzyrbml</a>

spewhjgcspewhjgc2012/01/10 23:529WTfCu , [url=http://pzosbgnunhso.com/]pzosbgnunhso[/url], [link=http://ltmlodiuszzd.com/]ltmlodiuszzd[/link], http://sybfvrkmnfar.com/

tyympnlcohltyympnlcohl2012/01/12 23:09wPxYOw <a href="http://kddcgdripmrb.com/">kddcgdripmrb</a>

nfqvxevcvnfqvxevcv2012/01/15 02:05p23W6g , [url=http://odzdgzibyvgi.com/]odzdgzibyvgi[/url], [link=http://jgzvkadsolqy.com/]jgzvkadsolqy[/link], http://urvnnvejqneu.com/

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

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

2008-10-03

2.2.4 図形言語

00:43 | はてなブックマーク - 2.2.4 図形言語 - SICP in the blanket 2.2.4 図形言語 - SICP in the blanket のブックマークコメント

ex2-51まで。

やっぱ視覚的に結果が出ると楽しいですね。

f:id:blanketsky:20081004004103p:image

f:id:blanketsky:20081004010246p:image

f:id:blanketsky:20081004012621p:image

f:id:blanketsky:20081004013529p:image


こちらの描画ツールを使わせていただきました。

http://d.hatena.ne.jp/kkanda/20080507/p1

LaviniaLavinia2011/04/11 00:36fAx6Jp I'm out of league here. Too much brain power on display!

qxgmkidbaqeqxgmkidbaqe2011/04/12 04:52MumdLt <a href="http://lfszgvwlwymm.com/">lfszgvwlwymm</a>

nirwsebonirwsebo2011/04/23 02:41qFvk1v <a href="http://kekazlrwjomq.com/">kekazlrwjomq</a>

syjroghtyvssyjroghtyvs2011/04/24 11:30CcyPyG , [url=http://bysohqxusotf.com/]bysohqxusotf[/url], [link=http://pgfeyouraqlf.com/]pgfeyouraqlf[/link], http://okwcwmzzmqql.com/

SumitSumit2013/08/07 13:24That's a subtle way of thniikng about it.

RemediosRemedios2013/08/09 07:39<a href="http://cbpsjhhal.com">Hahhaaha.</a> I'm not too bright today. Great post!

SaudSaud2013/08/15 13:43I read your post and wisehd I was good enough to write it http://jgqszxul.com [url=http://anqtvt.com]anqtvt[/url] [link=http://mmpxelz.com]mmpxelz[/link]

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

2008-09-26

2章 - N Queen

01:54 | はてなブックマーク - 2章 - N Queen - SICP in the blanket 2章 - N Queen - SICP in the blanket のブックマークコメント

ex2.42

一応貼っとく

(define empty-board '())

(define (enumerate-interval a b)
  (if (> a b) '()
      (cons a (enumerate-interval (+ a 1) b))))

(define (safe? k positions)
  (define (collide x y)
    (let ((c1 (car x)) (r1 (cdr x))
          (c2 (car y)) (r2 (cdr y)))
      (or (= c1 c2) (= r1 r2)
          (= (+ c1 r1) (+ c2 r2))
          (= (- c1 r1) (- c2 r2)))))
  (let ((kth (car positions)))
    (accumulate (lambda (x y) (and x y))
                #t
                (map (lambda (x) (not (collide kth x)))
                     (cdr positions)))))

(define (adjoin-position r c qs)
  (cons (cons c r) qs))

(define (queens board-size)
  (define (queen-cols k)
    (if (= k 0)
        (list empty-board)
        (filter
         (lambda (positions) (safe? k positions))
         (flatmap
          (lambda (rest-of-queens)
            (map (lambda (new-row)
                   (adjoin-position new-row k rest-of-queens))
                 (enumerate-interval 1 board-size)))
          (queen-cols (- k 1))))))
  (queen-cols board-size))

ex2.43

漸化式は 2.42のが

T(n) = T(n-1) + A*n*q(n-1) + B

で2.43のが

T'(n) = n*T'(n-1) + A*n*q(n-1) + B

ぐらいか? (q(n)はn-queenの解の数, A,Bは適当な定数)

なんか n が十分でかくなると n! 倍ぐらい差が出そうな感じ?

2章

01:16 | はてなブックマーク - 2章 - SICP in the blanket 2章 - SICP in the blanket のブックマークコメント

accumulate

SICPでは結果を右に溜める fold-right として定義されている。(R6RSの fold-right と同じ)

(define (accumulate f a xs)
  (if (null? xs) a
      (f (car xs)
         (accumulate f a (cdr xs)))))

Gaucheの(SRFI-1 の) fold も結果を右に溜める

gosh> (fold cons '() '(1 2 3 4))
(4 3 2 1)
gosh> (fold-right cons '() '(1 2 3 4))
(1 2 3 4)

enumerate-tree

preorderで辿る。ここでの tree はリストのリスト。

(define (enumerate-tree tree)
  (cond [(null? tree) '()]
        [(not (pair? tree)) (list tree)]
        [else (append (enumerate-tree (car tree))
                      (enumerate-tree (cdr tree)))]))

ex2.35

何をさせたいのか謎。

(define (count-leaves2 t)
  (accumulate (lambda (x a) (+ a (length x)))
              0
              (map enumerate-tree t)))

ex2.36

(define s1 '((1 2 3) (4 5 6) (7 8 9) (10 11 12)))
(define (accumulate-n op init seqs)
  (if (null? (car seqs))
      '()
      (cons (accumulate op init (map car seqs))
            (accumulate-n op init (map cdr seqs)))))

ex2.37

vector and matrix

(define m1 '((1 2 3 4) (4 5 6 6) (6 7 8 9)))

(define (dot-product v w)
  (accumulate + 0 (map * v w)))

(define (matrix-*-vector m v)
  (map (lambda (w) (dot-product v w))
       m))

(define (transpose mat)
  (accumulate-n cons '() mat))

(define (matrix-*-matrix m n)
  (let ((cols (transpose n)))
    (map (lambda (v) (matrix-*-vector cols v))
         m)))

ex2.38

結合律

ex2.39

fold-right の方はいかにも無駄が多い。

(define (reverse1 seq)
  (fold-right (lambda (x y) (append y (list x))) '() seq))

(define (reverse2 seq)
  (fold-left (lambda (x y) (cons y x)) '() seq))

ex2.40

(define (unique-pairs n)
  (flatmap (lambda (i)
             (accumulate (lambda (j a) (cons `(,i ,j) a))
                         '()
                         (iota (- i 1) 1)))
           (iota (- n 1) 2)))

ex2.41

flatmap を素直に使うとかなり読みづらくなる。

内包表記を使うとスッキリ。(SRFI-42)

(use srfi-42)
(define (ex2-41 s)
  (list-ec (: x 1 s)
           (: y 1 x)
           (: z 1 y)
           (if (= s (+ x y z)))
           (list x y z)))

1章

23:32 | はてなブックマーク - 1章  - SICP in the blanket 1章  - SICP in the blanket のブックマークコメント

今ざっと読み返して気になったところだけ適当に拾っていく。

Ackermann関数

なんかUnion-findの計算量を解析する時とかに出てくるやつ。

(define (A x y)
  (cond [(= x 0) (* 2 y)]
        [(= y 0) 0]
        [(= y 1) 2]
        [else    (A (- x 1)
                    (A x (- y 1)))]))
  • (A 0 0) = 0 ; (A 0 n) = (+ 2 (A 0 (- n 1)))
    • (A 0 n) = 2*n
  • (A 1 0) = 0 ; (A 1 n) = (* 2 (A 1 (- n 1)))
    • (A 1 n) = 2^n
  • (A 2 0) = 0 ; (A 2 n) = (expt 2 (A 2 (- n 1)))

Fibonacci, 黄金比φ

  • φ = (1 + √5) / 2
  • ψ = (1 - √5) / 2
  • |ψ|^n < √5 / 2
  • fib(n) = (φ^n - ψ^n) / √5
  • = (φ^n / √5) - ε ( |ε| < 1/2 )
  • fib(n) は φ^n / √5 に最も近い整数
  • Lameの定理: GCD(a,b)でkステップかかる ⇒ min(a,b) ≧ fib(k)

素数判定とか

後で使うのでライブラリ化しとく

(use math.mt-random)
(define generator (make <mersenne-twister> :seed (sys-time)))
(define (random n) ; generates a random integer between 1 .. n
  (+ 1 (mt-random-integer generator n))

;; x^n mod m
(define (expmod x n m)
  (define (squaremod x) (remainder (* x x) m))
  (cond [(= n 0) 1]
        [(even? n)
         (squaremod (expmod x (ash n -1) m))]
        [else
         (remainder (* x (expmod x (- n 1) m))
                    m)]))

;; Fermat test
(define (fermat-test n a)
  (= (expmod a (- n 1) n)
     1))

;; k-q decomposition
;; n = 2^k * q
(define (k&q n)
  (define (decomp k q)
    (if (odd? q)
        (list k q)
        (decomp (+ k 1) (ash q -1))))
  (decomp 0 n))

;; Miller-Rabin test
(define (miller-rabin-test n a)
  (define (squares k xs)
    (if (= k 0)
        xs
        (squares (- k 1)
                 (cons (expmod (car xs) 2 n) xs))))
  (define (traverse xs)
    (cond [(null? xs) #t]
          [(= (car xs) (- n 1))  #t]
          [(= (car xs) 1) (traverse (cdr xs))]
          [else #f]))
  (let* ([kq (k&q (- n 1))]
         [k  (car  kq)]
         [q  (cadr kq)]
         [xs (squares k `(,(expmod a q n)))])
    (if (= (car xs) 1)
        (traverse (cdr xs))
        #f)))

;; Prime Checker
(define (prime? n)
  (define times 5)
  (define (rand-test)
    (let ([a (random (- n 1))])
      (if (= (gcd a n) 1)
          (miller-rabin-test n a)
          #f)))
  (define (try i)
    (cond [(= i 0) #t]
          [(rand-test) (try (- i 1))]
          [else #f]))
  (if (<= n 1) #f (try times)))


;; Carmichael Numbers
(define carmichaels
  '(561 1105 1729 2465 2821 6601))

SICP and me

23:07 | はてなブックマーク -  SICP and me - SICP in the blanket  SICP and me - SICP in the blanket のブックマークコメント

1度目: 2006年初頭 / 2章頭ぐらいまで

2度目: 2007年初頭 / 図形言語手前まで

3度目の挑戦として、今年の6月頃からnyaxtさん主催のオンライン読書会に参加しています。

せっかくなのでこちらにログを残していこうと思います。

MattinglyMattingly2012/01/09 19:57Good to see real expertise on display. Your cotnrbiution is most welcome.

exjurlpgksoexjurlpgkso2012/01/10 17:23LtAXNu <a href="http://qwymdffdvjgu.com/">qwymdffdvjgu</a>

igtnwvigtnwv2012/01/15 01:29lgrZ4A , [url=http://dgncekoxiect.com/]dgncekoxiect[/url], [link=http://kgqqnwfzdjcy.com/]kgqqnwfzdjcy[/link], http://jtteuxkxmnoa.com/

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