乐正

Actions speak louder than words.

Sicp-ex2-49

问题

利用segments->painter定义下面基本画家:

  • 画出给定框架边界的画家
  • 通过连接给定框架两对角画出一个大叉子的画家
  • 通过连接框架各边的中点画出一个菱形的画家
  • 画家wave

解答

练习2.49 (ex2-49.scm) download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
(define (boundary->painter frame)
  (let ((seg1 (make-segment (origin-frame frame)
                            (edge1-frame frame)))
        (seg2 (make-segment (origin-frame frame)
                            (edge2-frame frame)))
        (new-origin (add-vect (edge1-frame frame)
                              (edge2-frame frame)))
        (seg3 (make-segment new-origin
                            (edge1-frame frame)))
        (seg4 (make-segment new-origin
                            (edge2-frame frame))))
    (segments->painter (list seg1 seg2 seg3 seg4))))

(define (diagonal->painter frame)
  (let ((segment1 (make-segment (origin-frame frame)
                                (add-vect (edge1-frame frame)
                                          (edge2-frame frame))))
        (segment2 (make-segment (edge1-frame frame)
                                (edge2-frame frame))))
    (segments->painter (list segment1 segment2))))

(define (diamond->painter frame)
  (let ((lcp (make-vect (xcor-vect (edge1-frame frame))
                        (/ (ycor-vect (edge1-frame frame)) 2)))
        (tcp (make-vect (/ (xcor-vect (edge2-frame frame)) 2)
                        (ycor-vect (edge2-frame frame))))
        (rcp (make-vect (xcor-vect (edge2-frame frame))
                        (/ (ycor-vect (edge1-frame frame)) 2)))
        (bcp (make-vect (/ (xcor-vect (edge2-frame frame)) 2)
                        (ycor-vect (edge2-frame frame)))))

    (segments->painter (list (make-segment lcp tcp)
                             (make-segment tcp rcp)
                             (make-segment rcp bcp)
                             (make-segment bcp lcp)))))

(define (wave frame)
  (let ((lp1 (make-vect (xcor-vect (edge1-frame frame))
                        (* 2 (/ (ycor-vect (edge1-frame frame) 3)))))
        (lp2 (make-vect (xcor-vect (edge1-frame frame))
                        (* 5 (/ (ycor-vect (edge1-frame frame) 6)))))i
        (tp1 (make-vect (* 2 (/ (xcor-vect (edge2-frame frame) 5)))
                        (ycor-vect (edge1-frame frame))))
        (tp2 (make-vect (* 3 (/ (xcor-vect (edge2-frame frame) 5)))
                        (ycor-vect (edge1-frame frame))))
        (rp1 (make-vect (xcor-vect (edge2-frame frame))
                        (* 1 (/ (ycor-vect (edge1-frame frame)) 3))))
        (rp2 (make-vect (xcor-vect (edge2-frame frame))
                        (* 1 (/ (ycor-vect (edge1-frame frame)) 6))))
        (bp1 (make-vect (* 3 (/ (xcor-vect (edge2-frame frame)) 4))
                        (ycor-vect (edge2-frame frame))))
        (bp2 (make-vect (* 5 (/ (xcor-vect (edge2-frame frame)) 8))
                        (ycor-vect (edge2-frame frame))))
        (bp3 (make-vect (* 3 (/ (xcor-vect (edge2-frame frame)) 8))
                        (ycor-vect (edge2-frame frame))))
        (bp4 (make-vect (* 1 (/ (xcor-vect (edge2-frame frame)) 4))
                        (ycor-vect (edge2-frame frame))))
        (cp1 (make-vect (* 1 (/ (xcor-vect (edge2-frame frame)) 8))
                        (* 3 (/ (ycor-vect (edge1-frame frame)) 8))))
        (cp2 (make-vect (xcor-vect bp4)
                        (ycor-vect lp1)))
        (cp3 (make-vect (* 1 (/ (xcor-vect (edge2-frame frame)) 3))
                        ((/ (ycor-vect (edge1-frame frame)) 2))))
        (cp4 (make-vect (/ (xcor-vect (edge2-frame frame)) 2)
                        ((/ (ycor-vect (edge1-frame frame)) 4))))
        (cp5 (make-vect (xcor-vect bp2)
                        (/ (ycor-vect (edge1-frame frame)) 2)))
        (cp6 (make-vect (xcor-vect bp1)
                        (/ (ycor-vect (edge1-frame frame) 3))))
        (cp7 (make-vect (xcor-vect bp2)
                        (ycor-vect cp6)))
        (cp8 (make-vect (xcor-vect cp2)
                        (ycor-vect lp2)))
        (cp9 (make-vect (xcor-vect bp4)
                        (ycor-vect lp2)))
        (cp10 (make-vect (xcor-vect bp3)
                         (ycor-vect cp6)))
        (cp11 (make-vect (xcor-vect cp2)
                         (ycor-vect cp6)))
        (cp12 (make-vect (xcor-vect cp1)
                         (ycor-vect lp1))))

    (segments->painter (list (make-segment lp1 cp1)
                             (make-segment cp1 cp2)
                             (make-segment cp2 cp3)
                             (make-segment cp3 bp4)
                             (make-segment bp3 cp4)
                             (make-segment cp4 bp2)
                             (make-segment bp1 cp5)
                             (make-segment cp5 rp2)
                             (make-segment rp1 cp6)
                             (make-segment cp6 cp7)
                             (make-segment cp7 cp8)
                             (make-segment cp8 tp2)
                             (make-segment tp1 cp9)
                             (make-segment cp9 cp10)
                             (make-segment cp10 cp11)
                             (make-segment cp11 cp12)
                             (make-segment cp12 lp2)))))

draft

« sicp-ex2-48 数据挖掘导论读书笔记-绪论 »

Comments