Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 368 lines (325 sloc) 9.149 kb
90317eec »
2012-05-06 Up thru rember
1 ; Load readline
2 (require readline)
3 (require readline/rep-start)
4
5 ; atom?
1c3e3df4 »
2012-05-10 Use more compact lambdaless func defines
6 (define (atom? a)
7 (not (list? a)))
90317eec »
2012-05-06 Up thru rember
8
9 ; remove member
1c3e3df4 »
2012-05-10 Use more compact lambdaless func defines
10 (define (rember a lat)
11 (cond
12 ((null? lat) '())
13 ((eq? (car lat) a) (cdr lat))
14 (else (cons (car lat) (rember a (cdr lat))))))
f0f61c7a »
2012-05-06 firsts
15
16 ; first item of each list
1c3e3df4 »
2012-05-10 Use more compact lambdaless func defines
17 (define (firsts lists)
18 (cond
19 ((null? lists) '())
20 (else (cons
21 (car (car lists))
22 (firsts (cdr lists))))))
3a056b28 »
2012-05-06 insertR
23
24 ; insert atom to right of other atom
1c3e3df4 »
2012-05-10 Use more compact lambdaless func defines
25 (define (insertR new existing lat)
26 (cond
27 ((null? lat) '())
28 (else
29 (cond
30 ((eq? (car lat) existing)
31 (cons existing (cons new (cdr lat))))
32 (else
33 (cons (car lat) (insertR new existing (cdr lat))))))))
d270ba3a »
2012-05-06 insertL
34
35 ; insert atom to LEFT of other atom!
1c3e3df4 »
2012-05-10 Use more compact lambdaless func defines
36 (define (insertL new existing lat)
37 (cond
38 ((null? lat) '())
39 (else
40 (cond
41 ((eq? (car lat) existing)
42 (cons new lat))
43 (else
44 (cons (car lat) (insertL new existing (cdr lat))))))))
45
46 ; substitute one atom for 1st occurrence of another
47 (define (subst new old lat)
48 (cond
49 ((null? lat) '())
50 (else (cond
51 ((eq? (car lat) old) (cons new (cdr lat)))
52 (else (cons (car lat) (subst new old (cdr lat))))))))
2f387b79 »
2012-05-10 subst2
53
54 ; substitute one atom for 1st occurrence of one or two others
55 (define (subst2 new old1 old2 lat)
56 (cond
57 ((null? lat) '())
58 (else
59 (cond
60 ((or (eq? (car lat) old1) (eq? (car lat) old2))
61 (cons new (cdr lat)))
62 (else (cons (car lat) (subst2 new old1 old2 (cdr lat))))))))
9e454ece »
2012-05-10 multirember
63
64 ; remove all matching members
65 (define (multirember a lat)
66 (cond
67 ((null? lat) '())
68 ((eq? (car lat) a) (multirember a (cdr lat)))
69 (else (cons (car lat) (multirember a (cdr lat))))))
055e047e »
2012-05-10 multiinsertR
70
71 ; insert to right of all matching members
72 (define (multiinsertR new existing lat)
73 (cond
74 ((null? lat) '())
75 (else
76 (cond
77 ((eq? (car lat) existing)
78 (cons existing (cons new (multiinsertR new existing (cdr lat)))))
79 (else
80 (cons (car lat) (multiinsertR new existing (cdr lat))))))))
8c607b1d »
2012-05-10 multiinsertL
81
82 ; insert to left of all matching members
83 (define (multiinsertL new existing lat)
84 (cond
85 ((null? lat) '())
86 (else
87 (cond
88 ((eq? (car lat) existing)
89 (cons new (cons existing (multiinsertL new existing (cdr lat)))))
90 (else
91 (cons (car lat) (multiinsertL new existing (cdr lat))))))))
f45d2940 »
2012-05-10 multisubst
92
93 ; substitute all matching members
94 (define (multisubst new old lat)
95 (cond
96 ((null? lat) '())
97 (else
98 (cond
99 ((eq? (car lat) old) (cons new (multisubst new old (cdr lat))))
100 (else
101 (cons (car lat) (multisubst new old (cdr lat))))))))
1826e72c »
2012-05-10 add (bit diff from book's soln)
102
103 ; addition
104 (define (add a b)
105 (cond
106 ((zero? b) a)
107 (else (add (add1 a) (sub1 b)))))
98d8303f »
2012-05-10 sub
108
109 ; subtraction
110 (define (sub a b)
111 (cond
112 ((zero? b) a)
113 (else (sub (sub1 a) (sub1 b)))))
efdd38cb »
2012-05-10 addtup
114
115 ; add up all numbers in a tuple
116 (define (addtup tup)
117 (cond
118 ((null? tup) 0)
119 (else (add (car tup) (addtup (cdr tup))))))
626a8a2b »
2012-05-10 mult
120
121 ; multiplication
122 (define (mult a b)
123 (cond
124 ((zero? b) 0)
125 (else (add a (mult a (sub1 b))))))
93ce180e »
2012-05-10 tupadd
126
127 ; zip-add two tuples
128 (define (tupadd tup1 tup2)
129 (cond
1534c982 »
2012-05-10 Updated tupadd
130 ((null? tup1) tup2)
131 ((null? tup2) tup1)
93ce180e »
2012-05-10 tupadd
132 (else (cons
133 (add (car tup1) (car tup2))
134 (tupadd (cdr tup1) (cdr tup2))))))
3c95ad7a »
2012-05-10 gt, lt
135
136 ; greater-than test
137 (define (gt n m)
138 (cond
139 ((zero? n) #f)
140 ((zero? m) #t)
141 (else (gt (sub1 n) (sub1 m)))))
142
143 ; less-than
144 (define (lt n m)
145 (cond
146 ((zero? m) #f)
147 ((zero? n) #t)
148 (else (lt (sub1 n) (sub1 m)))))
205f30e3 »
2012-05-10 My eq
149
150 ; equal
151 (define (eq n m)
152 (cond
483b48c1 »
2012-05-10 Their clever eq
153 ((zero? m) (zero? n))
154 ((zero? n) #f)
205f30e3 »
2012-05-10 My eq
155 (else (eq (sub1 n) (sub1 m)))))
2d7590ce »
2012-05-10 Power (with added touch: to the 0th power)
156
157 ; raising to power
158 (define (pwr n m)
159 (cond
160 ((zero? m) 1)
161 ((eq m 1) n)
162 (else (mult n (pwr n (sub1 m))))))
c664065a »
2012-05-10 Length
163
164 ; Length of a lat ("length" a racket builtin, using "len")
165 (define (len lat)
166 (cond
167 ((null? lat) 0)
168 (else (add1 (len (cdr lat))))))
2f31d782 »
2012-05-10 pick
169
170 ; Pick Nth item from a lat
171 (define (pick n lat)
172 (cond
173 ((eq? 1 n) (car lat))
174 (else (pick (sub1 n) (cdr lat)))))
87e84607 »
2012-05-10 rempick
175
176 ; Remove Nth item
177 (define (rempick n lat)
178 (cond
179 ((eq? 1 n) (cdr lat))
180 (else (cons (car lat) (rempick (sub1 n) (cdr lat))))))
4f0d0930 »
2012-05-10 nonums, allnums
181
182 ; Remove all numbers
183 (define (nonums lat)
184 (cond
185 ((null? lat) '())
186 (else
187 (cond
188 ((number? (car lat)) (nonums (cdr lat)))
189 (else (cons (car lat) (nonums (cdr lat))))))))
190
191 ; Remove all non-numbers
192 (define (allnums lat)
193 (cond
194 ((null? lat) '())
195 (else
196 (cond
197 ((number? (car lat)) (cons (car lat) (allnums (cdr lat))))
198 (else (allnums (cdr lat)))))))
91f74074 »
2012-05-10 eqan?
199
200 ; type-friendly equality
201 (define (eqan? a b)
202 (cond
203 ((and (number? a) (number? b)) (= a b))
204 ((or (number? a) (number? b)) #f)
205 (else (eq? a b))))
ce683afa »
2012-05-10 occur
206
207 ; counting an atom in a lat
208 (define (occur a lat)
209 (cond
210 ((null? lat) 0)
211 (else
212 (cond
213 ((eqan? (car lat) a) (add1 (occur a (cdr lat))))
214 (else (occur a (cdr lat)))))))
b0e92ad0 »
2012-05-10 My first working stab at rember*
215
216 ; recursive removal
217 (define (rember* a l)
218 (cond
219 ((null? l) '())
220 ((list? (car l)) (cons (rember* a (car l)) (rember* a (cdr l))))
221 (else
222 (cond
223 ((eqan? (car l) a) (rember* a (cdr l)))
224 (else (cons (car l) (rember* a (cdr l))))))))
ec10f138 »
2012-05-10 insertR*
225
226 ; recursive right insertion
227 (define (insertR* new existing l)
228 (cond
229 ((null? l) '())
230 ((list? (car l))
231 (cons (insertR* new existing (car l)) (insertR* new existing (cdr l))))
232 (else
233 (cond
234 ((eq? (car l) existing)
235 (cons existing (cons new (insertR* new existing (cdr l)))))
236 (else (cons (car l) (insertR* new existing (cdr l))))))))
e9a19a6a »
2012-05-11 Occur*
237
238 ; recursive occur
239 (define (occur* a l)
240 (cond
241 ((null? l) 0)
242 ((atom? (car l))
243 (cond
244 ((eq? (car l) a) (add1 (occur* a (cdr l))))
245 (else (occur* a (cdr l)))))
246 (else
247 (add (occur* a (car l)) (occur* a (cdr l))))))
05e80591 »
2012-05-12 subst*
248
249 ; recursive subst
250 (define (subst* new old l)
251 (cond
252 ((null? l) '())
253 ((atom? (car l))
254 (cond
255 ((eqan? (car l) old) (cons new (subst* new old (cdr l))))
256 (else (cons (car l) (subst* new old (cdr l))))))
257 (else (cons
258 (subst* new old (car l))
259 (subst* new old (cdr l))))))
92a399dc »
2012-05-12 insertL*
260
261 ; recursive left-insert
262 (define (insertL* new existing l)
263 (cond
264 ((null? l) '())
265 ((atom? (car l))
266 (cond
267 ((eqan? (car l) existing)
268 (cons new (cons existing (insertL* new existing (cdr l)))))
269 (else (cons (car l) (insertL* new existing (cdr l))))))
270 (else (cons
271 (insertL* new existing (car l))
272 (insertL* new existing (cdr l))))))
ffa5adeb »
2012-05-12 member*
273
274 ; recursive member test
275 (define (member* a l)
276 (cond
277 ((null? l) #f)
278 ((atom? (car l))
279 (cond
280 ((eqan? (car l) a) #t)
281 (else (member* a (cdr l)))))
282 (else (or (member* a (car l)) (member* a (cdr l))))))
08ed166f »
2012-05-14 leftmost
283
284 ; Find leftmost atom in a nested list
285 (define (leftmost l)
286 (cond
287 ((atom? (car l)) (car l))
288 (else (leftmost (car l)))))
17f2daf3 »
2012-05-14 eqlist?
289
290 ; Compare lists
291 (define (eqlist? l1 l2)
292 (cond
293 ; two nil lists are equal
294 ((and (null? l1) (null? l2)) #t)
295 ; no both nil, so then OR means one is nil, ergo definitely not equal
296 ((or (null? l1) (null? l2)) #f)
297 ; both cars are atoms?
298 ((and (atom? (car l1)) (atom? (car l2)))
299 (cond
300 ; eqan? recurse onto cdrs
301 ((eqan? (car l1) (car l2)) (and (eqlist? (cdr l1) (cdr l2))))
302 ; not equan? #f
303 (else #f)))
304 ; only one is an atom? #f
305 ((or (atom? (car l1)) (atom? (car l2))) #f)
306 ; both cars are lists? recurse onto both
307 ((and (list? (car l1)) (list? (car l2)))
308 (and (eqlist? (car l1) (car l2)) (eqlist? (cdr l1) (cdr l2))))
309 ; only one is a list? #f
310 (else #f)))
37aa3f30 »
2012-05-14 myequal?
311
312 ; Compare S-expressions
313 (define (myequal? s1 s2)
314 (cond
315 ((and (atom? s1) (atom? s2)) (eqan? s1 s2))
316 ((or (atom? s1) (atom? s2)) #f)
317 ; At this point atoms and nulls are ruled out; must be two lists
318 (else (eqlist? s1 s2))))
389e2802 »
2012-05-14 eqlist2 leveraging equal
319
320 ; eqlist using myequal
321 (define (eqlist2? l1 l2)
322 (cond
323 ; two nil lists are equal
324 ((and (null? l1) (null? l2)) #t)
325 ; no both nil, so then OR means one is nil, ergo definitely not equal
326 ((or (null? l1) (null? l2)) #f)
327 ; equality test on cars & cdrs
328 (else (and (myequal? (car l1) (car l2)) (eqlist2? (cdr l1) (cdr l2))))))
93c71e61 »
2012-05-15 set?
329
330 ; member?
331 (define (member? a lat)
332 (cond
333 ((null? lat) #f)
334 ((eqan? (car lat) a) #t)
335 (else (member? a (cdr lat)))))
336
337 ; set test
de941b8d »
2012-05-15 makeset
338 (define (myset? lat)
93c71e61 »
2012-05-15 set?
339 (cond
340 ((null? lat) #t)
341 ((member? (car lat) (cdr lat)) #f)
342 (else (myset? (cdr lat)))))
de941b8d »
2012-05-15 makeset
343
344 ; set enforcement
345 (define (makeset lat)
346 (cond
347 ((null? lat) '())
348 ((member? (car lat) (cdr lat)) (makeset (cdr lat)))
349 (else (cons (car lat) (makeset (cdr lat))))))
f7d7b4b8 »
2012-05-15 makeset2
350
351 ; set enforcement using multirember
352 (define (makeset2 lat)
353 (cond
354 ((null? lat) '())
355 (else (cons (car lat) (makeset (multirember (car lat) (cdr lat)))))))
778ce978 »
2012-05-16 subset?
356
357 ; subset test
358 (define (mysubset? lat1 lat2)
359 (cond
360 ((and (null? lat1) (null? lat2)) #t)
361 ((null? lat1) #t)
362 (else (and (member? (car lat1) lat2) (mysubset? (cdr lat1) (cdr lat2))))))
55933ea6 »
2012-05-16 intersect?
363
364 ; intersection test
365 (define (intersect? lat1 lat2)
366 (cond
367 ((or (null? lat1) (null? lat2)) #f)
368 (else (or (member? (car lat1) lat2) (intersect? (cdr lat1) (cdr lat2))))))
Something went wrong with that request. Please try again.