Some variables renaming for consitency
[TD_LISP.git] / exercices / lists.lsp
CommitLineData
72128279
JB
1#!/usr/bin/env newlisp
2
3(setq L '(1 9 3 7 0 5))
4(setq M '(2 6 5 4 0 1 3))
5
6(define (mem E L) ;la function mem a 2 arguments
7 (if (null? L) nil
8 (if (= (first L) E) true
9 (mem E (rest L)))))
ada8f303 10(println "mem rt bool")
72128279
JB
11(println (mem 9 L))
12
13(define (boolmemrec E L)
14 (cond
15 ((null? L) nil)
16 ((= (first L) E) true)
17 ((mem E (rest L)))))
ada8f303 18(println "mem rec rt bool")
72128279
JB
19(println (boolmemrec 10 L))
20
21(define (mem E L) ;la function mem a 2 arguments
22 (if (null? L) nil
23 (if (= (first L) E) L
24 (mem E (rest L)))))
ada8f303 25(println "mem rt list")
72128279
JB
26(println (mem 3 L))
27
28(define (mem E L)
29 (cond
30 ((null? L) nil)
31 ((= (first L) E) L)
32 ((mem E (rest L)))))
ada8f303 33(println "mem rec rt list")
72128279
JB
34(println (mem 9 L))
35(println (member 9 L))
36(println (mem 8 L))
37(println (member 8 L))
38
39(define (concatene L1 L2)
40 (if (null? L1) L2
41 (cons (first L1) (concatene (rest L1) L2))))
ada8f303 42(println "concatene/append")
7cbb4caf
JB
43(setq C (concatene L M))
44(println C)
72128279
JB
45(println (append L M))
46
47;(trace true)
48
9cd3ff4a
JB
49(define (rang E L)
50 (if (boolmemrec E L)
72128279 51 (cond
9cd3ff4a
JB
52 ((= E (first L)) 0)
53 ((+ 1 (rang E (rest L)))))
72128279 54 nil))
ada8f303 55(println "rang/find")
72128279
JB
56(println (rang 4 L))
57(println (find 4 L))
58(println (rang 0 L))
59(println (find 0 L))
60
61;(trace nil)
62
9cd3ff4a 63(define (tete N L)
72128279 64 (cond
7cbb4caf 65 ((null? L) '())
9cd3ff4a
JB
66 ((= N 0) '())
67 ((cons (first L) (tete (- N 1) (rest L))))))
ada8f303 68(println "tete/slice")
72128279
JB
69(println (tete 3 L))
70(println (slice L 0 3))
71(println (0 3 L))
72
ada8f303 73(define (intersectL L1 L2)
72128279 74 (cond
7cbb4caf 75 ((null? L1) '())
ada8f303
JB
76 ((member (first L1) L2) (cons (first L1) (intersectL (rest L1) L2)))
77 ((intersectL (rest L1) L2))))
78(println "intersectL/intersect")
79(println (intersectL L M))
72128279
JB
80(println (intersect L M))
81
82(setq N '(1 9 3))
83(define (inclu L1 L2)
84 (cond
85 ((null? L1) true)
86 ((null? L2) nil)
87 ((= (first L1) (first L2)) (inclu (rest L1) (rest L2)))
88 ((inclu L1 (rest L2)))))
ada8f303 89(println "inclu")
72128279
JB
90(println (inclu N L))
91(println (inclu L M))
92;did not found a newlisp builtin equivalent function
93
7cbb4caf
JB
94(define (unionE L1 L2)
95 (cond
96 ((null? L1) L2)
97 ((member (first L1) L2) (unionE (rest L1) L2))
98 ((cons (first L1) (unionE (rest L1) L2)))))
ada8f303 99(println "unionE/union")
7cbb4caf
JB
100(println (unionE L M))
101(println (unionE N L))
ada8f303 102(println (union N L))
7cbb4caf
JB
103
104;(trace true)
105
106(setq T '(((4)((2 5))((((((6 7)))))))))
107(define (prof L)
108 (cond
109 ((null? L) 0)
110 ((atom? L) 0)
111 ((max (+ 1 (prof (first L))) (prof (rest L))))))
ada8f303 112(println "prof")
7cbb4caf
JB
113(println (prof L))
114(println (prof T))
115
116;(trace nil)
117;(trace true)
118
119(define (aplatir L)
120 (cond
121 ((null? L) nil)
122 ((atom? L) (list L)) ;FIXME: the "casting" is not working properly
123 ((append (aplatir (first L)) (aplatir (rest L))))))
ada8f303 124(println "aplatir/flat")
7cbb4caf
JB
125;(println (aplatir T))
126(println (flat T))
127
128;(trace nil)
129
130(define (elim L)
131 (cond
132 ((null? L) '())
133 ((member (first L) (rest L)) (elim (rest L)))
134 ((cons (first L) (elim (rest L))))))
ada8f303 135(println "elim/unique")
7cbb4caf
JB
136(println (elim C))
137(println (unique C))
138
139(define (reverseL L)
140 (cond
141 ((null? L) '())
142 ((append (reverseL (rest L)) (list (first L))))))
ada8f303 143(println "reverseL/reverse")
7cbb4caf
JB
144(println (reverseL L))
145(println (reverse L))
146
9cd3ff4a 147(define (list< N L)
7cbb4caf
JB
148 (cond
149 ((null? L) '())
9cd3ff4a
JB
150 ((>= (first L) N) (list< N (rest L)))
151 ((cons (first L) (list< N (rest L))))))
ada8f303 152(println "list<")
7cbb4caf
JB
153(println (list< 5 L))
154(println (list< 5 C))
155
9cd3ff4a 156(define (list>= N L)
7cbb4caf
JB
157 (cond
158 ((null? L) '())
9cd3ff4a
JB
159 ((< (first L) N) (list>= N (rest L)))
160 ((cons (first L) (list>= N (rest L))))))
ada8f303 161(println "list>=")
7cbb4caf
JB
162(println (list>= 5 C))
163
f1823b2e
JB
164;(trace true)
165
166(define (qsort L)
167 (cond
168 ((null? L) '())
169 ((append
170 ;the pivot is the first element of the list
171 (qsort (list< (first L) (rest L)))
172 (cons (first L) '())
173 (qsort (list>= (first L) (rest L)))))))
174(println "qsort")
175(println (qsort C))
176
177;(trace nil)
178
179;we suppose both lists are flat
180(setq L1 '(A ? ? B C D ?))
181(setq L2 '(? A B ? C ? ? D))
182
9cd3ff4a 183(define (removeC C L)
f1823b2e
JB
184 (cond
185 ((null? L) '())
9cd3ff4a
JB
186 ((= C (first L))) (removeC C (rest L))
187 (((cons (first L) (removeC C (rest L)))))))
188(println "removeC")
f1823b2e 189(println (removeC A L1))
9cd3ff4a
JB
190;escape character in newLISP?
191(println (removeC \? L1))
f1823b2e
JB
192
193(define (filtre L1 L2 C)
194 (cond
195 ((and (null? L1) (null? L2)) true)
196 ((and (not (null? L1)) (null? L2)) nil)
197 ((and (null? L1) (not (null? L2))) nil)
198 ((and (inclu L1 L2) (inclu L2 L1) true))))
9cd3ff4a 199(println "filtre")
f1823b2e
JB
200;(println (filtre L1 L2 ?))
201
72128279 202(exit)