SICP 2.2.4 Example: A Picture Language - プログラミング再入門

ここでは再びDrRacket+PLaneTのSICPサポートを使います。
http://planet.racket-lang.org/package-source/soegaard/sicp.plt/2/1/planet-docs/sicp-manual/index.html

ノート

巷ではそのまま『図形言語』と訳している模様。

The picture language

最初のうちpainterが何なのか、painterを引数に取る関数が何をするのか判然としないまま話が進む。

A painter draws an image that is shifted and scaled to fit within a designated parallelogram-shaped frame.

painterは指定された平行四辺形の領域にイメージを描く能動的なオブジェクトの様に定義されている。テキストには出て来ないがPLaneTのSICPサポートでは最後に手続きpaintにpainterを渡してレンダリングさせないと表示してくれない。
コードの上では図形そのものにも見える事と暫くは領域（frame）がコードとして出て来ないので、何がどうなって結果（表示される図形）に結び付くのかイメージしにくい。手続きなのかデータなのか見分けが付かないのは意図されたものだろうけど。

まずは下記も参照してまずはwaveの図形を作ってみた。
http://sicp-picture-language-racket.googlecode.com/files/PictureLanguage_1_0.scm

#lang racket
(require (planet "sicp.ss" ("soegaard" "sicp.plt" 2 1)))
(define w1 (make-vect 0.00 0.85))
(define w2 (make-vect 0.15 0.62))
(define w3 (make-vect 0.30 0.70))
(define w4 (make-vect 0.42 0.70))
(define w5 (make-vect 0.38 0.88))
(define w6 (make-vect 0.40 1.00))
(define w7 (make-vect 0.62 1.00))
(define w8 (make-vect 0.65 0.88))
(define w9 (make-vect 0.60 0.70))
(define w10 (make-vect 0.75 0.70))
(define w11 (make-vect 1.00 0.38))
(define w12 (make-vect 1.00 0.15))
(define w13 (make-vect 0.64 0.48))
(define w14 (make-vect 0.78 0.00))
(define w15 (make-vect 0.62 0.00))
(define w16 (make-vect 0.52 0.30))
(define w17 (make-vect 0.40 0.00))
(define w18 (make-vect 0.25 0.00))
(define w19 (make-vect 0.36 0.52))
(define w20 (make-vect 0.30 0.64))
(define w21 (make-vect 0.15 0.43))
(define w22 (make-vect 0.00 0.67))
(define wave 
  (segments->painter 
   (list (make-segment w1 w2)
         (make-segment w2 w3)
         (make-segment w3 w4)
         (make-segment w4 w5)
         (make-segment w5 w6)
         (make-segment w7 w8)
         (make-segment w8 w9)
         (make-segment w9 w10)
         (make-segment w10 w11)
         (make-segment w12 w13)
         (make-segment w13 w14)
         (make-segment w15 w16)
         (make-segment w16 w17)
         (make-segment w18 w19)
         (make-segment w19 w20)
         (make-segment w20 w21)
         (make-segment w21 w22)
         )))
(paint wave)

paintを使って表示させてみる。

特に引数などに指定はないがpaintは何やら勝手に正方形の領域を決めて、そこに描かせている模様。

wave2は

waveと
waveを上下反転させたもの（flip-vert）
上記二つを左右に配置（beside）

besideとかflip-vertが引数のpainterに図を描かせてから自分の領域にはめ込んでいるのか、painterに領域を渡してそこに描かせているのかこの時点では分からないが、上記のwaveの定義でこの後の関数が色々と動くと言う事はpainter自身はあくまで(0, 0), (1, 0), (1, 1), (0, 1)の正方形に描いているつもりだけど結果として縦長になったり小さくなったりしているだけで、besideやflip-vertの方で変換している様に思える。

wave4は

wave2を上下に配置（below）

wave2、save4を実行してみる。

(define (flipped-pairs painter)
  (let ((painter2 (beside painter (flip-vert painter))))
    (below painter2 painter2)))

flipped-pairsは

painterを左にpainterを上下反転させたものを右に配置したものをpainter2と置いて
painter2を上下に配置

flipped-pairsを使ったwave4の定義を実行してみる。

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

right-splitのnは再帰を止める為だけに存在すると割り切って考える。再帰の基底部ではpainterをそのまま返しているが、再帰の帰り道でそれらはbelowの引数となるので、再帰を戻る度に小さな図形に変換される結果となる。
right-splitは

再帰呼び出しで返って来たpainterをsmallerと置いて
painterとsmallerを上下に配置したものを左右に配置

元の図形に対して右側に小さい版が上下に並び、その小さい図形の右に更に小さいのが上下に並ぶ。nを大きくすればいくらでも小さく細分化出来る。

corner-splitのnはright-splitの時と同じく再帰を止める為だけに存在する。
corner-splitは

up-splitで返って来た図形をupと置き、
right-splitで返って来た図形をrightと置き、
upを左右に並べたものをtop-leftと置き
rightを上下に並べたものをbottom-rightと置き、
再帰でcorner-splitから返って来た図形をcornerと置き、
top-leftとpainterを上下に配置し
cornerとbottom-rightを上下に配置し
上記の二つを左右に配置

square-limitは

上記corner-splitをquarterと置いて
quarterを左右反転したものとquarterを横に並べたものをhalfと置いて
halfを上に、halfを上下反転させたものを上下に配置

up-splitが定義されていないのでここではまだ実行出来ない。

Exercise 2.44

right-splitに倣って、up-splitを書く。right-splitは上下に分割したものを右に配置。上方向に変換するには左右に分割したものを上に配置。

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

right-split以降を実行してみる。

rogersの代わりにeinstein

square-limitも

High Order Operation

flipped-pairsとsquare-limitは４つのブロックを配置すると言う意味では共通なのでもう一段抽象化する。
square-of-fourで定義したflipped-pairsとsquare-limitを実行してみる。

Exercise 2.45

splitの引数は分割しない方と分割する方なので、fixedとsplittedとする。
square-of-fourと同様にlambdaで関数を返す事になる。right-split、up-splitともpainterと再帰の回数nを引数と取るので(lambda (painter n) ...で始める。この中にright-split、up-splitの中身を展開して、below、besideが有った所にfixedとsplittedを当てはめる。
問題は再帰呼び出ししている部分。正確には再帰とは違うのも知れないが、これから定義するright-split、up-splitの中身と同じ事をして関数を作ってそれを呼び出せば良い事になるので、(split fixed splitted)とすれば良い。

(define (split fixed splitted)
  (lambda (painter n)
    (if (= n 0)
        painter
        (let ((smaller ((split fixed splitted) painter (- n 1))))
          (fixed painter (splitted smaller smaller))))))

実行結果

Frames

origin-frameはframe-originと定義されているのでそっちを使って。

> (define a-frame (make-frame (make-vect 1 1)
                              (make-vect 1 1)
                              (make-vect 0 1)))
> ((frame-coord-map a-frame) (make-vect 0 0))
'(1 . 1)
> (frame-origin a-frame)
'(1 . 1)
>

原点が(1, 1)に移動している事が分かる。

Exercise 2.46

ここはRacketモードでPLaneTのSICPサポートは外して実施。

define (make-vect x y)
  (cons x y))
(define (xcor-vect v)
  (car v))
(define (ycor-vect v)
  (cdr v))
(define (liner-calc-vect f a b)
  (make-vect (f (xcor-vect a) (xcor-vect b))
             (f (ycor-vect a) (ycor-vect b))))
(define (add-vect a b)
  (liner-calc-vect + a b))
(define (sub-vect a b)
  (liner-calc-vect - a b))
(define (scale-vect s v)
  (make-vect (* s (xcor-vect v))
             (* s (ycor-vect v))))
(define (eq-vect? a b)
  (and (= (xcor-vect a) (xcor-vect b))
       (= (ycor-vect a) (ycor-vect b))))

実行結果。

> (add-vect (make-vect 1 2) (make-vect 3 4))
'(4 . 6)
> (sub-vect (make-vect 4 6) (make-vect 3 4))
'(1 . 2)
> (scale-vect 2 (make-vect 1 2))
'(2 . 4)
>

Racketモードだとドットペアがクォートされた形で表示される。

Exercise 2.47

; implementation 1
(define (make-frame1 origin edge1 edge2)
  (list origin edge1 edge2))
(define (origin1 f)
  (car f))
(define (edge11 f)
  (car (cdr f)))
(define (edge21 f)
  (car (cdr (cdr f))))

; implementation 2
(define (make-frame2 origin edge1 edge2)
  (cons origin (cons edge1 edge2)))
(define (origin2 f)
  (car f))
(define (edge12 f)
  (car (cdr f)))
(define (edge22 f)
  (cdr (cdr f)))

テスト

> (define f1 (make-frame1 (make-vect 10 10) (make-vect 10 0) (make-vect 0 10)))
> (origin1 f1)
'(10 . 10)
> (edge11 f1)
'(10 . 0)
> (edge12 f1)
'(10 . 0)
> (define f2 (make-frame2 (make-vect 10 10) (make-vect 10 0) (make-vect 0 10)))
> (origin2 f2)
'(10 . 10)
> (edge12 f2)
'(10 . 0)
> (edge22 f2)
'(0 . 10)
>

Painters

結局painterには引数としてframeが渡され、painter自身がそのframeに収まる様に図形を描く。このpainterが手続きとして作られている為に組み合わせを構成してより高度な描画が出来る。

Exercise 2.48

ここは単純に

(define (make-segment start end) (cons start end))
(define (start-segment segment) (car segment))
(define (end-segment segment) (cdr segment))

Exercise 2.49

segment-painterがframeを受け取り、その中に変換して描画してくれるので、ここで定義するpainter達はunit squareに描けば良い事になる。

(define draw-frame
  (segments->painter
   (list (make-segment (make-vect 0 0) (make-vect 0.99 0))
         (make-segment (make-vect 0.99 0) (make-vect 0.99 0.99))
         (make-segment (make-vect 0.99 0.99) (make-vect 0 0.99))
         (make-segment (make-vect 0 0.99) (make-vect 0 0)))))

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

(define draw-diamond
  (segments->painter
   (list (make-segment (make-vect 0.5 0) (make-vect 1 0.5))
         (make-segment (make-vect 1 0.5) (make-vect 0.5 1))
         (make-segment (make-vect 0.5 1) (make-vect 0 0.5))
         (make-segment (make-vect 0 0.5) (make-vect 0.5 0)))))

実装してから気づいた事だが、unit squareは０以上1未満の領域の様で、(1, 0)-(1, 1)、(1, 1)-(0, 1)の線は表示されない。なので苦し紛れでは有るが1の代わりに0.99を使用する。
動作は以下の通り：

waveについては既に実施済み。
最初に登場するwaveがここに来て漸く定義されるので、ここまでは殆ど動作確認せずに机上の論理だけで演習しなければならないのだろうか？

Transforming and combining painters

段々と中の実装が明らかになって来る。
(frame-cood-map frame)はvectorを引数に取りframe内の点に変換する関数となる。原点は３回出て来るのでnew-originと定義して、painterに新しいframeを渡す。
flip-vert等のframeの向きや大きさを変える関数の定義は簡単。
besideも二つのpainterそれぞれに左右に分割したframeを渡す。
この実装の特徴：

図形データはunit squareで定義するのが簡単。
painterがそれをframeにフィットさせて描画。
frameはpainterの引数になっているので描画領域の変換が自由。
painterを組み合わせる手続きはframeを操作する事でそれぞれのpainterの描画領域を制御出来る。
painterを組み合わせる手続きそのものもpainterとして働けばそれを更に部品として扱える。

Exercise 2.50

PLaneTのSICPサポートに定義されているtransform-painterの定義では引数の数が違う様なので、テキストのtransform-painterをtransform->painterと名前を変更して使用。この定義で使われるsub-vectはvectot-subとして定義されているのでラッパーを定義。

(define sub-vect vector-sub)

(define (flip-horizontal painter)
  (transform->painter painter
                     (make-vect 1.0 0.0)   ; new origin
                     (make-vect 0.0 0.0)   ; new end of edge1
                     (make-vect 1.0 1.0))) ; new end of edge2

(define (rotate180degrees painter)
  (transform->painter painter
                     (make-vect 1.0 1.0)
                     (make-vect 0.0 1.0)
                     (make-vect 1.0 0.0)))

(define (rotate270degrees painter)
  (transform->painter painter
                     (make-vect 0.0 1.0)
                     (make-vect 0.0 0.0)
                     (make-vect 1.0 1.0)))

実行結果

Exercise 2.51

前問と同様にtransform->painterを使用。below2はそれぞれを右に90度回転させたのは左右に配置してその結果を左に90度回転させて実現する。

(define (below1 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 (below2 painter1 painter2)
  (rotate90 (beside (rotate270 painter1) (rotate270 painter2))))

実行結果

Levels of language for robust design

プログラムを階層化して考える。原始的な手続きのセットを使って１段上のレベルの世界を構築。そのレベルでの手続きのセットを使って更に上のレベルの世界を構築すると言った具合。階層間のインターフェースが変わらなければ、変更の影響範囲は限定されるので変更に強い設計となる。

Exercise 2.52

a)
ちょっとスマートにして目と口を追加。

(define w1 (make-vect 0.00 0.83))
(define w2 (make-vect 0.20 0.70))
(define w3 (make-vect 0.35 0.80))
(define w4 (make-vect 0.45 0.80))
(define w5 (make-vect 0.38 0.88))
(define w6 (make-vect 0.40 1.00))
(define w7 (make-vect 0.60 1.00))
(define w8 (make-vect 0.62 0.88))
(define w9 (make-vect 0.58 0.80))
(define w10 (make-vect 0.75 0.80))
(define w11 (make-vect 1.00 0.48))
(define w12 (make-vect 1.00 0.45))
(define w13 (make-vect 0.70 0.68))
(define w14 (make-vect 0.82 0.00))
(define w15 (make-vect 0.72 0.00))
(define w16 (make-vect 0.57 0.30))
(define w17 (make-vect 0.40 0.00))
(define w18 (make-vect 0.28 0.00))
(define w19 (make-vect 0.42 0.42))
(define w20 (make-vect 0.35 0.70))
(define w21 (make-vect 0.22 0.58))
(define w22 (make-vect 0.00 0.78))
(define wave 
  (segments->painter 
   (list (make-segment w1 w2)
         (make-segment w2 w3)
         (make-segment w3 w4)
         (make-segment w4 w5)
         (make-segment w5 w6)
         (make-segment w7 w8)
         (make-segment w8 w9)
         (make-segment w9 w10)
         (make-segment w10 w11)
         (make-segment w12 w13)
         (make-segment w13 w14)
         (make-segment w15 w16)
         (make-segment w16 w17)
         (make-segment w18 w19)
         (make-segment w19 w20)
         (make-segment w20 w21)
         (make-segment w21 w22)
         (make-segment (make-vect 0.42 0.92) (make-vect 0.44 0.92))
         (make-segment (make-vect 0.50 0.92) (make-vect 0.52 0.92))
         (make-segment (make-vect 0.46 0.87) (make-vect 0.50 0.87))
         (make-segment (make-vect 0.46 0.87) (make-vect 0.49 0.83))
         (make-segment (make-vect 0.50 0.87) (make-vect 0.49 0.83))
         )))

実行結果

b)
右側のwaveが左右反転、対角のwaveは交互に反転。

(define (corner-split painter n)
  (if (= n 0)
      painter
      (let ((up (up-split painter (- n 1)))
            (right (right-split (flip-horiz painter) (- n 1))))
        (let ((top-left (beside up up))
              (bottom-right (below right right))
              (corner (corner-split painter (- n 1))))
          (beside (below (if (odd? n) (flip-horiz painter) painter) top-left)
                  (below bottom-right corner))))))

実行結果

c)
大きな４つが90°ずつ回転するパターン。取り敢えず引数のnは残してはおくが使わない。

(define (square-limit painter n)
  ((square-of-four identity rotate270 rotate90 rotate180) painter))

実行結果