;; exercice 1 (cons '(A) '(B)) ;; ((A) B) (append '(A (B)) '(C) '(D)) ;; (A (B) C D) (remove '(A) '((A) B C) :test #'equal) ;; (B C) (mapcar (lambda (e) (if (atom e) 0 (length e))) '((1) 2 (3 4 5))) ;; (1 0 3) ;; exercice 2 ;; map-append (f l) retourne la concaténation des listes ;; obtenues en appliquant la fonction f à chacune des ;; sous-listes de la liste l. (defun map-append (f l) (if (endp l) '() (append (funcall f (car l)) (map-append f (cdr l))))) (defun map-append-iter (f l) (append-sublist-iter-1 (mapcar f l))) (map-append #'reverse '((1 2 3) (4 (5)) (6))) ;; (3 2 1 (5) 4 6) (map-append #'butlast '((1 2 3) (4 (5)) (6 7))) ;; (1 2 4 6) ;; append-sublist(l)} retourne la concaténation des sous-listes ;; de la liste l. (defun append-sublist (l) (if (endp l) '() (append (car l) (append-sublist (cdr l))))) ;;; La version itérative plus évidente ; aussi efficace (defun append-sublist-iter (l) (let ((res '())) (loop for e in l do (loop for i in e do (push i res))) (nreverse res))) ;;; le même algorithme avec dolist (defun append-sublist-iter (l) (let ((res nil)) (dolist (e l) (dolist (i e) (push i res))) (nreverse res))) ;;; nconc est une version destructive d'append (defun append-sublist-iter-1 (l) (do ((l l (cdr l)) (res '() (nconc (reverse (car l)) res))) ((endp l) (nreverse res)))) ;;; une solution géniale utilisant les fonctions de Common Lisp (defun append-sublist-iter-2 (l) (mapcan #'copy-list l)) ;;; une alternative avec loop (defun append-sublist-iter-3 (l) (loop for sublist in l append sublist)) (append-sublist '((1 2 3) (4 (5)) (6))) ;;(1 2 3 4 (5) 6) ;; exercice 3 (defstruct ville nom dept popu x y) (defparameter *v1* (make-ville :nom 'v1 :dept 10 :popu 10000 :x 0 :y 0)) (defparameter *v2* (make-ville :nom 'v2 :dept 10 :popu 15000 :x 10 :y 0)) (defparameter *v3* (make-ville :nom 'v3 :dept 20 :popu 8000 :x 10 :y 5)) (defparameter *v4* (make-ville :nom 'v4 :dept 20 :popu 6000 :x 20 :y 5)) (defparameter *v5* (make-ville :nom 'v5 :dept 20 :popu 10000 :x 20 :y 10)) (defparameter *v6* (make-ville :nom 'v6 :dept 30 :popu 12000 :x 30 :y 0)) (defparameter *v7* (make-ville :nom 'v7 :dept 30 :popu 4000 :x 40 :y 0)) (defparameter *v8* (make-ville :nom 'v8 :dept 40 :popu 60000 :x 40 :y 5)) (defparameter *v9* (make-ville :nom 'v9 :dept 20 :popu 5000 :x 30 :y 10)) (defparameter *villes* (list *v1* *v2* *v3* *v4* *v5* *v6* *v7* *v8* *v9*)) ;;; retourne la distance entre deux villes (defun distance-villes (v1 v2) (let ((x (- (ville-x v1) (ville-x v2 ))) (y (- (ville-y v1) (ville-y v2)))) (sqrt (+ (* x x) (* y y))))) (distance-villes *v1* *v2*) (distance-villes *v1* *v3*) ;;; tri une liste de villes par nombre décroissant d'habitants ;;; fonction destructive (defun tri-population (villes) (sort villes #'> :key #'ville-popu)) (tri-population *villes*) ;;; à partir d'une liste de villes, retourne une liste contenant la ;;; ville la plus peuplée de chaque département, triée par numéro ;;; croissant de département ;;; ;;; En cas de duplication remove-duplicates laisse le dernier élément trouvé. (defun tri-population-departement (villes) ;; Bien que sort soit destructive, il faut utiliser la valeur renvoyée. (let* ((villes-tri-popu (sort villes #'< :key #'ville-popu)) (villes-popu-dept (remove-duplicates villes-tri-popu :key #'ville-dept))) (sort villes-popu-dept #'< :key #'ville-dept))) (tri-population-departement *villes*) (defun tri-population-departement-bis (villes) (let ((villes-tri-popu (tri-population villes)) (res '())) (loop for v in villes-tri-popu do (setf res (adjoin v res :key #'ville-dept))) (sort res #'< :key #'ville-dept))) (defun ville-adjoin (v villes d) (adjoin v villes :test #'(lambda (v1 v2) (< (distance-villes v1 v2) d)))) ;;; à partir d'une liste de villes, retourne une liste de villes triée ;;; par nombre décroissant d'habitants et telle que la distance entre ;;; deux villes quelconques est supérieure à d km. ;;; Cette liste contient prioritairement les villes les plus peuplées (defun tri-population-distances-bis (villes d) (let ((villes-tri-popu (tri-population villes)) (res '())) (loop for v in villes-tri-popu do (setf res (ville-adjoin v res d))) (nreverse res))) (defun tri-population-distances (villes d) (let* ((villes-tri-popu (sort villes #'< :key #'ville-popu)) (villes-popu-dist (remove-duplicates villes-tri-popu :test #'(lambda (v1 v2) (< (distance-villes v1 v2) d))))) (sort villes-popu-dist #'> :key #'ville-popu))) (tri-population-distances-bis *villes* 12) ;; (#S(VILLE :NOM V8 :DEPT 40 :POPU 60000 :X 40 :Y 5) ;; #S(VILLE :NOM V2 :DEPT 10 :POPU 15000 :X 10 :Y 0) ;; #S(VILLE :NOM V5 :DEPT 20 :POPU 10000 :X 20 :Y 10)) (tri-population-distances-bis *villes* 11) ;; (#S(VILLE :NOM V8 :DEPT 40 :POPU 60000 :X 40 :Y 5) ;; #S(VILLE :NOM V2 :DEPT 10 :POPU 15000 :X 10 :Y 0) ;; #S(VILLE :NOM V6 :DEPT 30 :POPU 12000 :X 30 :Y 0) ;; #S(VILLE :NOM V5 :DEPT 20 :POPU 10000 :X 20 :Y 10)) (tri-population-distances-bis *villes* 10) ;; (#S(VILLE :NOM V8 :DEPT 40 :POPU 60000 :X 40 :Y 5) ;; #S(VILLE :NOM V2 :DEPT 10 :POPU 15000 :X 10 :Y 0) ;; #S(VILLE :NOM V6 :DEPT 30 :POPU 12000 :X 30 :Y 0) ;; #S(VILLE :NOM V1 :DEPT 10 :POPU 10000 :X 0 :Y 0) ;; #S(VILLE :NOM V5 :DEPT 20 :POPU 10000 :X 20 :Y 10) ;; #S(VILLE :NOM V9 :DEPT 20 :POPU 5000 :X 30 :Y 10)) (defparameter *ville-table* (make-hash-table :test #'eq)) (loop for ville in *villes* do (setf (gethash (ville-nom ville) *ville-table*) ville)) ;;; retourne une liste contenant la distance entre chaque ville ;;; dans la table et ville. La liste est de la forme : ;;; ((nom1 d1) (nom2 d2) ...) ;;; où nomi est le nom d'une ville dans la table et ;;; di la distance entre cette ville et la ville ville. (defun liste-villes-distances (table-villes cle-ville) (progn (let ((ville (gethash cle-ville table-villes))) (when ville (let ((res '())) (maphash (lambda (c v) (declare (ignore c)) (push (list (ville-nom v) (distance-villes ville v)) res)) table-villes) res))))) (liste-villes-distances *ville-table* 'v1)