1:
2:
3:
4:
5: (use gauche.test)
6: (test-start "util")
7:
8: (use srfi-1)
9:
10:
11: (test-section "util.combinations")
12: (use util.combinations)
13: (test-module 'util.combinations)
14:
15: (test* "permutations (boundary)" '(())
16: (permutations '()))
17: (test* "permutations (boundary)" '((a))
18: (permutations '(a)))
19: (test* "permutations" '((a b) (b a))
20: (permutations '(a b)))
21: (test* "permutations" '((a a) (a a))
22: (permutations '(a a)))
23: (test* "permutations" '((a b c) (a c b) (b a c) (b c a) (c a b) (c b a))
24: (permutations '(a b c)))
25: (test* "permutations" '((a b c d) (a b d c) (a c b d) (a c d b)
26: (a d b c) (a d c b) (b a c d) (b a d c)
27: (b c a d) (b c d a) (b d a c) (b d c a)
28: (c a b d) (c a d b) (c b a d) (c b d a)
29: (c d a b) (c d b a) (d a b c) (d a c b)
30: (d b a c) (d b c a) (d c a b) (d c b a))
31: (permutations '(a b c d)))
32:
33: (test* "permutations* (boundary)" '(())
34: (permutations* '()))
35: (test* "permutations* (boundary)" '((a))
36: (permutations* '(a)))
37: (test* "permutations*" '((a b) (b a))
38: (permutations* '(a b)))
39: (test* "permutations*" '((a a))
40: (permutations* '(a a)))
41: (test* "permutations*" '((a b c) (a c b) (b a c) (b c a) (c a b) (c b a))
42: (permutations* '(a b c)))
43: (test* "permutations*" '((a a b) (a b a) (b a a))
44: (permutations* '(a a b)))
45: (test* "permutations*" '((a b a) (a a b) (b a a))
46: (permutations* '(a b a)))
47: (test* "permutations*" '((b a a) (a b a) (a a b))
48: (permutations* '(b a a)))
49: (test* "permutations*" '((a a a))
50: (permutations* '(a a a)))
51: (test* "permutations*" '((a b c d) (a b d c) (a c b d) (a c d b)
52: (a d b c) (a d c b) (b a c d) (b a d c)
53: (b c a d) (b c d a) (b d a c) (b d c a)
54: (c a b d) (c a d b) (c b a d) (c b d a)
55: (c d a b) (c d b a) (d a b c) (d a c b)
56: (d b a c) (d b c a) (d c a b) (d c b a))
57: (permutations* '(a b c d)))
58: (test* "permutations*" '((a a b c) (a a c b) (a b a c) (a b c a)
59: (a c a b) (a c b a) (b a a c) (b a c a)
60: (b c a a) (c a a b) (c a b a) (c b a a))
61: (permutations* '(a a b c)))
62: (test* "permutations*" '((a b a c) (a b c a) (a a b c) (a a c b)
63: (a c b a) (a c a b) (b a a c) (b a c a)
64: (b c a a) (c a b a) (c a a b) (c b a a))
65: (permutations* '(a b a c)))
66: (test* "permutations*" '((a b c a) (a b a c) (a c b a) (a c a b)
67: (a a b c) (a a c b) (b a c a) (b a a c)
68: (b c a a) (c a b a) (c a a b) (c b a a))
69: (permutations* '(a b c a)))
70: (test* "permutations*" '((a b a b) (a b b a) (a a b b)
71: (b a a b) (b a b a) (b b a a))
72: (permutations* '(a b a b)))
73: (test* "permutations*" '((a a a b) (a a b a) (a b a a) (b a a a))
74: (permutations* '(a a a b)))
75: (test* "permutations*" '((a b a a) (a a b a) (a a a b) (b a a a))
76: (permutations* '(a b a a)))
77: (test* "permutations*" '((a a a a))
78: (permutations* '(a a a a)))
79:
80: (test* "permutations*" '(("a" "b" "b" "a") ("a" "b" "a" "b") ("a" "a" "b" "b")
81: ("b" "a" "b" "a") ("b" "a" "a" "b") ("b" "b" "a" "a"))
82: (permutations* '("a" "b" "b" "a") string=?))
83:
84: (test* "permutations-for-each"
85: '()
86: (let1 r '()
87: (permutations-for-each (lambda (p) (push! r p)) '())
88: (reverse r)))
89: (test* "permutations-for-each"
90: '((a))
91: (let1 r '()
92: (permutations-for-each (lambda (p) (push! r p)) '(a))
93: (reverse r)))
94: (test* "permutations-for-each"
95: '((a b c) (a c b) (b a c) (b c a) (c a b) (c b a))
96: (let1 r '()
97: (permutations-for-each (lambda (p) (push! r p)) '(a b c))
98: (reverse r)))
99: (test* "permutations*-for-each"
100: '()
101: (let1 r '()
102: (permutations*-for-each (lambda (p) (push! r p)) '())
103: (reverse r)))
104: (test* "permutations*-for-each"
105: '((a))
106: (let1 r '()
107: (permutations*-for-each (lambda (p) (push! r p)) '(a))
108: (reverse r)))
109: (test* "permutations*-for-each"
110: '((a b c) (a c b) (b a c) (b c a) (c a b) (c b a))
111: (let1 r '()
112: (permutations*-for-each (lambda (p) (push! r p)) '(a b c))
113: (reverse r)))
114: (test* "permutations*-for-each"
115: '((a a b) (a b a) (b a a))
116: (let1 r '()
117: (permutations*-for-each (lambda (p) (push! r p)) '(a a b))
118: (reverse r)))
119: (test* "permutations*-for-each"
120: '((a a a))
121: (let1 r '()
122: (permutations*-for-each (lambda (p) (push! r p)) '(a a a))
123: (reverse r)))
124: (test* "permutations*-for-each"
125: '(("a" "a" "b") ("a" "b" "a") ("b" "a" "a"))
126: (let1 r '()
127: (permutations*-for-each (lambda (p) (push! r p)) '("a" "a" "b")
128: string=?)
129: (reverse r)))
130:
131: (test* "combinations" '(())
132: (combinations '() 0))
133: (test* "combinations" '((a))
134: (combinations '(a) 1))
135: (test* "combinations" '((a) (b) (c) (d))
136: (combinations '(a b c d) 1))
137: (test* "combinations" '((a b) (a c) (b c))
138: (combinations '(a b c) 2))
139: (test* "combinations" '((a b c))
140: (combinations '(a b c) 3))
141: (test* "combinations" '((a b c) (a b d) (a c d) (b c d))
142: (combinations '(a b c d) 3))
143:
144: (test* "combinations*" '(())
145: (combinations* '() 0))
146: (test* "combinations*" '((a))
147: (combinations* '(a) 1))
148: (test* "combinations*" '((a) (b) (c) (d))
149: (combinations* '(a b c d) 1))
150: (test* "combinations*" '((a b) (a c) (b c))
151: (combinations* '(a b c) 2))
152: (test* "combinations*" '((a b c))
153: (combinations* '(a b c) 3))
154: (test* "combinations*" '((a b c) (a b d) (a c d) (b c d))
155: (combinations* '(a b c d) 3))
156: (test* "combinations*" '((a) (b))
157: (combinations* '(a a b) 1))
158: (test* "combinations*" '((a a) (a b))
159: (combinations* '(a a b) 2))
160: (test* "combinations*" '((a a b))
161: (combinations* '(a a b) 3))
162: (test* "combinations*" '((a b) (a a))
163: (combinations* '(a b a a) 2))
164: (test* "combinations*" '((a b a) (a a a))
165: (combinations* '(a b a a) 3))
166: (test* "combinations*" '((a b b) (a b a))
167: (combinations* '(a b b a) 3))
168: (test* "combinations*" '(("a" "b" "b") ("a" "b" "a"))
169: (combinations* '("a" "b" "b" "a") 3 string=?))
170:
171: (test* "combinations-for-each" '(())
172: (let1 r '()
173: (combinations-for-each (lambda (c) (push! r c)) '() 0)
174: (reverse! r)))
175: (test* "combinations-for-each" '((a))
176: (let1 r '()
177: (combinations-for-each (lambda (c) (push! r c)) '(a) 1)
178: (reverse! r)))
179: (test* "combinations-for-each" '((a) (b) (c) (d))
180: (let1 r '()
181: (combinations-for-each (lambda (c) (push! r c)) '(a b c d) 1)
182: (reverse! r)))
183: (test* "combinations-for-each" '((a b) (a c) (b c))
184: (let1 r '()
185: (combinations-for-each (lambda (c) (push! r c)) '(a b c) 2)
186: (reverse! r)))
187: (test* "combinations-for-each" '((a b c))
188: (let1 r '()
189: (combinations-for-each (lambda (c) (push! r c)) '(a b c) 3)
190: (reverse! r)))
191: (test* "combinations-for-each" '((a b c) (a b d) (a c d) (b c d))
192: (let1 r '()
193: (combinations-for-each (lambda (c) (push! r c)) '(a b c d) 3)
194: (reverse! r)))
195:
196: (test* "combinations*-for-each" '(())
197: (let1 r '()
198: (combinations*-for-each (lambda (c) (push! r c)) '() 0)
199: (reverse! r)))
200: (test* "combinations*-for-each" '((a))
201: (let1 r '()
202: (combinations*-for-each (lambda (c) (push! r c)) '(a) 1)
203: (reverse! r)))
204: (test* "combinations*-for-each" '((a) (b) (c) (d))
205: (let1 r '()
206: (combinations*-for-each (lambda (c) (push! r c)) '(a b c d) 1)
207: (reverse! r)))
208: (test* "combinations*-for-each" '((a b) (a c) (b c))
209: (let1 r '()
210: (combinations*-for-each (lambda (c) (push! r c)) '(a b c) 2)
211: (reverse! r)))
212: (test* "combinations*-for-each" '((a b c))
213: (let1 r '()
214: (combinations*-for-each (lambda (c) (push! r c)) '(a b c) 3)
215: (reverse! r)))
216: (test* "combinations*-for-each" '((a b c) (a b d) (a c d) (b c d))
217: (let1 r '()
218: (combinations*-for-each (lambda (c) (push! r c)) '(a b c d) 3)
219: (reverse! r)))
220: (test* "combinations*-for-each" '((a) (b))
221: (let1 r '()
222: (combinations*-for-each (lambda (c) (push! r c)) '(a a b) 1)
223: (reverse! r)))
224: (test* "combinations*-for-each" '((a a) (a b))
225: (let1 r '()
226: (combinations*-for-each (lambda (c) (push! r c)) '(a a b) 2)
227: (reverse! r)))
228: (test* "combinations*-for-each" '((a a b))
229: (let1 r '()
230: (combinations*-for-each (lambda (c) (push! r c)) '(a a b) 3)
231: (reverse! r)))
232: (test* "combinations*-for-each" '((a b) (a a))
233: (let1 r '()
234: (combinations*-for-each (lambda (c) (push! r c)) '(a b a a) 2)
235: (reverse! r)))
236: (test* "combinations*-for-each" '((a b a) (a a a))
237: (let1 r '()
238: (combinations*-for-each (lambda (c) (push! r c)) '(a b a a) 3)
239: (reverse! r)))
240: (test* "combinations*-for-each" '((a b b) (a b a))
241: (let1 r '()
242: (combinations*-for-each (lambda (c) (push! r c)) '(a b b a) 3)
243: (reverse! r)))
244: (test* "combinations*-for-each" '(("a" "b" "b") ("a" "b" "a"))
245: (let1 r '()
246: (combinations*-for-each (lambda (c) (push! r c)) '("a" "b" "b" "a") 3
247: string=?)
248: (reverse! r)))
249:
250: (test* "power-set-binary" '(())
251: (power-set-binary '()))
252: (test* "power-set-binary" '(() (a))
253: (power-set-binary '(a)))
254: (test* "power-set-binary" '(() (c) (b) (b c) (a) (a c) (a b) (a b c))
255: (power-set-binary '(a b c)))
256:
257: (test* "power-set" '(())
258: (power-set '()))
259: (test* "power-set" '(() (a))
260: (power-set '(a)))
261: (test* "power-set" '(() (a) (b) (c) (a b) (a c) (b c) (a b c))
262: (power-set '(a b c)))
263:
264: (test* "power-set*" '(())
265: (power-set* '()))
266: (test* "power-set*" '(() (a))
267: (power-set* '(a)))
268: (test* "power-set*" '(() (a) (b) (a a) (a b) (a a b))
269: (power-set* '(a a b)))
270: (test* "power-set*" '(() ("a") ("b") ("a" "a") ("a" "b") ("a" "a" "b"))
271: (power-set* '("a" "a" "b") string=?))
272:
273: (test* "power-set-for-each" '(())
274: (let1 r '()
275: (power-set-for-each (lambda (s) (push! r s)) '())
276: (reverse! r)))
277: (test* "power-set-for-each" '(() (a))
278: (let1 r '()
279: (power-set-for-each (lambda (s) (push! r s)) '(a))
280: (reverse! r)))
281: (test* "power-set-for-each" '(() (a) (b) (c) (a b) (a c) (b c) (a b c))
282: (let1 r '()
283: (power-set-for-each (lambda (s) (push! r s)) '(a b c))
284: (reverse! r)))
285:
286: (test* "power-set*-for-each" '(())
287: (let1 r '()
288: (power-set*-for-each (lambda (s) (push! r s)) '())
289: (reverse! r)))
290: (test* "power-set*-for-each" '(() (a))
291: (let1 r '()
292: (power-set*-for-each (lambda (s) (push! r s)) '(a))
293: (reverse! r)))
294: (test* "power-set*-for-each" '(() (a) (b) (a a) (a b) (a a b))
295: (let1 r '()
296: (power-set*-for-each (lambda (s) (push! r s)) '(a a b))
297: (reverse! r)))
298: (test* "power-set*-for-each" '(() ("a") ("b") ("a" "a") ("a" "b") ("a" "a" "b"))
299: (let1 r '()
300: (power-set*-for-each (lambda (s) (push! r s)) '("a" "a" "b")
301: string=?)
302: (reverse! r)))
303:
304: (test* "cartesian-product" '((a 0) (a 1) (b 0) (b 1) (c 0) (c 1))
305: (cartesian-product '((a b c) (0 1))))
306: (test* "cartesian-product" '((a 0 0) (a 0 1) (a 1 0) (a 1 1)
307: (b 0 0) (b 0 1) (b 1 0) (b 1 1))
308: (cartesian-product '((a b) (0 1) (0 1))))
309: (test* "cartesian-product-right" '((a 0) (b 0) (c 0) (a 1) (b 1) (c 1))
310: (cartesian-product-right '((a b c) (0 1))))
311:
312:
313: (test-section "util.isomorph")
314: (use util.isomorph)
315: (test-module 'util.isomorph)
316:
317: (define-class <isomorph-test> ()
318: ((a :init-keyword :a)
319: (b :init-keyword :b)))
320:
321: (define-method object-isomorphic? ((x <isomorph-test>)
322: (y <isomorph-test>)
323: context)
324: (and (isomorphic? (ref x 'a) (ref y 'a) context)
325: (isomorphic? (ref x 'b) (ref y 'b) context)))
326:
327: (define (make-data type)
328: (let* ((z (vector #f #f #f #f))
329: (x (circular-list "a" 'b 4 9845938427094857239485 #\z 8+5i z))
330: (y (circular-list "a" 'b 4 9845938427094857239485 #\z 8+5i z))
331: (w (make <isomorph-test> :a z)))
332: (vector-set! z 0 x)
333: (vector-set! z 1 y)
334: (vector-set! z 2 w)
335: (slot-set! w 'b w)
336: (if type (vector-set! z 3 x) (vector-set! z 3 y))
337: z))
338:
339: (test* "isomorphic?" #t
340: (isomorphic? (make-data #f) (make-data #f)))
341: (test* "isomorphic?" #f
342: (isomorphic? (make-data #t) (make-data #f)))
343:
344:
345: (test-section "util.lcs")
346: (use util.lcs)
347: (test-module 'util.lcs)
348:
349: (test* "lcs skip" '(a c)
350: (lcs '(a b c) '(a c)))
351:
352: (test* "lcs head" '(a b)
353: (lcs '(a b c) '(a b)))
354:
355: (test* "lcs tail" '(b c)
356: (lcs '(a b c) '(b c)))
357:
358: (test* "lcs same" '(a b c)
359: (lcs '(a b c) '(a b c)))
360:
361: (test* "lcs no common" '()
362: (lcs '(a b c) '(x y z)))
363:
364: (test* "lcs empty" '()
365: (lcs '(a b c) '()))
366:
367: (test* "lcs mislead" '(a x b y c z)
368: (lcs '(a x b y c z p d q) '(a b c a x b y c z)))
369:
370: (test* "lcs mislead count"
371: '(6 ((a 0 0) (x 1 4) (b 2 5) (y 3 6) (c 4 7) (z 5 8)))
372: (lcs-with-positions '(a x b y c z p d q) '(a b c a x b y c z)))
373:
374: (let1 z (iota 200)
375: (test* "lcs (long, same)" #t (equal? z (lcs z z)))
376: (test* "lcs (long, none)" '(199) (lcs (reverse z) z))
377: (test* "lcs (long)" '(0 1 2 3 4 5 6 7 8 9)
378: (lcs z (apply append (make-list 10 (iota 10)))))
379: (test* "lcs (long)" '(0 1 2 3 4 5 6 7 8 9)
380: (lcs z (apply append (make-list 10 (iota 10 9 -1)))))
381: )
382:
383: (test* "lcs edit-list"
384: '(((- 0 a))
385: ((+ 2 d))
386: ((- 4 h) (+ 4 f))
387: ((+ 6 k))
388: ((- 8 n) (- 9 p) (+ 9 r) (+ 10 s) (+ 11 t)))
389: (lcs-edit-list '(a b c e h j l m n p)
390: '(b c d e f j k l m r s t)))
391:
392: (test* "lcs edit-list"
393: '(((- 0 a) (- 1 b) (- 2 c) (- 3 d) (+ 0 e) (+ 1 f) (+ 2 g) (+ 3 h)))
394: (lcs-edit-list '(a b c d) '(e f g h)))
395:
396: (test* "lcs edit-list"
397: '()
398: (lcs-edit-list '(a b c d) '(a b c d)))
399:
400: (test* "lcs edit-list"
401: '(((- 0 a) (- 1 b) (- 2 c) (- 3 d)))
402: (lcs-edit-list '(a b c d) '()))
403:
404: (test* "lcs edit-list"
405: '(((+ 0 a) (+ 1 b) (+ 2 c) (+ 3 d)))
406: (lcs-edit-list '() '(a b c d)))
407:
408: (test* "lcs edit-l 