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) '())
 122     ((atom? L) (list L))
 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 ;(println "replace")
 184 ;(println L1)
 185 ;(println L2)
 186 ;the replace function modify the passed argument
 187 ;(println (replace 'B L1))
 188 ;(println (replace '? L1))
 189 ;(println (replace '? L2))
 190 ;(println L1)
 191 ;(println L2)
 192
 193 (define (filtre L1 L2 C)
 194   ;the replace function modify the passed argument
 195   ;FIXME: use the function argument C
 196   (replace '? L1)
 197   (replace '? L2)
 198   (cond
 199     ((and (null? L1) (null? L2)) true)
 200     ((and (not (null? L1)) (null? L2)) nil)
 201     ((and (null? L1) (not (null? L2))) nil)
 202     ((and (inclu L1 L2) (inclu L2 L1) true))))
 203 (println "filtre")
 204 (println (filtre L1 L2 ?))
 205 (println (filtre L M ?))
 206
 207 ;algorithm written on the board
 208 (define (filtrerec L1 L2 C)
 209   ;FIXME: use the function argument C
 210   (cond
 211     ((null? L1)
 212       (cond
 213         ((null? L2) true)
 214         ((= '? (first L2)) (filtrerec L1 (rest L2)))
 215         (nil)))
 216     ((null? L2) (filtrerec L2 L1))
 217     ((= '? (first L1)) (filtrerec (rest L1) L2))
 218     ((= '? (first L2)) (filtrerec L1 (rest L2)))
 219     ((= (first L1) (first L2)) (filtrerec (rest L1) (rest L2)) )
 220     (nil)))
 221 (println "filtrerec")
 222 (println (filtrerec L1 L2 ?))
 223 (println (filtrerec L M ?))
 224
 225 (exit)