2.2.4 図形言語 - yukichanko's diary

http://mitpress.mit.edu/sicp/full-text/book/book-Z-H-15.html#%_sec_2.2.4
今回はさくっといこう。

環境は、DrScheme V3.5.2です。
コレを使うと、図形言語の章が非常に楽です。

ここの節は、問題はつまらんけど、書いている内容がためになる。
閉包性や再帰の強力さを再実感する章でした。

問題 2.44

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

問題 2.45

(define (split seq-fun red-fun)
  (define (split-iter painter n)
    (if (= n 0)
        painter
        (let ((smaller (split-iter painter (- n 1))))
          (seq-fun painter (red-fun smaller smaller)))))
  split-iter)

問題 2.46

(define (make-vect x y)
  (cons x y))
(define (xcor-vect v)
  (car x))
(define (ycor-vect v)
  (cdr y))
(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 s v)
  (make-vect (* s (xcor-vect v)) (* s (ycor-vect v))))

問題 2.47

リストの方

(define (make-frame origin edge1 edge2)
  (list origin edge1 edge2))
(define (origin-frame f)
  (car f))
(define (edge1-frame f)
  (cadr f))
(define (edge2-frame f)
  (caddr f))

consの方

(define (make-frame origin edge1 edge2)
  (cons origin (cons edge1 edge2)))
(define (origin-frame f)
  (car f))
(define (edge1-frame f)
  (cadr f))
(define (edge2-frame f)
  (cddr f))

問題2.48

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

問題2.49

外形フレーム

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

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

ひし形

(define Dia (segments->painter
             (list
              (make-segment (make-vect 0.5 0.0)
                            (make-vect 1.0 0.5))
              (make-segment (make-vect 1.0 0.5)
                            (make-vect 0.5 1.0))
              (make-segment (make-vect 0.5 1.0)
                            (make-vect 0.0 0.5))
              (make-segment (make-vect 0.0 0.5)
                            (make-vect 0.5 0.0)))))

問題 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)))

180度回転

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

270度回転

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

問題2.51

transform-painterを使う方法

(define (below painter1 painter2)
  (let ((split-point (make-vec 0.0 0.5)))
    (let ((paint-lower
           (transform-painter painter1
                              (make-vect 0.0 0.0)
                              (make-vect 0.0 1.0)
                              split-point))
          (paint-upper
           (transform-painter painter2
                              split-point
                              (make-vect 1.0 0.5)
                              (make-vect 0.0 0.5))))
      (lambda (frame)
        (paint-lower frame)
        (paint-upper frame)))))

besideを使う方法

(define (below painter1 painter2)
  (rotate90 (beside (rotate270 painter1) (rotate270 painter2))))