<jupyter_start><jupyter_text>練習問題2.52上で述べた各レベルに⼿を加え、  図2.9に⽰したwaveによるsquare-limitを変更せよ。  具体的には、次のようなものである。- a.練習問題2.49のwave基本ペインタに線分をいくつか加えよ(例えば、笑顔を追加するなど)。- b.corner-splitによって構築されるパターンを変更せよ(例えば、up-splitやright-splitの画像を⼆つではなく⼀つ だけ使うようにする)。- c.square-of-fourを使うほうのsquare-limitを修正し、四隅を違うパターンで組み⽴てるようにせよ(例えば、正⽅形の四隅で⼤きなロジャーズ⽒が外を向くようにするなど)。  回答は  以下をサイトを参照しました。  https://github.com/snufkon/SICP/blob/master/ch2/2-52.scm<jupyter_code>; 線形変換
; 通常の行列計算より最適化してある。
; transform-painter手続きで線形変換だけ必要だったので、
; frame-coord-map手続きのアフィン変換と分離した。
(define (linear-transform frame v)
  (let ((edge1 (edge1-frame frame))
        (edge2 (edge2-frame frame)))
    (let ((x (xcor-vect v))
          (y (ycor-vect v)))
      (add-vect (scale-vect x edge1) (scale-vect y edge2))
     )
    )
  )


; テキストの実装から変更している。
; 通常の線形変換の数式に沿っている。
(define (frame-coord-map frame)
  (lambda (v)
    (let ((edge1 (edge1-frame frame))
          (edge2 (edge2-frame frame)))
      (add-vect
       (origin-frame frame)
       (linear-transform frame v)
      )
     )
    )
  )

; ベクトルコンストラクタ・セレクタ
(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 s v)
  (make-vect (* s (xcor-vect v))
             (* s (ycor-vect v))))

; フレームコンストラクタ・セレクタ
(define (make-frame origin edge1 edge2)(list origin edge1 edge2))
(define (origin-frame frame)(car frame))
(define (edge1-frame frame)(cadr frame))
(define (edge2-frame frame)(caddr frame))

; 線分コンストラクタ・セレクタ
(define (make-segment v1 v2)(cons v1 v2))
(define (start-segment seg)(car seg))
(define (end-segment seg)(cdr seg))

; ペインタ
(define (segments->painter segment-list)
  (lambda (frame)
    (for-each
     (lambda (segment)
       (draw-line
        ((frame-coord-map frame) (start-segment segment))
        ((frame-coord-map frame) (end-segment segment))))
     segment-list)))

; ペインタ変換と組み合わせ
(define (transform-painter painter origin corner1 corner2)
  (lambda (frame)
    (let ((m (frame-coord-map frame)))
      (let ((new-origin (m origin)))
        (painter
         (make-frame new-origin
                     (linear-transform frame corner1)
                     (linear-transform frame corner2)
                     )
         )
        )
      )
    )
  )


; 線形変換のベクトルは変更
(define (flip-vert painter)
  (transform-painter painter
                     ;(make-vect 0.0 1.0)
                     ;(make-vect 1.0 1.0)
                     ;(make-vect 0.0 0.0)
                     (make-vect 0.0 1.0)
                     (make-vect 1.0 0.0)
                     (make-vect 0.0 -1.0)
    )
  )

; 線形変換のベクトルは変更
(define (beside painter1 painter2)
  (let ((split-point (make-vect 0.5 0.0)))
    (let ((paint-left
           (transform-painter painter1
                              (make-vect 0.0 0.0)
                              split-point
                              (make-vect 0.0 1.0)
                              )
           )
          (paint-right
           (transform-painter painter2
                              ;split-point
                              ;(make-vect 1.0 0.0)
                              ;(make-vect 0.5 1.0)
                              split-point
                              split-point
                              (make-vect 0.0 1.0)
                              )
           )
          )
      (lambda (frame)
        (paint-left frame)
        (paint-right frame)))))

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

; waveペインタ
; 以下のサイトを参照しました。
; https://gist.github.com/tkmr/28498
(define wave
  (lambda (frame)
    ((segments->painter
      (list (make-segment (make-vect 0.000 0.645) (make-vect 0.154 0.411))
            (make-segment (make-vect 0.154 0.411) (make-vect 0.302 0.588))
            (make-segment (make-vect 0.302 0.588) (make-vect 0.354 0.497))
            (make-segment (make-vect 0.354 0.497) (make-vect 0.245 0.000))
            (make-segment (make-vect 0.419 0.000) (make-vect 0.497 0.171))
            (make-segment (make-vect 0.497 0.171) (make-vect 0.575 0.000))
            (make-segment (make-vect 0.748 0.000) (make-vect 0.605 0.462))
            (make-segment (make-vect 0.605 0.462) (make-vect 1.000 0.142))
            (make-segment (make-vect 1.000 0.354) (make-vect 0.748 0.657))
            (make-segment (make-vect 0.748 0.657) (make-vect 0.582 0.657))
            (make-segment (make-vect 0.582 0.657) (make-vect 0.640 0.857))
            (make-segment (make-vect 0.640 0.857) (make-vect 0.575 1.000))
            (make-segment (make-vect 0.419 1.000) (make-vect 0.354 0.857))
            (make-segment (make-vect 0.354 0.857) (make-vect 0.411 0.657))
            (make-segment (make-vect 0.411 0.657) (make-vect 0.285 0.657))
            (make-segment (make-vect 0.285 0.657) (make-vect 0.154 0.605))
            (make-segment (make-vect 0.154 0.605) (make-vect 0.000 0.857)))) frame)))

(import-as "picseg" 'pic)

(define (draw-line v1 v2)
  (let ((start-x (xcor-vect v1))
        (start-y (ycor-vect v1))
        (end-x (xcor-vect v2))
        (end-y (ycor-vect v2)))
    (pic.draw_line start-x start-y end-x end-y)
    ;(display "(")
    ;(display start-x)
    ;(display ",")
    ;(display start-y)
    ;(display ") (")
    ;(display end-x)
    ;(display ",")
    ;(display end-y)
    ;(display ")")
    ;(newline)
    )
  )

; ペインタの動作確認
(define (paint painter)
  (let ((frame0 (make-frame
                            (make-vect 0 0)
                            (make-vect 1 0)
                            (make-vect 0 1))))
    (pic.clear)
    (painter frame0)
    (pic.update)
    )
  )
; a.waveペインタに(笑っているような)線分を加えよ
; waveペインタは以下のサイトを参照しました。
; https://gist.github.com/tkmr/28498
(define wave-mod
  (lambda (frame)
    ((segments->painter
      (list (make-segment (make-vect 0.000 0.645) (make-vect 0.154 0.411))
            (make-segment (make-vect 0.154 0.411) (make-vect 0.302 0.588))
            (make-segment (make-vect 0.302 0.588) (make-vect 0.354 0.497))
            (make-segment (make-vect 0.354 0.497) (make-vect 0.245 0.000))
            (make-segment (make-vect 0.419 0.000) (make-vect 0.497 0.171))
            (make-segment (make-vect 0.497 0.171) (make-vect 0.575 0.000))
            (make-segment (make-vect 0.748 0.000) (make-vect 0.605 0.462))
            (make-segment (make-vect 0.605 0.462) (make-vect 1.000 0.142))
            (make-segment (make-vect 1.000 0.354) (make-vect 0.748 0.657))
            (make-segment (make-vect 0.748 0.657) (make-vect 0.582 0.657))
            (make-segment (make-vect 0.582 0.657) (make-vect 0.640 0.857))
            (make-segment (make-vect 0.640 0.857) (make-vect 0.575 1.000))
            (make-segment (make-vect 0.419 1.000) (make-vect 0.354 0.857))
            (make-segment (make-vect 0.354 0.857) (make-vect 0.411 0.657))
            (make-segment (make-vect 0.411 0.657) (make-vect 0.285 0.657))
            (make-segment (make-vect 0.285 0.657) (make-vect 0.154 0.605))
            (make-segment (make-vect 0.154 0.605) (make-vect 0.000 0.857))
            ; 追加分
            (make-segment (make-vect 0.410 0.850) (make-vect 0.440 0.830))
            (make-segment (make-vect 0.440 0.830) (make-vect 0.470 0.850))
            (make-segment (make-vect 0.530 0.850) (make-vect 0.560 0.830))
            (make-segment (make-vect 0.560 0.830) (make-vect 0.590 0.850))
      )) frame)))

(paint wave-mod)
; b.corner-splitで構成されるパターンを変更せよ
(define (corner-split2 painter n)
  (if (= n 0)
      painter
      (let ((up (up-split painter (- n 1)))
            (right (right-split painter (- n 1)))
            (corner (corner-split painter (- n 1))))
        (beside (below painter up)
                (below right corner))
        ;(beside (below painter right)
        ;        (below up corner))
        )
      )
  )


; テキストにあるright-splitの実装
(define (right-split painter n)
  (if (= n 0) painter
      (let ((smaller (right-split painter (- n 1))))
        (beside painter (below smaller smaller)))
      )
  )

; テキストにあるcorner-splitの実装
; up-splitの実装されていない
(define (corner-split painter n)
  (if (= n 0) painter
      (let ((up (up-split painter (- n 1)))
            (right (right-split painter (- n 1))))
        (let ((top-left (beside up up))
              (bottom-right (below right right))
              (corner (corner-split painter (- n 1))))
          (beside (below painter top-left) (below bottom-right corner))
          )
        )
      )
  )

; 回答
; up-spitの実装
(define (up-split painter n)
  (if (= n 0) painter
      (let ((smaller (up-split painter (- n 1))))
        (below painter (beside smaller smaller)))
      )
  )

(paint (corner-split2 wave 1))
(paint (corner-split2 wave 2))
(paint (corner-split2 wave 3))
; c.square-limit (square-of-four版)を隅を異なるパターンに修正せよ
(define (square-limit2 painter n)
  (let ((combine4 (square-of-four flip-horiz (lambda (x) x) rotate180 flip-vert)))
  ;(let ((combine4 (square-of-four flip-vert rotate180 (lambda (x) x) flip-horiz)))
    (combine4 (corner-split (flip-vert (flip-horiz painter)) n))
    ;(combine4 (corner-split painter n))
    )
  )

; 回答
; flip-horiz手続き
(define (flip-horiz painter)
  (transform-painter painter
                     (make-vect 1.0 0.0)
                     (make-vect -1.0 0.0)
                     (make-vect 0.0 1.0)
            )
  )

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

(define (square-of-four tl tr bl br)
  (lambda (painter)
    (let ((top (beside (tl painter) (tr painter)))
          (bottom (beside (bl painter) (br painter))))
      (below bottom top))))

; beside手続き
; フレームの仕様を変えたので線形変換のベクトルは変更してある。
(define (beside painter1 painter2)
  (let ((split-point (make-vect 0.5 0.0)))
    (let ((paint-left
           (transform-painter painter1
                              (make-vect 0.0 0.0)
                              split-point
                              (make-vect 0.0 1.0)
                              )
           )
          (paint-right
           (transform-painter painter2
                              ;split-point
                              ;(make-vect 1.0 0.0)
                              ;(make-vect 0.5 1.0)
                              split-point
                              split-point
                              (make-vect 0.0 1.0)
                              )
           )
          )
      (lambda (frame)
        (paint-left frame)
        (paint-right frame)))))

; 1つ目の回答
; beside手続きと同様の実装
(define (below painter1 painter2)
  (let ((split-point (make-vect 0.0 0.5)))
    (let ((paint-below
           (transform-painter painter1
                              (make-vect 0.0 0.0)
                              (make-vect 1.0 0.0)
                              (make-vect 0.0 0.5)))
          (paint-above
           (transform-painter painter2
                              (make-vect 0.0 0.5)
                              (make-vect 1.0 0.0)
                              (make-vect 0.0 0.5))))
      (lambda (frame)
        (paint-below frame)
        (paint-above frame)))))

(paint (square-limit2 wave 1))
(paint (square-limit2 wave 2))
(paint (square-limit2 wave 3))<jupyter_output><empty_output>
{'fraction_non_alphanumeric': 0.14463220675944333, 'fraction_numerical': 0.0728959575878065, 'mean_word_length': 1.6092500540306893, 'pattern_counts': {'":': 0, '<': 5, '<?xml version=': 0, '>': 8, 'https://': 3, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'chain_length': '1', 'dir': 'jupyter-structured-clean-dedup', 'id': '188790', 'license': 'CC0-1.0', 'n_tokens_mistral': 5313, 'n_tokens_neox': 4677, 'n_words': 963, 'path': 'exercises/2.52.ipynb', 'repo_name': 'tokits/sicp-study', 'size': '12072'}