Hatena::Groupcsnagoya-sicp

クラなんとかの日記 このページをアンテナに追加 RSSフィード

2009-10-14

2.32

| 17:13 | 2.32 - クラなんとかの日記 を含むブックマーク はてなブックマーク - 2.32 - クラなんとかの日記 2.32 - クラなんとかの日記 のブックマークコメント

もっかい考えてみた.

n を集合のサイズとする.

n = 0 の場合(集合=S(0))

部分集合全体の集合ss(S(0))は,{()} の1つ.

n = 1 の場合(集合=S(1))

x_1 を要素とすると,部分集合全体の集合ss(S(1))は,{(), (x_1)} の2つ.

n = 2 の場合(集合=S(2))

x_2 を追加の要素とすると,ss(S(2)) = {(), (x_1), (x_2), (x_2, x_1)} の4つ

ss(S(2)) = {ss(S(1)), x_2 + ss(S(1))}

つまり,

n = k の場合,(集合=S(k))

ss(S(k)) = {ss(S(k-1)), x_k + ss(S(k-1))}

という関係が見てとれる.

つまり,新しい要素を含まない部分集合全体(ss(S(k-1)))と

新しい要素を含んでいる部分集合全体(x_k + ss(S(k-1))) の組合せがある.

こうやって見ると,常に部分集合の全体集合のサイズは,2^n となることもわかる.

(毎回二倍になるので.

2009-07-05このニコタマが好きだから

2.42

| 2.42 - クラなんとかの日記 を含むブックマーク はてなブックマーク - 2.42 - クラなんとかの日記 2.42 - クラなんとかの日記 のブックマークコメント

エイトクイーンパズルです.

日本語訳版を忘れたので,拙訳

エイトクイーンパズルは,チェス盤に
どのクイーンも互いに取られないような
8つのクイーンの置き方を答えるものです.
(例えば,2つのクイーンは同じ縦,横,斜めの線上に無いということです)
1つの解を,図2.8 に示します.
パズルを解く1つの方法は,盤上に順番に,
各列それぞれにクイーンを置くことです.
k-1個のクイーンを一旦置ければ,
k 番目のクイーンが,盤上に既に置かれたクイーンのどれにもチェックされない,
場所に置かれなければなりません.
このアプローチを,再帰的に形式化することができる.
k-1列の盤上に,k-1個のクイーンが置かれる,全ての可能な組み合わせが生成されていると仮定する.
それらの組み合わせそれぞれに対して,k番目の列の全行にクイーンを置いた拡張された集合を生成する.
それをフィルターし,他のクイーンと干渉しない安全な行にクイーンを置いたものだけ残す.
これで,k列にk 個のクイーンが置かれた全組み合わせを生成する.
この手続きを繰り返すことによって,1つだけでなく,全てのパズルの解を得られる.

この解法をqueens という手続きで実装する.
これは,n x nのチェス盤にn個のクイーンを置く問題への全ての解の列を返す.
queens は,queens-cols という盤上の先頭k column 分のクイーンの位置の全
部の場合のシーケンスを返す内部手続きを持つ.

この手続きの中で,rest-of-queens は,先頭のk-1列の中のk-1個のクイーン
の位置の1つの状態であり,
new-row は,k番目のcolumn に対する,queen の位置の1つの提案を差す.
盤の位置の集合を表現と,
位置集合に新しいrow-column を追加する adjoin-position,
位置集合が空である場合の表現 empty-board 手続き
を実装することで,このプログラムを完成させなさい.
それには,k 番目のcolumn の中のクイーンが,他のものと干渉していないか
どうかを,位置集合が決定するsafe? 手続きも書かなければならない,
(ここで,新しいクイーンのみをsafe であることをチェックすればよいことを
注釈する.残りのクイーンは,既に保証されている)

# row - 行, column - 列

方針としては,再帰的に n x (k-1) から n x k の盤を作るというもの.

こうすれば,k 行目のクイーン1つだけをチェックすればよくなる.

queens は,全解を得るための関数.

queen-cols は,n x k の盤のうち許されるものを返す.

埋める関数は,以下.

  • adjoin-position
  • empty-board
  • safe?
(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))

ということで,ポジションのxy座標をリストにして持つ感じの実装してみた.

nth みたいなのを使うとアレかもしれん.

#!/usr/bin/env gosh
;;; -*- coding: utf-8-unix; -*-

(define nil (list))

;;; en p120
(define (enumerate-interval low high)
  (if (> low high)
      nil
      (cons low (enumerate-interval (+ low 1) high))))

;;; en p125
(define (flatmap proc seq)
  (accumulate append nil (map proc seq)))

;;; jp p66
(define (accumulate op initial sequence)
  (if (null? sequence)
      initial
      (op (car sequence)
          (accumulate op initial (cdr sequence)))))

;;; jp p66
(define (filter predicate sequence)
  (cond ((null? sequence) nil)
        ((predicate (car sequence))
         (cons (car sequence)
               (filter predicate (cdr sequence))))
        (else (filter predicate (cdr sequence)))))

;;; answer
(define empty-board nil)

;;; answer
(define (adjoin-position new-row col rest-of-queens)
  (cons (cons new-row col) rest-of-queens))

(define (queen-x queen)
  (car queen))
(define (queen-y queen)
  (cdr queen))

;;; answer
(define (safe? col positions)
  (define (diagonal a b)
    (let ((ax (queen-x a))
          (ay (queen-y a))
          (bx (queen-x b))
          (by (queen-y b)))
      (= (abs (- ax bx))
         (abs (- ay by)))))
  (let ((last-queen (car positions))
        (rest-of-queens (cdr positions)))
    (cond ((null? rest-of-queens)
           #t)
          (else
           (let ((x (queen-x last-queen))
                 (y (queen-y last-queen)))
             (null? (filter
                     (lambda (pos)
                       (cond ((= x (queen-x pos)) ; x
                              #t)
                             ((= y (queen-y pos)) ; y
                              #t)
                             ((diagonal last-queen pos) ; diagnal
                              #t)
                             (else
                              #f))) ; ok
                     rest-of-queens)))))))

;;; from question
(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))

;;; for print
(define (print-queens positions)
  (let ((size (length positions)))
    (for-each
     (lambda (i)
       (display "|")
       (for-each
        (lambda (j)
          (display
           (if (null?
                (filter
                 (lambda (pos)
                   (cond ((and (= i (queen-x pos))
                               (= j (queen-y pos)))
                             #t)
                         (else
                          #f)))
                 positions))
               " " "*"))
          (display "|"))
        (enumerate-interval 1 size))
       (newline))
     (enumerate-interval 1 size))))

(for-each (lambda (x)
            (print-queens x)
            (newline))
          (queens (string->number (car *argv*))))

2.41

| 2.41 - クラなんとかの日記 を含むブックマーク はてなブックマーク - 2.41 - クラなんとかの日記 2.41 - クラなんとかの日記 のブックマークコメント

n に対し 0 < i < j < k <= n という三つの数字の組のうち,

合計が s になるものをみつけたい.

問題文では,i, j, k の大小について記述されていないが,

順序が無い場合は回答重複するだけなので,省いてもよい.

まいどおなじみの accumurate の中で再帰しています.

再帰は,size を減らしていって,accumurate のループは,

決まった数値より後ろの部分で回ります.

#!/usr/bin/env gosh
;; -*- coding: utf-8; -*-
; 

;; 準備
(define nil (list))

;; 2.2.3 より (日本語版 p.66)
(define (filter predicate sequence)
  (cond ((null? sequence) nil)
        ((predicate (car sequence))
         (cons (car sequence)
               (filter predicate (cdr sequence))))
        (else (filter predicate (cdr sequence)))))

(define (accumulate op initial sequence)
  (if (null? sequence)
      initial
      (op (car sequence)
          (accumulate op initial (cdr sequence)))))

;; 2.2.3 より (日本語版 p.67)
(define (enumerate-interval low high)
  (if (> low high)
      nil
      (cons low (enumerate-interval (+ low 1) high))))

;; 問題文より

;; 答え
(define (make-unique-tupple size max)
  (define (iter size n)
    (if (= size 0)
        (list nil)
        (accumulate append nil
                    (map (lambda (i)
                           (map (lambda (l)
                                  (cons i l))
                                (iter (- size 1) (+ i 1))))
                         (enumerate-interval n max)))))
  (iter size 1))

(define (find-parted-3-numbers n s)
  (filter (lambda (triple)
            (= s (+ (car triple)
                    (cadr triple)
                    (caddr triple))))
          (make-unique-tupple 3 n)))

;; 確認
(define n 10)
(define s 15)

(format #t "n = ~d" n) (newline) ; 10
(format #t "s = ~d" s) (newline) ; 15
(display (find-parted-3-numbers n s)) (newline) ; ((1 4 10) (1 5 9) (1 6 8) (2 3 10) (2 4 9) (2 5 8) (2 6 7) (3 4 8) (3 5 7) (4 5 6))

2009-06-16掃除中

2.40

| 2.40 - クラなんとかの日記 を含むブックマーク はてなブックマーク - 2.40 - クラなんとかの日記 2.40 - クラなんとかの日記 のブックマークコメント

1 <= j < i <= n なる unique-pairs を定義せよ.という問題.

ついでに,prime-sum-pairs もそれを使って書き直せともある.

元のprime-sum-pairs の部分を取ってくればよい.

下記回答だと,unique-pairs の出力がx, y でソートされるようにしてある.

#!/usr/bin/env gosh
;; -*- coding: utf-8; -*-
; 

;; 準備
(define nil (list))

;; 2.2.3 より (日本語版 p.28)
(define (square x) (* x x))

(define (smallest-divisor n)
  (find-divisor n 2))

(define (find-divisor n test-divisor)
  (cond ((> (square test-divisor) n) n)
        ((divides? test-divisor n) test-divisor)
        (else (find-divisor n (+ test-divisor 1)))))

(define (divides? a b)
  (= (remainder b a) 0))

(define (prime? n)
  (= n (smallest-divisor n)))

;; 2.2.3 より (日本語版 p.66)
(define (filter predicate sequence)
  (cond ((null? sequence) nil)
        ((predicate (car sequence))
         (cons (car sequence)
               (filter predicate (cdr sequence))))
        (else (filter predicate (cdr sequence)))))

(define (accumulate op initial sequence)
  (if (null? sequence)
      initial
      (op (car sequence)
          (accumulate op initial (cdr sequence)))))

;; 2.2.3 より (日本語版 p.67)
(define (enumerate-interval low high)
  (if (> low high)
      nil
      (cons low (enumerate-interval (+ low 1) high))))

;; 2.2.3 より (日本語版 p.71)
(define (flatmap proc seq)
  (accumulate append nil (map proc seq)))

(define (prime-sum? pair)
  (prime? (+ (car pair) (cadr pair))))

(define (make-pair-sum pair)
  (list (car pair) (cadr pair) (+ (car pair) (cadr pair))))

;; 問題文より

;; 答え
(define (unique-pairs n)
  (flatmap (lambda (j)
             (map (lambda (i)
                    (list i j))
                  (enumerate-interval 1 (- j 1))))
           (enumerate-interval 2 n)))

(define (prime-sum-pairs n)
  (map make-pair-sum
       (filter prime-sum? (unique-pairs n))))
               

;; 確認
(define n 5)

(display n) (newline) ; 5
(display (unique-pairs n)) (newline) ; ((1 2) (1 3) (2 3) (1 4) (2 4) (3 4) (1 5) (2 5) (3 5) (4 5))
(display (prime-sum-pairs n)) (newline) ; ((1 2 3) (2 3 5) (1 4 5) (3 4 7) (2 5 7))

2.39

| 2.39 - クラなんとかの日記 を含むブックマーク はてなブックマーク - 2.39 - クラなんとかの日記 2.39 - クラなんとかの日記 のブックマークコメント

reverse を fold-{right, left} を使って書け.という問題

fold-right が再帰.fold-left が反復ということがわかればいい感じかな?

#!/usr/bin/env gosh
;; -*- coding: utf-8; -*-
; 

;; 準備
(define nil (list))

(define (accumulate op initial sequence)
  (if (null? sequence)
      initial
      (op (car sequence)
          (accumulate op initial (cdr sequence)))))

(define fold-right accumulate)

; 問題文より
(define (fold-left op initial  sequence)
  (define (iter result rest)
    (if (null? rest)
        result
        (iter (op result (car rest))
              (cdr rest))))
  (iter initial sequence))

;; 答え
(define (reverse-r sequence)
  (fold-right (lambda (x y) (append y (list x))) nil sequence))

(define (reverse-l sequence)
  (fold-left (lambda (x y) (cons y x)) nil sequence))

;; 確認
(define x (list 1 2 3))

(display x) (newline) ; (1 2 3)
(display (reverse-r x)) (newline) ; (3 2 1)
(display (reverse-l x)) (newline) ; (3 2 1)

2009-06-11準備会

2.38

| 2.38 - クラなんとかの日記 を含むブックマーク はてなブックマーク - 2.38 - クラなんとかの日記 2.38 - クラなんとかの日記 のブックマークコメント

accumulate は,先頭の要素に右側の要素を組み合わせるので,fold-right と呼ばれている.

fold-left のことを考えてみようという問題.

fold-right と fold-left の結果が等しくなるのは,op の結果が引数の順序で不変である場合.(+ や * など)

#!/usr/bin/env gosh
;; -*- coding: utf-8; -*-
; 

;; 準備
(define (accumulate op initial sequence)
  (if (null? sequence)
      initial
      (op (car sequence)
          (accumulate op initial (cdr sequence)))))

(define fold-right accumulate)

; 問題文より
(define (fold-left op initial  sequence)
  (define (iter result rest)
    (if (null? rest)
        result
        (iter (op result (car rest))
              (cdr rest))))
  (iter initial sequence))

;; 答え

;; 確認
(define x (list 1 2 3))

(display x) (newline) ; (1 2 3)
(display (fold-right / 1 x)) (newline) ; 3/2 {= 1 / (2 / (3 / 1))}
(display (fold-left / 1 x)) (newline) ; 1/6 {= (1 / 2) / 3}
(display (fold-right list (list) x)) (newline) ; (1 (2 (3 ())))
(display (fold-left list (list) x)) (newline) ; (((() 1) 2) 3)

2.37

| 2.37 - クラなんとかの日記 を含むブックマーク はてなブックマーク - 2.37 - クラなんとかの日記 2.37 - クラなんとかの日記 のブックマークコメント

matrix-*-vector, transpose, matrix-*-matrix を定義せよ.

matrix の定義がわかればわかる問題.2.36 も参照のこと.

#!/usr/bin/env gosh
;; -*- coding: utf-8; -*-
; 

;; 準備
(define (accumulate op initial sequence)
  (if (null? sequence)
      initial
      (op (car sequence)
          (accumulate op initial (cdr sequence)))))

; 2.36 より
(define (accumulate-n op init seqs)
  (if (null? (car seqs))
      (list)
      (cons (accumulate op init (map car seqs))
            (accumulate-n op init (map cdr seqs)))))

; 問題文より
(define (dot-product v w)
  (accumulate + 0 (map * v w)))

;; 答え
(define (matrix-*-vector m v)
  (map (lambda (w)
;         (dot-product w v))
         (list (dot-product w v))) ; 6/18 訂正 list が抜けていた
       m))

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

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

;; 確認
(define m (list (list 1 2 3 4) (list 4 5 6 6) (list 6 7 8 9)))
(define n (list (list 2 4) (list 6 8) (list 9 7) (list 1 3)))
(define v (list 1 2 3 4))

(display m) (newline) ; ((1 2 3 4) (4 5 6 6) (6 7 8 9))
(display n) (newline) ; ((2 4) (6 8) (9 7) (1 3))
(display v) (newline) ; (1 2 3 4)
(display (matrix-*-vector m v)) (newline) ; (30 56 80)
(display (transpose m)) (newline) ; ((1 4 6) (2 5 7) (3 6 8) (4 6 9))
(display (matrix-*-matrix m n)) (newline) ; ((45 53) (98 116) (135 163))

2.36

| 2.36 - クラなんとかの日記 を含むブックマーク はてなブックマーク - 2.36 - クラなんとかの日記 2.36 - クラなんとかの日記 のブックマークコメント

accumulate-n を実装する.

seqs の car を accumulate していき,cdr を accumulate-n すればよい.

#!/usr/bin/env gosh
;; -*- coding: utf-8; -*-
; 

;; 準備
(define (accumulate op initial sequence)
  (if (null? sequence)
      initial
      (op (car sequence)
          (accumulate op initial (cdr sequence)))))

;; 答え
(define (accumulate-n op init seqs)
  (if (null? (car seqs))
      (list)
      (cons (accumulate op init (map car seqs))
            (accumulate-n op init (map cdr seqs)))))

;; 確認
(define s (list (list 1 2 3) (list 4 5 6) (list 7 8 9) (list 10 11 12)))

(display s) (newline) ; ((1 2 3) (4 5 6) (7 8 9) (10 11 12))
(display (accumulate-n + 0 s)) (newline) ; (22 26 30)

2.35

| 2.35 - クラなんとかの日記 を含むブックマーク はてなブックマーク - 2.35 - クラなんとかの日記 2.35 - クラなんとかの日記 のブックマークコメント

count-leaves をaccumulate を使って実装する.

再帰がどこにかかるかわかれば簡単.

list の要素がlist である場合に再帰すればよい.

#!/usr/bin/env gosh
;; -*- coding: utf-8; -*-
; 

;; 準備
(define (accumulate op initial sequence)
  (if (null? sequence)
      initial
      (op (car sequence)
          (accumulate op initial (cdr sequence)))))

;; 答え
(define (count-leaves tree)
  (accumulate + 0 (map (lambda (x)
                         (if (pair? x)
                             (count-leaves x)
                             1))
                       tree)))
              

;; 確認
(define x (cons (list 1 2) (list 3 4)))
(define y (list x x))

(display x) (newline) ; ((1 2) 3 4)
(display y) (newline) ; (((1 2) 3 4) ((1 2) 3 4))
(display (length x)) (newline) ; 3
(display (length y)) (newline) ; 2
(display (count-leaves x)) (newline) ; 4
(display (count-leaves y)) (newline) ; 8

2.34

| 2.34 - クラなんとかの日記 を含むブックマーク はてなブックマーク - 2.34 - クラなんとかの日記 2.34 - クラなんとかの日記 のブックマークコメント

(k_n k_{n-1} ... k_1 k_0) のように項のリストが与えられたとして.

  • T_0 = k_0
  • T_n = k_n + T_{n-1} * x

こんな感じで,前の項をx 倍して,項を足す漸化式を考えればよい.

例えば,(1 3 0 5 0 1) を項のリストとして与えられた場合,以下のように式が変形する.

(ここで,リストとは逆順に項が与えられていくことに注意)

  1. 1
  2. 0 + (1) * x = x
  3. 5 + (x) * x = 5 + x^2
  4. 0 + (5 + x^2) * x = 5x + x^3
  5. 3 + (5x + x^3) * x = 3 + 5x^2 + x^4
  6. 1 + (3 + 5x^2 + x^4) * x = 1 + 3x + 5x^3 + x^5
#!/usr/bin/env gosh
;; -*- coding: utf-8; -*-
; 

;; 準備
(define (accumulate op initial sequence)
  (if (null? sequence)
      initial
      (op (car sequence)
          (accumulate op initial (cdr sequence)))))

;; 答え
(define (horner-eval x coefficient-sequence)
  (accumulate (lambda (this-coefficient higher-term)
                (+ (* higher-term x)
                   this-coefficient))
              0
              coefficient-sequence))

;; 確認
(define x 2)
(define cs (list 1 3 0 5 0 1))

(display x) (newline) ; 2
(display cs) (newline) ; (1 3 0 5 0 1)
(display (horner-eval x cs)) (newline) ; 79 (= 1 + 3x + 5x^3 + x^5 = 1 + 6 + 40 + 32)

2009-06-10喉が痛い

2.33

| 2.33 - クラなんとかの日記 を含むブックマーク はてなブックマーク - 2.33 - クラなんとかの日記 2.33 - クラなんとかの日記 のブックマークコメント

accumulate の定義から考えればそのまま.

#!/usr/bin/env gosh
;; -*- coding: utf-8; -*-
; 

;; 準備
(define (square x)
  (* x x))

(define (accumulate op initial sequence)
  (if (null? sequence)
      initial
      (op (car sequence)
          (accumulate op initial (cdr sequence)))))

;; 答え
(define (map p sequence)
  (accumulate (lambda (x y)
                (cons (p x) y))
              (list)
              sequence))

(define (append seq1 seq2)
  (accumulate cons seq2 seq1))

(define (length sequence)
  (accumulate (lambda (x y)
                (+ 1 y))
              0
              sequence))

;; 確認
(define x (list 1 2 3))
(define y (list 4 5 6))

(display x) (newline) ; => (1 2 3)
(display y) (newline) ; => (4 5 6)
(display (map square x)) (newline) ; => (1 4 9)
(display (append x y)) (newline) ; => (1 2 3 4 5 6)
(display (length x)) (newline) ; => 3