-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy path2.3.rkt
162 lines (131 loc) · 3.82 KB
/
2.3.rkt
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
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
#lang sicp
;;;2.3
;;2.53
(list 'a 'b 'c)
(list (list 'george))
(cdr '((x1 x2) (y1 y2)))
(cadr '((x1 x2) (y1 y2)))
(pair? (car '(a short list)))
(define (memq item x)
(cond ((null? x) false)
((eq? item (car x)) x)
(else (memq item (cdr x)))))
(memq 'red '((red shoes) (blue socks)))
(memq 'red '(red shoes blue socks))
(define a (list 2 3))
(cdr a)
;;2.54
(define (equal? a b)
(cond ((and (not (pair? a)) (not (pair? b))) ;注意不能直接用symbol?
(eq? a b))
((and (pair? a) (pair? b))
(cond ((eq? (car a) (car b))
(equal? (cdr a) (cdr b)))
(else false)))
(else false)))
(equal? '(this is) '(this is))
(equal? '(this (is)) '(this is))
;;2.55
(car ''abcdefg)
;;2.56
(define (variable? x) (symbol? x))
(define (same-variable? x y)
(and (variable? x) (variable? y) (eq? x y)))
#|(define (deriv exp var)
(cond ((number? exp) 0)
((variable? exp)
(if (same-variable? exp var) 1 0))
((exponentiation? exp)
(make-product (derive (base exp) var)
(make-product (exponent exp)
(make-exponentiation (base exp) (- (exponent exp) 1)))))))
|#
(define (exponentiation? exp)
(and (pair? exp) (eq? (car exp) '^)))
(define (base exp)
(cadr exp))
(define (exponent exp) (caddr exp))
;;2.57
#|(define (augent a)
(accumulate make-sum 0 (cddr a)))
(define (multiplicand a)
(accumulate make-product 1 (cddr a)))
(define (accumulate op init sequence)
(cond ((null? sequence) init)
(else (op (car sequence)
(accumulate op init (cdr sequence))))))
|#
;;2.58
;a)
(define (make-sum a1 a2) (list a1 '+ a2));此处加一个化简更好
(define (addend s) (car s))
(define (augend s) (caddr s))
(define (sum? exp) (and (pair? exp) (eq? (cadr exp) '+)))
;b)可能会有些难 今晚困了 带不动
;;2.59
(define (element-of-set? x set)
(cond ((null? set) false)
((equal? x (car set)) true)
(else (element-of-set? x (cdr set)))))
(define (union-set-a s1 s2)
(cond ((null? s1) s2)
((null? s2) s1)
(else (if (element-of-set? (car s1) s2)
(union-set-a (cdr s1) s2)
(cons (car s1)
(union-set-a (cdr s1) s2))))))
(union-set-a '(3 1 4) '(2 3 4))
;;2.60 题目太多了 而且大概方法是一样的
;;2.61
(define (adjoin-set e set)
(cond ((> e (car set))
(cons (car set) (adjoin-set e (cdr set))))
((< e (car set))
(cons e set))
((= e (car set))
set)))
(adjoin-set 2 '(1 3 4 5))
(adjoin-set 2 '(1 2))
;(adjoin-set 3 '()) 需要加个if判断一下
;;2.62
(define (union-set s1 s2)
(cond ((null? s1) s2)
((null? s2) s1)
(else (let ( (x1 (car s1)) (x2 (car s2)) )
(cond ((= x1 x2)
(cons x1
(union-set (cdr s1)
(cdr s2))))
((< x1 x2)
(cons x1
(union-set (cdr s1)
s2)))
((> x1 x2)
(cons x2
(union-set s1
(cdr s2)))))))))
(union-set '(1 3 4) '(2 3 4))
;;2.63
#|
a)
tree-to-list-1:
tree-to-list-2:
相同
b)
第二种通过迭代的方式增长的更慢
|#
;;2.64 有点复杂 要午睡了 呜呜呜 list-to-tree
;;2.65 用了各种组合 大大清晰‘简化’了操作
(define (union-tree t1 t2)
(list-to-tree (union-set (tree-to-set t1)
(tree-to-set t2))))
(define (intersection-tree t1 t2)
(list-to-tree (intersection-set (tree-to-set t1)
(tree-to-set t2))))
;;2.66
;;2.67
;;2.68
;;2.69
;;2.70
;;2.71
;;2.72