;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Exercice 1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; 1- (list '(1 2) '(3) '(4 5 6)) -> ((1 2) (3) (4 5 6)) ;; 2- (append '(1 2) '(3) '(4 5 6)) -> (1 2 3 4 5 6) ;; 3- (cons '(1 2) '(3 4)) -> ((1 2) 3 4) ;; 4- (remove '(a) '((a) (b) (c))) -> ((A) (B) (C)) ;; 5- (mapcar #'(lambda (e) (if (listp e) (length e) (list e))) ;; '((1 (2 3) 4) 5 (6 7 8))) -> (3 (5) 3) ;; 6- (remove-if #'evenp '((a . 2) (b . 3) (b . 4) (c . 5)) :key #'cdr) ;; -> ((B . 3) (C . 5)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Exercice 2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; 1- (mystere '(1 2 3 4 5)) -> (1 2 3 4 5) ;; 2- (mystere '(1 (2 3 (4 5)) (6))) -> (1 2 3 4 5 6) ;; 3- mystere supprime tous les niveaux de parenthèses d'une liste ;; 4- (defun my-flatten (l) (do ((ll '()) (todo l)) ((endp todo) (nreverse ll)) (let ((first (pop todo))) (if (listp first) (setf todo (append first todo)) (push first ll))))) ;; versions sans append (defun my-flatten2 (l) (let ((result '()) (stack (list l))) (do () ((endp stack) (nreverse result)) (let ((current-list (pop stack))) (if (not (endp current-list)) (progn (push (cdr current-list) stack) (if (listp (car current-list)) (push (car current-list) stack) (push (car current-list) result)))))))) (defun my-flatten3 (l) (do ((ll '()) (todo l)) ((endp todo) (nreverse ll)) (let ((first (pop todo))) (if (listp first) (unless (endp first) (push (cdr first) todo) (push (car first) todo)) (push first ll))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Exercice 3 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; 1- (defun f-n (f n) (if (zerop n) #'identity (lambda (x) (funcall f (funcall (f-n f (1- n)) x))))) ;; 2- (funcall (f-n #'1+ 10) 0) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Exercice 4 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; 1- (defun ens-adjoin (x e) (make-ens :test (ens-test e) :elements (adjoin x (ens-elements e) :test (ens-test e)))) ;; 2- (defun ens-from-list (l &key (test #'eql)) (make-ens :test test :elements (remove-duplicates l :test test :from-end t))) ;; 3- (defun display-sequence (l stream &key (sep " ")) (when l (mapc (lambda (e) (format stream "~A~A " e sep)) (butlast l)) (format stream "~A" (car (last l))))) (defstruct (ens (:print-function (lambda (e s k) (declare (ignore k)) (format s "{") (display-sequence (ens-elements e) s :sep ",") (format s "}")))) (test #'eql) (elements '())) ;; 4- (defun ens-nadjoin (x e) (unless (ens-member x e) (setf (ens-elements e) (push x (ens-elements e)))) e)