Some variables renaming for consitency
[TD_LISP.git] / exercices / lists.lsp
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)))))
10 (println "mem rt bool")
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)))))
18 (println "mem rec rt bool")
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)))))
25 (println "mem rt list")
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)))))
33 (println "mem rec rt list")
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))))
42 (println "concatene/append")
43 (setq C (concatene L M))
44 (println C)
45 (println (append L M))
46
47 ;(trace true)
48
49 (define (rang E L)
50 (if (boolmemrec E L)
51 (cond
52 ((= E (first L)) 0)
53 ((+ 1 (rang E (rest L)))))
54 nil))
55 (println "rang/find")
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
63 (define (tete N L)
64 (cond
65 ((null? L) '())
66 ((= N 0) '())
67 ((cons (first L) (tete (- N 1) (rest L))))))
68 (println "tete/slice")
69 (println (tete 3 L))
70 (println (slice L 0 3))
71 (println (0 3 L))
72
73 (define (intersectL L1 L2)
74 (cond
75 ((null? L1) '())
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))
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)))))
89 (println "inclu")
90 (println (inclu N L))
91 (println (inclu L M))
92 ;did not found a newlisp builtin equivalent function
93
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)))))
99 (println "unionE/union")
100 (println (unionE L M))
101 (println (unionE N L))
102 (println (union N L))
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))))))
112 (println "prof")
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))))))
124 (println "aplatir/flat")
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))))))
135 (println "elim/unique")
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))))))
143 (println "reverseL/reverse")
144 (println (reverseL L))
145 (println (reverse L))
146
147 (define (list< N L)
148 (cond
149 ((null? L) '())
150 ((>= (first L) N) (list< N (rest L)))
151 ((cons (first L) (list< N (rest L))))))
152 (println "list<")
153 (println (list< 5 L))
154 (println (list< 5 C))
155
156 (define (list>= N L)
157 (cond
158 ((null? L) '())
159 ((< (first L) N) (list>= N (rest L)))
160 ((cons (first L) (list>= N (rest L))))))
161 (println "list>=")
162 (println (list>= 5 C))
163
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
183 (define (removeC C L)
184 (cond
185 ((null? L) '())
186 ((= C (first L))) (removeC C (rest L))
187 (((cons (first L) (removeC C (rest L)))))))
188 (println "removeC")
189 (println (removeC A L1))
190 ;escape character in newLISP?
191 (println (removeC \? L1))
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))))
199 (println "filtre")
200 ;(println (filtre L1 L2 ?))
201
202 (exit)