本文

ペインタと変換の組合せ

ペインタの演算 : 引数のフレームから作られたフレームに関して、元のペインタを発動する新しいペインタを作り出す

ペインタが抽象化されているおかげで、要素ペインタに対してフレームを与えるだけで処理をおこなうことができる。

問題解答

問2.50

(define (flip-horiz painter)
	(transform-painter painter
                     (make-vect 1.0 0.0)
                     (make-vect 0.0 0.0)
                     (make-vect 1.0 1.0)))

(define (rot180 painter)
  (transform-painter painter
                     (make-vect 1.0 1.0)
                     (make-vect 0.0 1.0)
                     (make-vect 1.0 0.0)))

(define (rot270 painter)
  (transform-painter painter
                     (make-vect  0.0 1.0)
                     (make-vect  0.0 0.0)
                     (make-vect  1.0 1.0)))

問2.51

(define (below painter1 painter2)
  (let ((split-point (make-vect 0.0 0.5)))
    (let ((paint-bottom
           (transform-painter painter1
                              (make-vect 0.0 0.0)
                              (make-vect 1.0 0.0)
                              split-point))
          (paint-top
           (transform-painter painter2
                              split-point
                              (make-vect 1.0 0.5)
                              (make-vect 0.0 1.0))))

      (lambda (frame)
        (paint-bottom frame)
        (paint-top frame)))))

(define (below painter1 painter2)
  (rot90 (beside (rot270 painter1) (rot270 painter2))))

問題解答

問2.46

(define (make-vect x y)
  (cons x y))

(define (xcor-vect v)
  (car v))

(define (ycor-vect v)
  (cdr v))

(define (add-vect v1 v2)
  (make-vect
   (+ (xcor-vect v1) (xcor-vect v2))
   (+ (ycor-vect v1) (ycor-vect v2))))

(define (sub-vect v1 v2)
  (make-vect
   (- (xcor-vect v1) (xcor-vect v2))
   (- (ycor-vect v1) (ycor-vect v2))))

(define (scale-vect v s)
  (make-vect
   (* s (xcor-vect v))
   (* s (ycor-vect v))))

(define v1 (make-vect 1 2))
(define v2 (make-vect 2 1))

(xcor-vect v1)
(ycor-vect v1)

(add-vect v1 v2)
(sub-vect v1 v2)
(scale-vect v1 5)

問2.47
方法1

(define (make-frame origin edge1 edge2)
  (list origin edge1 edge2))

(define (frame-origin frame)
  (list-ref frame 0))

(define (frame-edge1 frame)
  (list-ref frame 1))

(define (frame-edge2 frame)
  (list-ref frame 2))

方法2

(define (make-frame origin edge1 edge2)
  (cons origin (cons edge1 edge2)))

(define (frame-origin frame)
  (car frame))

(define (frame-edge1 frame)
  (cadr frame))

(define (frame-edge2 frame)
  (cddr frame))

本文

ペインタ
フレームに合うように画像を描画する手続き

問題解答

問2.48

(define (make-segment v1 v2)
  (cons v1 v2))

(define (start-segment seg)
  (car v1))

(define (end-segment seg)
  (cdr v1))

問2.49
a.

(define (outline-painter)
  (segments->painter
   (list (make-segment (make-vect 0 0) (make-vect 1 0))
         (make-segment (make-vect 1 0) (make-vect 1 1))
         (make-segment (make-vect 1 1) (make-vect 0 1))
         (make-segment (make-vect 0 1) (make-vect 0 0)))))

以下、やることは同じなので略。

昨日ガッツリと取り組んだおかげで何とかペースが戻ってきた気がします。引き続きボチボチいきます。

本文

2.2.4 例:図形言語
図形の処理に対して閉包性を持たせる。

問題解答

問2.44

(define (up-split painter n)
  (if (= n 0)
      painter
      (let ((smaller (up-split painter (-n 1))))
        (below painter (beside smaller smaller)))))

本文

高階演算

フレーム
フレーム座標写像の方法がイマイチ理解できない。フレームを定義するには 3 つのベクトルが必要なのに、frame-coord-map では一つのベクトルしか返さない。これで写像できるのか?

→単位方形内に定義された画像の要素をフレーム内に貼り付けるための処理ということっぽい。たしかに文章でもそう書いている。

一週間間が空いたせいでペースがつかめなくなってしまって SICP に手を伸ばすまでにものすごく時間がかかるようになってしまいました。
ここで辞めてしまうと本当にやらなくなっちゃうのでちょいと踏ん張り所です。一日一問でも進めて徐々にペースを戻さないと。

問題解答

問2.42
とっかかりが掴めない。というか、どういうデータ構造で格納されるのか?が想像つかない。
しかたがないので empty-board をカンニング。

(define empty-board '())

ん?これでいいのか?

クィーンの置く場所を数値として表すらしい。 サンプルだと (3 7 2 8 5 1 4 6) となるということか。
それを踏まえて元のコードをじっと眺める。

。。。だがダメ。ダメ。全く頭が動かない。一週間空くとここまでダメなのか(もともとダメという話は無かったことに)。
仕方ないから全部カンニングしてきちんと把握することにします。

(define (flatmap proc seq)
  (accumulate append '() (map proc seq)))

map で作成したリストを展開する

seq に (1 2) のような値が入力され、各値に proc を施すことで
((1 1) (2 2)) のようなリストのリストになる場合、リストに変換する。

この場合は (1 1 2 2) になる。

(define (adjoin-position new-row k rest-of-queens)
  (cons new-row rest-of-queens))

既存のクィーンの並びに新しいクィーン new-row を加える

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

初期値を initial として、返り値に対して sequence の各値を op で処理していく。sequence が (1 2 3) だった場合、(op 1 (op 2 (op 3 initial))) という処理になる。

(define (enumerate-interval low high)
  (if (> low high)
      '()
      (cons low (enumerate-interval (+ low 1) high))))

low から high まで値を数え上げ、リストにして返す

(define (filter predicate sequence)
  (cond ((null? sequence) '())
        ((predicate (car sequence))
         (cons (car sequence)
               (filter predicate (cdr sequence))))
        (else (filter predicate (cdr sequence)))))

predicate で評価されて true になるもののリストを返す

(define (safe? k positions)
  (define (safe1 x n)
    (or (= n k)
        (let ((y (list-ref positions n)))
          (and (not (= x y))
               (not (= (- x y) n))
               (not (= (- y x) n))
               (safe1 x (+ n 1))))))

  (safe1 (car positions) 1))

list-ref なる未知の関数が使われている。Gauche のマニュアルを見ると

listのk番目の要素を返します。

ということのようで。これ、もっと早めに教えてよっ!!(涙。
LISP の文法関係は、SICP だけじゃ足りないのか、、、、

ということで、safe1 では一番頭にある値とそれ以降の値を比較して許容できる配置かどうかをチェックしている。

(not (= x y) ; 同じ行にクィーンが配置されていないか
(not (= (- x y) n)) ; 斜め方向にクィーンが配置されていないか
(not (= (- y x) n)) ; 斜め方向にクィーンが配置されていないか
(safe1 x (+ n 1)))))) ; 次のアイテムをチェック

(define empty-board '())

空のリストを作成

ここまで来て本体の確認をします。

(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))

(enumerate-interval 1 board-size) で 1 から board-size までの値を数え上げ。board-size が 3 なら (1 2 3)。

まず、k=1 の場合を考える。 (queen-cols (-k 1)) は (()) になる。
この値を使用して flatmap 内の動作確認。rest-of-queens は (()) から要素が一つづつ取り出されるので、()。

(map (lambda (new-row)
       (adjoin-position 
        new-row 
        k
        rest-of-queens))
     (enumerate-interval 1 board-size)))

この部分は (1 2 3) のアイテムに対して adjoin-position を適用したリストを返す。
rest-of-queens は () 、new-row は 1,2,3 が繰り返し毎に入るので結果は
((1) (2) (3))。

flatmap の実態は map なので、まずは map で考える。

(map
 (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)))

やっていることは rest-of-queens を取り替えながら map を実行して、その結果をリストにしていることなので (((1) (2) (3)))。
flatmap リストを一つ解除するので ((1) (2) (3))。この、(1),(2),(3) それぞれに対してsafe? で評価して取捨選択するのが filter。結果は ((1) (2) (3))。これが k=1 のときの結果。

k=2 の時は

(flatmap
 (lambda (rest-of-queens)
   (map (lambda (new-row)
          (adjoin-position 
           new-row 
           2
           rest-of-queens))
        (enumerate-interval 1 board-size)))
 '((1) (2) (3))')

という処理になる(k-1 の時の結果をわかりやすいようにシングルクォーテーションで囲っている)。
rest-of-queens の最初の値は (1) なので、map の結果は ((1 1) (2 1) (3 1))。flatmap 内の map まで処理が終ると

(((1 1) (2 1) (3 1))
 ((1 2) (2 2) (3 2))
 ((1 3) (2 3) (3 3)))

になるので、flatmap されて ((1 1) (2 1) (3 1) (1 2) (2 2) (3 2) (1 3) (2 3) (3 3))。
ここから filter されて ((3 1) (1 3)) が残る。以下同様に処理をおこなう。

こんな感じでしょうかね。map がネストすると途端に処理を追いかけられなくなってしまいます。何となく、map の処理が自分の中でキチンとモデル化できていない感じです。

問2.43
外側のループの数が増えるのが原因? flatmap 内で処理がおこなわれる回数は変わらないきがするけれども。。。

→ queens-cols の呼ばれる回数が増えると、その下で再帰される分が増える。

board-size を s とする。
最初の実装だと queens-cols が呼ばれると s 回再帰で呼ばれる。
Louis の実装だと enumerate-interval 毎に s 回呼ばれ、それぞれの中で再帰されていく。
そのため、quessn-cols の呼ばれる回数は

k = s のとき 1
k = s-1 のとき s
k = s-2 のとき s^2
:
:
k = 1 のとき s^(s-1)

これは等比数列なので合計で呼び出される回数は初項 a、公比 r、項数 n で a(r^n-1)/(r-1) から (s^s-1)/(s-1)。

最初のものと比較すると (s^s-1)/(s-1)/s は大体 s^(s-2) 倍処理がおこなわれていることになる。

結局カンニングして何とか流れを追うことができました。でも、自分で一から回答できるかというとできる自信がないですね、、、、
ちょっと気にはなるものの、次に進むことにします。

この一週間は新婚旅行に行っていたので SICP はおやすみ。今日から気合一新再開です。
一週間空いたおかげで細かいところを忘れているのでまずはおさらいから。

…というか、今日はおさらいするだけでおしまい。明日から本気出します(ぁ

問題解答

問2.42
とりあえず本に書いてあるコードは打ち込んだので、あしたから本格的に問題に取り掛かる。

本文

写像の入れ子

map を入れ子にして リストのリストを生成、flatmap でリストにして filter でフィルタリング、
加算結果が追加された結果を生成。

問題解答

問2.40

(define (unique-pairs n)
  (flatmap
   append
   (map (lambda (i)
          (map (lambda (j) (list i j))
               (enumerate-interval 1 (- i 1))))
        (enumerate-interval 1 n))))

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

問2.41

(define (filterSum n s)
  (filter (lambda (l) (= (accumulate + 0 l) s))
          (flatmap
           (lambda (i)
             (flatmap
              (lambda (j)
                (map (lambda (k) (list i j k))
                     (enumerate-interval 1 n)))
              (enumerate-interval 1 n)))
           (enumerate-interval 1 n))))

そろそろ、ちゃんとしたデバッガのある環境が欲しい。。。。
コードの流れをきちんと追いかけるトレーニングをするにはデバッガのない環境っていいんですが、謎なエラーと格闘する時間が多くてもったいないです。

問題解答

問2.38
(fold-right / 1 (list 1 2 3)) は以下のような処理になる。

(op 1
    (fold-right op 1 (2 3)))
(op 1
    (op 2
        (fold-right op 1 (3))))
(op 1
    (op 2
        (op 3
            (fold-right op 1 ())))
(op 1
    (op 2
        (op 3
            1)))
(op 1
    (op 2
        3))
(op 1
    2/3)
3/2

(fold-left / 1 (list 1 2 3)) は以下。

(iter 1 (1 2 3))
(iter (op 1 1) (2 3)) → (iter 1 (2 3))
(iter (op 1 2) (3)) → (iter 1/2 (3))
(iter (op 1/2 3) ()) → (iter 1/6 ())
1/6

op はオペランドが入れ替わっても同じ結果を返すものであれば fold-right と fold-left で同じ値を得ることができる。

問2.39

(define (reverse sequence)
  (fold-right (lambda (x y) (append y (list x))) () sequence))

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

cons, list 周りと append などのオペレーション周りの理解が怪しい感じがしたので復習。

問題解答

問2.36

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

(define (lh l)
  (if (null? (cdr l))
      (list (caar l))
      (cons (caar l)
            (lh (cdr l)))))

(define (ll l)
  (if (null? (cdr l))
      (list (cdar l))
      (cons (cdar l)
            (ll (cdr l)))))

(define l (list (list 1 2 3) (list 4 5 6) (list 7 8 9) (list 10 11 12)))

(define (accumulate-n op init seqs)
  (if (null? (car seqs))
      ()
      (cons (accumulate op init (lh seqs))
            (accumulate-n op init (ll seqs)))))


(accumulate-n + 0 l)

できたけど、絶対これじゃない感が。。。。そして正解を見て鼻血出ました。

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

map か、、、たしかに。というか、答えを見れば当たり前だなと思うんですよね。何であんな冗長な書き方しか思い浮かばなかったのか。

問2.37
四苦八苦しながら作成。

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

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

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

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

matrix-*-matrix は、答えを見ると方法が違った。

(define (matrix-*-matrix m n)
  (let ((cols (transpose n)))
    (map (lambda (x)
      (map (lambda (y) (dot-product x y)) cols)) m)))

考え方的には間違っていない。。。ハズ。ただ、最後に transpose しているのはダサいし余分な処理なのでよくない感じはする。それに比べて参考解答は素直に処理していて普通の計算方法そのもの。

うーーーん。。まだ、自分でこれを一からパッと作れる気がしないです。単純な二重ループなんですけどね。

問題解答

問2.34

(define (horner-eval x coefficient-sequence)
  (accumulate (lambda (this-coeff higher-terms) (+ this-coeff (* higher-terms x)))
                0
                coefficient-sequence))

問2.35

(define (count-leaves t)
  (accumulate + 0 (map (lambda (x) (cond ((null? x) 0)
                                         ((not (pair? x)) 1)
                                         (else (count-leaves x)))) t)))

週末+1日で三日間開くと波に乗るのに時間がかかってしまう。やっぱり週末も手をつけるようにしたほうがいいかも。

本文

2.2.3 公認インターフェースとしての並び

再度ここから再読。内容もOK。

説明の流れ上そうなるよなーというのはあるものの、例として上がっていコードの

(define (sum-odd-squares tree)
  (accumulate +
              0
              (map square
                   (filter odd?
                           (enumerate-tree tree)))))

なんかは

(define v (enumerate-tree tree))
(define v (filter odd? v))
(define v (map square v))
(define v (accumulate + 0 v))

こういう感じで書いた方が意図がわかりやすいんじゃないでしょうかね。各演算に v をバケツリレーしてる感じ。

問題解答

問2.33

(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)) () sequence))

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

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

(define l1 (list 0 1 2 3 4))
(define l2 (list 5 6 7))
(length l1)
(append l1 l2)
(map (lambda (x) (* x x)) l2)

append で accumulate に渡すのが seq2 seq1 になっているのがハマりどころですね。
ちょっと気持ち悪いけど、たしかに処理を追っていくとそうなるのでそんなものなのかなという感じです。