Hatena::Groupsicp

SICP in the blanket

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さん主催のオンライン読書会に参加しています。

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

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

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

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

ゲスト



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