Todo
2.19
Exercise 2.17
(define (last-pair list)
(if (null? (cdr list))
list
(last-pair (cdr list))))
;;gosh> (last-pair (list 23 72 149 34))
;;(34)
Exercise 2.18
(define (reverse_r l)
(if (null? l)
'()
(append (reverse_r (cdr l)) (list (car l)))))
(define (reverse_i l)
(define (reverse_iter l rl)
(if (null? l)
rl
(reverse_iter (cdr l) (cons (car l) rl))))
(reverse_iter l ()))
;;gosh> (define a (list 1 4 9 16 24))
;;a
;;gosh> (reverse_r a)
;;(24 16 9 4 1)
;;gosh> (reverse_i a)
;;(24 16 9 4 1)
Exercise 2.19
後日
Exercise 2.20
(define (same-parity-r x . y)
(let ((even/odd? (if (even? x) even? odd?))
(items (cons x y)))
(define (rec l)
(cond ((null? l) l)
((even/odd? (car l)) (cons (car l) (rec (cdr l))))
(else (rec (cdr l)))))
(rec items)))
(define (same-parity-i x . y)
(let ((even/odd? (if (even? x) even? odd?)))
(define (iter y l)
(cond ((null? y) (cons x (reverse l)))
((even/odd? (car y)) (iter (cdr y) (cons (car y) l)))
(else (iter (cdr y) l))))
(iter y '())))
;;gosh> (same-parity-i 1 2 3 4 5 6 7)
;;(1 3 5 7)
;;gosh> (same-parity-i 2 3 4 5 6 7)
;;(2 4 6)
;;gosh> (same-parity-r 1 2 3 4 5 6 7)
;;(1 3 5 7)
;;gosh> (same-parity-r 2 3 4 5 6 7)
;;(2 4 6)
Exercise 2.21
(define (square-list-r l)
(if (null? l)
'()
(cons (square (car l)) (square-list-r (cdr l)))))
(define (square-list-m l)
(map square l))
;;gosh> (square-list-r (list 1 2 3 4))
;;(1 4 9 16)
;;gosh> (square-list-m (list 1 2 3 4))
;;(1 4 9 16)
Exercise 2.22
;; square-list-1ではanswerにはthingsの最初の項が最後に、thingsの次の項が最後から2番目にとlistされるため。
(define (square-list-1 items)
(define (iter things answer)
(if (null? things)
answer
(iter (cdr things)
(cons (square (car things))
answer))))
(iter items '()))
;; square-list-2ではanswerのcar部にこれまでの結果が、cdr部にsquareのドットペアを生成している。
(define (square-list-2 items)
(define (iter things answer)
(if (null? things)
answer
(iter (cdr things)
(cons answer
(square (car things))))))
(iter items '()))
;; 素直に
(define (square-list-3 items)
(define (iter things answer)
(if (null? things)
(reverse answer)
(iter (cdr things)
(cons (square (car things))
answer))))
(iter items '()))
;;gosh> (square-list-1 (list 1 2 3 4))
;;(16 9 4 1)
;;gosh> (square-list-2 (list 1 2 3 4))
;;((((() . 1) . 4) . 9) . 16)
;;gosh> (square-list-3 (list 1 2 3 4))
;;(1 4 9 16)
Exercise 2.23
(define (for-each proc items)
(if (null? items)
#t
(begin (proc (car items)) (for-each proc (cdr items)))))
;;gosh> (for-each (lambda (x) (newline) (display x)) '(57 321 88))
;;
;;57
;;321
;;88#t
Exercise 2.24
;; (1 (2 (3 4)))
;; / : nilのつもり
;; [1 : ]->[ :/ ]
;; |
;; [2 : ]->[ :/ ]
;; |
;; [3 : ]->[4 :/ ]
;; treeは省略
;;gosh> (list 1 (list 2 (list 3 4)))
;;(1 (2 (3 4)))
Exercise 2.25
;;gosh> (car (cdr (car (cdr (cdr '(1 3 (5 7) 9))))))
;;7
;;gosh> (car (car '((7))))
;;7
;;gosh> (car (cdr (car (cdr (car (cdr (car (cdr (car (cdr (car (cdr '(1 (2 (3 (4 (5 (6 7))))))))))))))))))
;;7
Exercise 2.26
;; (append x y) -> (1 2 3 4 5 6)
;; (cons x y) -> ((1 2 3) 4 5 6)
;; (list x y) -> ((1 2 3) (4 5 6))
;;gosh> (define x '(1 2 3))
;;x
;;gosh> (define y '(4 5 6))
;;y
;;gosh> (append x y)
;;(1 2 3 4 5 6)
;;gosh> (cons x y)
;;((1 2 3) 4 5 6)
;;gosh> (list x y)
;;((1 2 3) (4 5 6))
Exercise 2.27
(define (deep-reverse l)
(if (null? l)
'()
(append (deep-reverse (cdr l))
(list (if (pair? (car l))
(deep-reverse (car l))
(car l))))))
;;gosh> (define x '(( 1 (1 2)) ((3 4) 4)))
;;x
;;gosh> x
;;((1 (1 2)) ((3 4) 4))
;;gosh> (deep-reverse x)
;;((4 (4 3)) ((2 1) 1))
Exercise 2.28
(define (fringe tree)
(cond ((null? tree) '())
((pair? tree) (append (fringe (car tree)) (fringe (cdr tree))))
(else (list tree))))
;;gosh> x
;;((1 (1 2)) ((3 4) 4))
;;gosh> (fringe x)
;;(1 1 2 3 4 4)
;;gosh> (fringe (list x x))
;;(1 1 2 3 4 4 1 1 2 3 4 4)
Exercise 2.29
;; constructor
(define (make-mobile left right)
(list left right))
(define (make-branch length structure)
(list length structure))
;; a. seletor
(define (left-branch m)
(car m))
(define (right-branch m)
(cadr m))
(define (branch-length b)
(car b))
(define (branch-structure b)
(cadr b))
;; b. total-weight
(define (total-weight m)
(let ((left-s (branch-structure (left-branch m)))
(right-s (branch-structure (right-branch m))))
(+ (if (number? left-s) left-s (total-weight left-s))
(if (number? right-s) right-s (total-weight right-s)))))
;; c. balanced?
(define (balanced? m)
(define (rec m)
(let ((left (branch-structure (left-branch m)))
(right (branch-structure (right-branch m))))
(let ((left-w (if (number? left) left (rec left)))
(right-w (if (number? right) right (rec right)))
(left-l (branch-length (left-branch m)))
(right-l (branch-length (right-branch m))))
(if (and (number? left-w) (number? right-w)
(= (* left-w left-l) (* right-w right-l)))
(+ left-w right-w)
#f))))
(number? (rec m)))
;; d.
;; constructor
(define (d) ;-----以下のconstructorとselectorを使う時はコメントアウトする。
(define (make-mobile left right)
(cons left right))
(define (make-branch length structure)
(cons length structure))
;; seletor
(define (left-branch m)
(car m))
(define (right-branch m)
(cdr m))
(define (branch-length b)
(car b))
(define (branch-structure b)
(cdr b))
) ;------
;; test data -- : 長さ １ 数字 ： 錘
;; --+------
;; | |
;; ----+-- 2
;; | |
;; 2 4
(define bl2w2 (make-branch 2 2))
(define bl1w4 (make-branch 1 4))
(define mbl2w2bl1w4 (make-mobile bl2w2 bl1w4))
(define bl3w2 (make-branch 3 2))
(define bl1mbl2w2bl1w4 (make-branch 1 mbl2w2bl1w4))
(define m-top (make-mobile bl1mbl2w2bl1w4 bl3w2))
(define bl2w3 (make-branch 2 3))
(define mbl2w3bl1w4 (make-mobile bl2w3 bl1w4))
(define bl1mbl2w3bl1w4 (make-branch 1 mbl2w3bl1w4))
(define m-top-x (make-mobile bl1mbl2w3bl1w4 bl3w2))
;;gosh> (total-weight m-top)
;;8
;;gosh> (total-weight m-top-x)
;;9
;;gosh> (balanced? m-top)
;;#t
;;gosh> (balanced? m-top-x)
;;#f
Exercise 2.30
(define (square-tree-d t)
(cond ((null? t) '())
((number? t) (square t))
(else (cons (square-tree-d (car t))
(square-tree-d (cdr t))))))
(define (square-tree-m t)
(map (lambda (st)
(if (pair? st)
(square-tree-m st)
(square st)))
t))
;;gosh> tree
;;(1 (2 (3 4) 5) (6 7))
;;gosh> (square-tree-d tree)
;;(1 (4 (9 16) 25) (36 49))
;;gosh> (square-tree-m tree)
;;(1 (4 (9 16) 25) (36 49))
Exercise 2.31
(define (tree-map f t)
(map (lambda (st)
(if (pair? st)
(tree-map f st)
(f st)))
t))
;;gosh> (define tree (list 1 (list 2 (list 3 4) 5) (list 6 7)))
;;tree
;;gosh> (define (square-tree tree) (tree-map square tree))
;;square-tree
;;gosh> (square-tree tree)
;;(1 (4 (9 16) 25) (36 49))
Exercise 2.32
(define (subsets s)
(if (null? s)
(list '())
(let ((rest (subsets (cdr s))))
(append rest (map (lambda (x) (cons (car s) x)) rest)))))
;;gosh> (display (subsets '(1 2 3)))
;;(() (3) (2) (2 3) (1) (1 3) (1 2) (1 2 3))#<undef>
;;letの変数の値を求める処理が引数のcdrをとる再帰となっているので、
;; sの値 restの値 mapの結果 subsetsの値
;; 1. '() - - (())
;; 2. (3) (()) (3) (() (3))
;; 3. (2 3) (() (3)) ((2) (2 3)) (() (3) (2) (2 3))
;; 4. (1 2 3) (() (3) (2) (2 3)) ((1) (1 3) (1 2) (1 2 3)) (() (3) (2) (2 3) (1) (1 3)
;; (1 2) (1 2 3)
Exercise 2.33
(define (map-n p sequence)
(accumulate (lambda (x y) (cons (p x) y)) '() sequence))
(define (append-n seq1 seq2)
(accumulate cons seq2 seq1))
(define (length-n sequence)
(accumulate (lambda (x y) (+ 1 y)) 0 sequence))
;;gosh> (map-n cadr '((a b) (d e) (g h)))
;;(b e h)
;;gosh> (append-n '(a (b)) '((c)))
;;(a (b) (c))
;;gosh> (length-n '(a (b) (c d e)))
;;3
Exercise 2.34
(define (horner-eval x coefficient-sequence)
(accumulate
(lambda (this-coeff higher-term)
(+ this-coeff (* x higher-term)))
0
coefficient-sequence))
;;gosh> (horner-eval 2 (list 1 3 0 5 0 1))
;;79
Exercise 2.35
(define (count-leaves-a t)
(accumulate + 0
(map (lambda (x)
(if (pair? x)
(count-leaves-a x)
1))
t)))
;;gosh> (define x (cons (list 1 2) (list 3 4)))
;;x
;;gosh> x
;;((1 2) 3 4)
;;gosh> (count-leaves-a x)
;;4
;;gosh> (count-leaves-a (list x x))
;;8
Exercise 2.36
(define (accumulate-n op init seqs)
(if (null? (car seqs))
'()
(cons (accumulate op init (map car seqs))
(accumulate-n op init (map cdr seqs)))))
;;gosh> (accumulate-n + 0 s)
;;(22 26 30)
Exercise 2.37
(define (dot-product v w)
(accumulate + 0 (map * v w)))
(define (matrix-*-vector m v)
(map (lambda (w) (dot-product v w)) m))
(define (transpose mat)
(accumulate-n cons '() mat))
(define (matrix-*-matrix m n)
(let ((cols (transpose n)))
(map (lambda (v) (map (lambda (w) (dot-product v w)) cols)) m)))
;;gosh> m
;;((1 2 3 4) (4 5 6 6) (6 7 8 9))
;;gosh> v
;;(2 3 4 5)
;;gosh> (matrix-*-vector m v)
;;(40 77 110)
;;gosh> (transpose m)
;;((1 4 6) (2 5 7) (3 6 8) (4 6 9))
;;gosh> (matrix-*-matrix m (transpose m))
;;((30 56 80) (56 113 161) (80 161 230))
Exercise 2.38
(define (fold-right op init seq)
(accumulate op init seq))
(define (fold-left op init seq)
(define (iter result rest)
(if (null? rest)
result
(iter (op result (car rest))
(cdr rest))))
(iter init seq))
;; 交換則が成り立つかな？
;;gosh> (fold-right / 1 (list 1 2 3))
;;3/2
;;gosh> (fold-left / 1 (list 1 2 3))
;;1/6
;;gosh> (fold-right list '() (list 1 2 3))
;;(1 (2 (3 ())))
;;gosh> (fold-left list '() (list 1 2 3))
;;(((() 1) 2) 3)
;;gosh> (fold-right + 0 (list 1 2 3))
;;6
;;gosh> (fold-left + 0 (list 1 2 3))
;;6
Exercise 2.39
(define (reverse-r seq)
(fold-right (lambda (x y) (append y (list x))) '() seq))
(define (reverse-l seq)
(fold-left (lambda (x y) (cons y x)) '() seq))
;;gosh> (define seq '(1 2 3 4))
;;seq
;;gosh> (reverse-r seq)
;;(4 3 2 1)
;;gosh> (reverse-l seq)
;;(4 3 2 1)
Exercise 2.40
(define (uniqe-pairs n)
(flatmap (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?
(uniqe-pairs n))))
(define (make-pair-sum pair)
(list (car pair) (cadr pair) (+ (car pair) (cadr pair))))
(define (prime-sum? pair)
(prime? (+ (car pair) (cadr pair))))
;;gosh> (uniqe-pairs 5)
;;((2 1) (3 1) (3 2) (4 1) (4 2) (4 3) (5 1) (5 2) (5 3) (5 4))
;;gosh> (prime-sum-pairs 6)
;;((2 1 3) (3 2 5) (4 1 5) (4 3 7) (5 2 7) (6 1 7) (6 5 11))
Exercise 2.41
(define (ordered-triples-sum n s)
(filter (lambda (triples)
(let ((i (car triples))
(j (cadr triples))
(k (caddr triples)))
(if (= (+ i j k) s)
#t
#f)))
(flatmap (lambda (k)
(flatmap (lambda (j)
(map (lambda (i) (list i j k))
(enumerate-interval 1 j)))
(enumerate-interval 1 k)))
(enumerate-interval 1 n))))
;;gosh> (ordered-triples-sum 6 8)
;;((2 3 3) (2 2 4) (1 3 4) (1 2 5) (1 1 6))
;;だと思っていたら、distinctを理解していなかった。
(define (ordered-triples-sum n s)
(filter (lambda (triples)
(let ((i (car triples))
(j (cadr triples))
(k (caddr triples)))
(if (and (< i j k) (= (+ i j k) s))
#t
#f)))
(flatmap (lambda (k)
(flatmap (lambda (j)
(map (lambda (i) (list i j k))
(enumerate-interval 1 j)))
(enumerate-interval 1 k)))
(enumerate-interval 1 n))))
;;gosh> (ordered-triples-sum 6 8)
;;((1 3 4) (1 2 5))
Exercise 2.42
(define empty-board '())
(define (safe? k positions)
(let ((qk (car positions)))
(define (safe-colum? i rest-of-colums)
(cond ((null? rest-of-colums) #t)
(else (let ((qi (car rest-of-colums)))
(cond ((or (= qk qi) (= (+ qk i) qi) (= (- qk i) qi)) #f)
(else (safe-colum? (+ i 1) (cdr rest-of-colums))))))))
;; (display positions) (display (safe-colum? 1 (cdr positions)))(newline)
(safe-colum? 1 (cdr positions))))
(define (adjoin-position new-row k rest-of-queens)
(cons new-row rest-of-queens))
(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))
;;gosh> (queens 4)
;;((3 1 4 2) (2 4 1 3))
;;gosh> (write (queens 5))
;;((4 2 5 3 1) (3 5 2 4 1) (5 3 1 4 2) (4 1 3 5 2) (5 2 4 1 3) (1 4 2 5 3) (2 5 3 1 4) (1 3 5 2 4) (3 1 4 2 5) (2 4 1 3 5))#<undef>
;;gosh> (length (queens 8))
;;92
kが使えてない！
対称形の考慮など奥深そうな問題だけど・・・
Exercise 2.43
;; queen-colsの呼ばれる回数は、board-sizeをnとすると
;; queens-a ： カラムに対して一度 -> 1+n
;; queens-b ： カラムの各ロウに対して再帰的にカラム数だけ ->
;; 1+n^1+n^2+n^3+...+n^n
;; 時間の推定は？？？
(define (queens-a board-size)
(let ((cc 0) (sc 0))
(define (queen-cols k)
(set! cc (+ cc 1))
;;(display "queens-cols:") (display k) (display " ")
(if (= k 0)
(list empty-board)
(filter
(lambda (positions) (set! sc (+ sc 1)) (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) (display cc) (display " ") (display sc) (display " ") (display (* 1.0 (/ sc cc)))))
(define (queens-b board-size)
(let ((cc 0) (sc 0))
(define (queen-cols k)
(set! cc (+ cc 1))
;; (display "queens-cols:") (display k) (display " ")
(if (= k 0)
(list empty-board)
(filter
(lambda (positions) (set! sc (+ sc 1)) (safe? k positions))
(flatmap
(lambda (new-row)
(map (lambda (rest-of-queens)
(adjoin-position new-row k rest-of-queens))
(queen-cols (- k 1))))
(enumerate-interval 1 board-size)))))
(queen-cols board-size) (display cc) (display " ") (display sc)(display " ") (display (* 1.0 (/ sc cc)))))
;;gosh> (queens-a 3)
;;4 18#<undef>
;;gosh> (queens-b 3)
;;40 60#<undef>
;;gosh> (queens-a 4)
;;5 60#<undef>
;;gosh> (queens-b 4)
;;341 624#<undef>
;;gosh> (queens-a 5)
;;6 220#<undef>
;;gosh> (queens-b 5)
;;3906 8160#<undef>
;;gosh> (queens-a 6)
;;7 894#<undef>
;;gosh> (queens-b 6)
;;55987 128904#<undef>
Exercise 2.44
(define (up-split painter n)
(if (= n 0)
painter
(let ((smaller (up-split painter (- n 1))))
(below painter (beside smaller smaller)))))
Exercise 2.45
(define (split op1 op2)
(lambda (painter n)
(if (= n 0)
painter
(let ((smaller ((split op1 op2) painter (- n 1))))
(op1 painter (op2 smaller smaller))))))
(define right-split (split beside below))
(define up-split (split below beside))
;;(plot (corner-split wave 4))
Exercise 2.46
;; constructor
(define (make-vect x y)
(cons x y))
;; selectors
(define (xcor-vect v)
(car v))
(define (ycor-vect v)
(cdr v))
;; operations
(define (add-vect v1 v2)
(make-vect (+ (xcor-vect v1) (xcor-vect v2))
(+ (ycor-vect v1) (ycor-vect v2))))
(define (sub-vect v1 v2)
(add-vect v1 (scale-vect -1 v2)))
(define (scale-vect s v)
(make-vect (* s (xcor-vect v)) (* s (ycor-vect v))))
;;gosh> (define v21 (make-vect 2 1))
;;v21
;;gosh> v21
;;(2 . 1)
;;gosh> (xcor-vect v21)
;;2
;;gosh> (ycor-vect v21)
;;1
;;gosh> (define v-24 (make-vect -2 4))
;;v-24
;;gosh> (add-vect v21 v-24)
;;(0 . 5)
;;gosh> (sub-vect v21 v-24)
;;(4 . -3)
;;gosh> (scale-vect 2 v21)
;;(4 . 2)
Exercise 2.47
;; constructor
(define (make-frame origin edge1 edge2)
(list origin edge1 edge2))
;; selectors
(define (origin-frame f)
(car f))
(define (edge1-frame f)
(cadr f))
(define (edge2-frame f)
(caddr f))
;; constructor-2
(define (make-frame-p origin edge1 edge2)
(cons origin (cons edge1 edge2)))
;; selectors
(define (origin-frame-p f)
(car f))
(define (edge1-frame-p f)
(cadr f))
(define (edge2-frame-p f)
(cddr f))
;;gosh> (define origin (make-vect 1 1))
;;origin
;;gosh> (define edge1 (make-vect 2 2))
;;edge1
;;gosh> (define edge2 (make-vect 3 3))
;;edge2
;;gosh> (define frame (make-frame origin edge1 edge2))
;;frame
;;gosh> (origin-frame frame)
;;(1 . 1)
;;gosh> (edge1-frame frame)
;;(2 . 2)
;;gosh> (edge2-frame frame)
;;(3 . 3)
;;gosh> (define frame-p (make-frame-p origin edge1 edge2))
;;frame-p
;;gosh> (origin-frame-p frame-p)
;;(1 . 1)
;;gosh> (edge1-frame-p frame-p)
;;(2 . 2)
;;gosh> (edge2-frame-p frame-p)
;;(3 . 3)
Exercise 2.48
;; constructor
(define (make-segment sv ev)
(cons sv ev))
;; selectors
(define (start-segment s)
(car s))
(define (end-segment s)
(cdr s))
Exercise 2.49
;; a
(define frame-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)))))
;; b
(define X-painter (segments->painter
(list (make-segment (make-vect 0.0 0.0)
(make-vect 1.0 1.0))
(make-segment (make-vect 1.0 0.0)
(make-vect 0.0 1.0)))))
;; c
(define diamond-painter (segments->painter
(list (make-segment (make-vect 0.0 0.5)
(make-vect 0.5 0.0))
(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)))))
;; d naoya_t氏に感謝
(define wave (segments->painter
(append
(make-path (make-vect 0.0 0.86)
(make-vect 0.16 0.60)
(make-vect 0.28 0.65)
(make-vect 0.42 0.65)
(make-vect 0.35 0.86)
(make-vect 0.42 1.0))
(make-path (make-vect 0.58 1.0)
(make-vect 0.65 0.86)
(make-vect 0.58 0.65)
(make-vect 0.76 0.65)
(make-vect 1.0 0.35))
(make-path (make-vect 1.0 0.14)
(make-vect 0.60 0.46)
(make-vect 0.76 0.0))
(make-path (make-vect 0.58 0.0)
(make-vect 0.50 0.17)
(make-vect 0.42 0.0))
(make-path (make-vect 0.24 0.0)
(make-vect 0.35 0.51)
(make-vect 0.30 0.59)
(make-vect 0.16 0.41)
(make-vect 0.0 0.65))
)))
;;(plot wave)
Exercise 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 (rotate180 painter)
(flip-horiz (flip-vert painter)))
(define (rotate270 painter)
(rotate90 (rotate180 painter)))
;;(plot (rotate180 wave))
;;(plot (rotate270 wave))
Exercise 2.51
(define (below p1 p2)
(let ((split-point (make-vect 0.0 0.5)))
(let ((paint-lower
(transform-painter p1
(make-vect 0.0 0.0)
(make-vect 1.0 0.0)
split-point))
(paint-upper
(transform-painter p2
split-point
(make-vect 1.0 0.5)
(make-vect 0.0 1.0))))
(lambda (frame)
(paint-lower frame)
(paint-upper frame)))))
(define (below1 p1 p2)
(rotate90 (beside (rotate270 p1) (rotate270 p2))))
;;(plot (below wave wave))
Exercise 2.51
;; a
(define wave2 (segments->painter
(append
(make-path (make-vect 0.0 0.86)
(make-vect 0.16 0.60)
(make-vect 0.28 0.65)
(make-vect 0.42 0.65)
(make-vect 0.35 0.86)
(make-vect 0.42 1.0))
(make-path (make-vect 0.58 1.0)
(make-vect 0.65 0.86)
(make-vect 0.58 0.65)
(make-vect 0.76 0.65)
(make-vect 1.0 0.35))
(make-path (make-vect 1.0 0.14)
(make-vect 0.60 0.46)
(make-vect 0.76 0.0))
(make-path (make-vect 0.58 0.0)
(make-vect 0.50 0.17)
(make-vect 0.42 0.0))
(make-path (make-vect 0.24 0.0)
(make-vect 0.35 0.51)
(make-vect 0.30 0.59)
(make-vect 0.16 0.41)
(make-vect 0.0 0.65))
(make-path (make-vect 0.45 0.73)
(make-vect 0.50 0.75)
(make-vect 0.55 0.73))
)))
;;(plot wave2)
;; b
(define (corner-split 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)))))
;;(plot (corner-split wave2 4))
;; c
(define (square-limit painter n)
(let ((combine4 (square-of-four flip-horiz identity
rotate180 flip-vert)))
(combine4 (corner-split (flip-horiz painter) n))))
;;(plot (square-limit wave2 0))
最終更新：2008年02月27日 22:10
