The little scheme 书上的部分scheme代码（Guile 实现）- 2

下面这些给我留下了很深的印象
always ask null? as the first question in expressing any function.
when building a list, describe the first typical element, then cons it onto the natural recursion.
always change at least one argument when use recurring.it must be changed to be closer to termination.
The changing argument must be tested in the termination condition. when using cdr, test termination
with null?.
when recurring on a list of atomes, lat , use (cdr lat).
when recurring on a number, n, use (sub1 n),

when recurring on a list of Scheme-expressions, l, ask three questions.
(null? l)
(atom? (car l))
and else.
use (car l) and (cdr l) if neither (null? l) nor (atom? (car l)) are true.

点击(此处)折叠或打开

1. #! /usr/bin/guile -s
   
2. !#
   
3. (define atom?
   
4.     (lambda (x)
   
5.         (and (not (pair? x)) (not (null? x)))))
   
6. 
   
7. 
   
8. ;; remove all the atom a from a list
   
9. (define rember*
   
10.     (lambda (a l)
    
11.         (cond
    
12.             ((null? l) '())
    
13.             ((atom? (car l))
    
14.             (cond
    
15.                 ((eq? (car l) a) (rember* a (cdr l)))
    
16.                 (else (cons (car l) (rember* a (cdr l))))))
    
17.             (else (cons (rember* a (car l)) (rember* a (cdr l)))))))
    
18. 
    
19. 
    
20. 
    
21. ;; insertR*
    
22. (define insertR*
    
23.     (lambda (new old l)
    
24.         (cond
    
25.             ((null? l) '())
    
26.             ((atom? (car l))
    
27.             (cond
    
28.                 ((eq? (car l) old) (cons old (cons new (insertR* new old (cdr l)))))
    
29.                 (else (cons (car l) (insertR* new old (cdr l))))))
    
30.             (else (cons (insertR* new old (car l)) (insertR* new old (cdr l)))))))
    
31. 
    
32. ;; occur*
    
33. (define occur*
    
34.     (lambda (a l)
    
35.         (cond
    
36.             ((null? l) 0)
    
37.             ((atom? (car l))
    
38.             (cond
    
39.                 ((eq? (car l) a) (+ 1 (occur* a (cdr l))))
    
40.                 (else (occur* a (cdr l)))))
    
41.             (else
    
42.                 (+ (occur* a (car l)) (occur* a (cdr l)))))))
    
43. 
    
44. ;; subst*
    
45. 
    
46. (define subst*
    
47.     (lambda (new old l)
    
48.         (cond
    
49.             ((null? l) '())
    
50.             ((atom? (car l))
    
51.             (cond
    
52.                 ((eq? (car l) old) (cons new (subst* new old (cdr l))))
    
53.                 (else (cons (car l) (subst* new old (cdr l))))))
    
54.             (else
    
55.                 (cons (subst* new old (car l)) (subst* new old (cdr l)))))))
    
56. 
    
57. ;; insertL*
    
58. (define insertL*
    
59.     (lambda (new old l)
    
60.         (cond
    
61.             ((null? l) '())
    
62.             ((atom? (car l))
    
63.             (cond
    
64.                 ((eq? (car l) old) (cons new l))
    
65.                 (else (cons (car l) (insertL* new old (cdr l))))))
    
66.             (else
    
67.                 (cons (insertL* new old (car l)) (insertL* new old (cdr l)))))))
    
68. 
    
69. 
    
70. ;; member*
    
71. (define member*
    
72.     (lambda (a l)
    
73.         (cond
    
74.             ((null? l) #f)
    
75.             ((atom? (car l)) (or (eq? (car l) a) (member* a (cdr l))))
    
76.             (else
    
77.                 (or (member* a (car l)) (member* a (cdr l)))))))
    
78. 
    
79. 
    
80. 
    
81. ;; leftmost
    
82. (define leftmost
    
83.     (lambda (l)
    
84.         (cond
    
85.             ((null? l) #f)
    
86.             ((atom? (car l)) (car l))
    
87.             (else
    
88.                 (leftmost (car l))))))
    
89. 
    
90. 
    
91. 
    
92. ;; compare two atom
    
93. (define eqan?
    
94.     (lambda (a b)
    
95.         (cond
    
96.             ((and (number? a) (number? b)) (= a b))
    
97.             ((or (number? a) (number? b)) #f)
    
98.             (else (eq? a b)))))
    
99. 
    
100. 
     
101. ;; eqlist3?
     
102. (define eqlist3?
     
103.     (lambda (l1 l2)
     
104.         (cond
     
105.             ((and (null? l1) (null? l2)) #t)
     
106.             ((and (null? l1) (atom? (car l2))) #f)
     
107.             ((null? l1) #f)
     
108.             ((and (atom? (car l1)) (null? l2)) #f)
     
109.             ((and (atom? (car l1)) (atom? (car l2)))
     
110.              (and (eqan? (car l1) (car l2)) (eqlist3? (cdr l1) (cdr l2))))
     
111.             ((atom? (car l1)) #f)
     
112.             ((null? l2) #f)
     
113.             ((atom? (car l2)) #f)
     
114.             (else
     
115.                 (and (eqlist? (car l1) (car l2)) (eqlist3? (cdr l1)(cdr l2)))))))
     
116. 
     
117. 
     
118. 
     
119. (define eqlist2?
     
120.     (lambda (l1 l2)
     
121.         (cond
     
122.         ((and (null? l1) (null? l2)) #t)
     
123.         ((or (null? l1) (null? l2)) #f)
     
124.         ((and (atom? (car l1)) (atom? (car l2)))
     
125.          (and (eqan? (car l1) (car l2)) (eqlist2? (cdr l1) (cdr l2))))
     
126.         ((or (atom? (car l1)) (atom? (car l2))) #f)
     
127.         (else (and (eqlist2? (car l1) (car l2)) (eqlist2? (cdr l1) (cdr l2)))))))
     
128. 
     
129. ;; eq_s_exp
     
130. (define eq_s_exp?
     
131.     (lambda (s1 s2)
     
132.         (cond
     
133.             ((and (atom? s1) (atom? s2)) (eqan? s1 s2))
     
134.             ((or (atom? s1) (atom? s2)) #f)
     
135.             (else (eqlist? s1 s2)))))
     
136. 
     
137. 
     
138. (define eqlist?
     
139.     (lambda (l1 l2)
     
140.         (cond
     
141.             ((and (null? l1) (null? l2)) #t)
     
142.             (( or (null? l1) (null? l2)) #f)
     
143.             (else
     
144.                 (and (eq_s_exp? (car l1) (car l2)) (eqlist? (cdr l1) (cdr l2)))))))
     
145. 
     
146. ; remove s-expression from a list
     
147. (define rember
     
148.     (lambda (s l)
     
149.         (cond
     
150.             ((null? l) '())
     
151.             ((equal? (car l) s) (rember s (cdr l)))
     
152.             (else (cons (car l) (rember s (cdr l)))))))
     
153. 
     
154. 
     
155. ; numbered?
     
156. (define numbered?
     
157.     (lambda (aexp)
     
158.         (cond
     
159.             ((atom? aexp) (number? aexp))
     
160.             (else (and (numbered? (car aexp)) (numbered? (car (cdr (cdr aexp)))))))))
     
161. 
     
162. ; compute '(3 + 4)
     
163. (define value
     
164.     (lambda (nexp)
     
165.         (cond
     
166.             ((atom? nexp) nexp)
     
167.             ((eq? (car (cdr nexp)) '+ ) (+ (value (car nexp)) (value (car (cdr (cdr nexp))))))
     
168.             ((eq? (car (cdr nexp)) '- ) (- (value (car nexp)) (value (car (cdr (cdr nexp))))))
     
169.             ((eq? (car (cdr nexp)) '* ) (* (value (car nexp)) (value (car (cdr (cdr nexp))))))
     
170.             (else
     
171.             (/ (value (car nexp)) (value (car (cdr (cdr nexp)))))))))
     
172. 
     
173.  
     
174. ; get 3 from '(+ 3 4)
     
175. (define fst-sub-exp
     
176.     (lambda (aexp)
     
177.         (car (cdr aexp))))
     
178. 
     
179. ; get 4 from '(+ 3 2)
     
180. (define sec-sub-exp
     
181.     (lambda (aexp)
     
182.         (car (cdr (cdr aexp)))))
     
183. 
     
184. ;get operator
     
185. (define operator
     
186.     (lambda (aexp)
     
187.         (car aexp)))
     
188. 
     
189. ; compute '(+ 3 4)
     
190. (define value1
     
191.     (lambda (nexp)
     
192.         (cond
     
193.             ((atom? nexp) nexp)
     
194.             ((eq? (operator nexp) '+) (+ (value1 (fst-sub-exp nexp)) (value1 (sec-sub-exp nexp))))
     
195.             ((eq? (operator nexp) '-) (- (value1 (fst-sub-exp nexp)) (value1 (sec-sub-exp nexp))))
     
196.             ((eq? (operator nexp) '*) (* (value1 (fst-sub-exp nexp)) (value1 (sec-sub-exp nexp))))
     
197.             (else
     
198.             (/ (value1 (fst-sub-exp nexp)) (value1 (sec-sub-exp nexp)))))))
     
199. 
     
200. 
     
201. ; member
     
202. (define member?
     
203.     (lambda (s lat)
     
204.         (cond
     
205.             ((null? lat) #f)
     
206.             (else (or (eq_s_exp? (car lat) s) (member? s (cdr lat)))))))
     
207. 
     
208. ; set? whether a lat is a set
     
209. (define set?
     
210.     (lambda (lat)
     
211.         (cond
     
212.             ((null? lat) #t)
     
213.             ((member? (car lat) (cdr lat)) #f)
     
214.             (else (set? (cdr lat))))))
     
215. 
     
216. ;makeset
     
217. (define makeset
     
218.     (lambda (lat)
     
219.         (cond
     
220.             ((null? lat) '())
     
221.             ((member? (car lat) (cdr lat)) (makeset (cdr lat)))
     
222.             (else (cons (car lat) (makeset (cdr lat)))))))
     
223. 
     
224. ;; multiple remove a atom from a list
     
225. (define multirember
     
226.     (lambda (a lat)
     
227.         (cond
     
228.             ((null? lat) '())
     
229.             ( (eq? (car lat) a)
     
230.                 (multirember a (cdr lat)))
     
231.             (else (cons (car lat) (multirember a (cdr lat)))))))
     
232. 
     
233. 
     
234. ;;rewrite makeset with multirember
     
235. (define makeset2
     
236.     (lambda (lat)
     
237.         (cond
     
238.             ((null? lat) '())
     
239.             (else (cons (car lat) (makeset2 (multirember (car lat) (cdr lat))))))))
     
240. 
     
241. 
     
242. ;check whether each atom in set 1 is also in set2;subset
     
243. (define subset?
     
244.     (lambda (set1 set2)
     
245.         (cond
     
246.             ((null? set1) #t)
     
247.             (else (cond
     
248.                     ((member? (car set1 ) set2) (subset? (cdr set1) set2))
     
249.                     (else #f))))))
     
250. 
     
251. (define subset2?
     
252.     (lambda (set1 set2)
     
253.         (cond
     
254.             ((null? set1) #t)
     
255.             ((member? (car set1) set2) (subset? (cdr set1) set2))
     
256.             (else #f))))
     
257. 
     
258. ; two set are equal
     
259. (define eqset?
     
260.     (lambda (set1 set2)
     
261.         (and (subset? set1 set2) (subset? set2 set1))))
     
262. 
     
263. (define eqset2?
     
264.     (lambda (set1 set2)
     
265.         (cond
     
266.             ((subset? set1 set2) (subset? set2 set1))
     
267.             (else #f))))
     
268. 
     
269. ;intersect?
     
270. (define intersect?
     
271.     (lambda (set1 set2)
     
272.         (cond
     
273.             ((null? set1) #f)
     
274.             ((member? (car set1) set2) #t)
     
275.             (else (intersect? (cdr set1) set2)))))
     
276. 
     
277. 
     
278. (define intersect
     
279.     (lambda (set1 set2)
     
280.         (cond
     
281.             ((null? set1) '())
     
282.             ((member? (car set1) set2) (cons (car set1) (intersect (cdr set1) set2)))
     
283.             (else (intersect (cdr set1) set2)))))
     
284. 
     
285. ;union
     
286. (define union
     
287.     (lambda (set1 set2)
     
288.         (cond
     
289.             ((null? set1) set2)
     
290.             ((member? (car set1) set2) (union (cdr set1) set2))
     
291.             (else (cons (car set1) (union (cdr set1) set2))))))
     
292. 
     
293. 
     
294. ;set difference
     
295. (define difference
     
296.     (lambda (set1 set2)
     
297.         (cond
     
298.             ((null? set1) '())
     
299.             ((member? (car set1) set2) (difference (cdr set1) set2))
     
300.             (else (cons (car set1) (difference (cdr set1) set2))))))
     
301. 
     
302. ;intersectall l-set: list of sets
     
303. (define intersectall
     
304.     (lambda (l-set)
     
305.         (cond
     
306.             ((null? (cdr l-set)) (car l-set))
     
307.             (else (intersect (car l-set) (intersectall (cdr l-set)))))))

点击(此处)折叠或打开

1. #! /usr/bin/guile -s
   
2. !#
   
3. 
   
4. (define atom?
   
5.     (lambda (a)
   
6.         (and (not(null? a)) (not (pair? a)))))
   
7. 
   
8. 
   
9. 
   
10. (define a-pair?
    
11.     (lambda (x)
    
12.         (cond
    
13.             ((null? x) #f)
    
14.             ((atom? x) #f)
    
15.             ((null? (cdr x)) #f)
    
16.             ((null? (cdr (cdr x))) #t)
    
17.             (else #f))))
    
18. 
    
19. 
    
20. (define first
    
21.     (lambda (p)
    
22.         (cond
    
23.             (else (car p)))))
    
24. 
    
25. (define second
    
26.     (lambda (p)
    
27.         (cond
    
28.             (else (car (cdr p))))))
    
29. 
    
30. (define revpair
    
31.     (lambda (p)
    
32.         (build (second p) (first p))))
    
33. 
    
34. 
    
35. (define build
    
36.     (lambda (s1 s2)
    
37.         (cond
    
38.             (else (cons s1 (cons s2 '()))))))
    
39. 
    
40. (define third
    
41.     (lambda (l)
    
42.         (car (cdr (cdr l)))))
    
43. 
    
44. ;; check an atom whether a member of a list
    
45. (define member?
    
46.     (lambda (a lat)
    
47.         (cond
    
48.             ((null? lat) #f)
    
49.             (else (or (eq? (car lat) a)
    
50.                     (member? a (cdr lat)))))))
    
51. 
    
52. ; set? whether a lat is a set
    
53. (define set?
    
54.     (lambda (lat)
    
55.         (cond
    
56.             ((null? lat) #t)
    
57.             ((member? (car lat) (cdr lat)) #f)
    
58.             (else (set? (cdr lat))))))
    
59. 
    
60. ;; get all the car of the list
    
61. (define firsts
    
62.     (lambda (lat)
    
63.         (cond
    
64.             ((null? lat) '())
    
65.             (else (cons (car (car lat)) (firsts(cdr lat)))))))
    
66. 
    
67. ;;get all the second of the list
    
68. (define seconds
    
69.     (lambda (lat)
    
70.         (cond
    
71.             ((null? lat) '())
    
72.             (else
    
73.                 (cons (car (cdr (car lat))) (seconds (cdr lat)))))))
    
74. 
    
75. 
    
76. ; rel: relation, list of pairs and set of pairs
    
77. (define fun?
    
78.     (lambda (rel)
    
79.         (set? (firsts rel))))
    
80. 
    
81. 
    
82. (define revrel
    
83.     (lambda (rel)
    
84.         (cond
    
85.             ((null? rel) '())
    
86.             (else
    
87.                 (cons (build (second (car rel)) (first (car rel)))
    
88.                     (revrel (cdr rel)))))))
    
89.                     
    
90. (define revrel1
    
91.     (lambda (rel)
    
92.         (cond
    
93.             ((null? rel) '())
    
94.             (else
    
95.                 (cons (revpair (car rel)) (revrel1 (cdr rel)))))))
    
96. 
    
97. (define fullfun?
    
98.     (lambda (fun)
    
99.         (set? (seconds fun))))
    
100. 
     
101. 
     
102. (define one-to-one?
     
103.     (lambda (fun)
     
104.         (fun? (revrel fun))))

#https://www.gnu.org/software/guile/docs/docs-2.0/guile-ref/Equality.html#Equality
eq? tests just for the same object (essentially a pointer comparison). This is fast, and can be used when searching for a particular object, or when working with symbols or keywords (which are always unique objects).
eqv? extends eq? to look at the value of numbers and characters. It can for instance be used somewhat like = (see Comparison) but without an error if one operand isn’t a number.
equal? goes further, it looks (recursively) into the contents of lists, vectors, etc. This is good for instance on lists that have been read or calculated in various places and are the same, just not made up of the same pairs. Such lists look the same (when printed), and equal? will consider them the same.
Generally eqv? below should be used when comparing numbers or characters.