;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Exercice 1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; 1. ;; CL-USER> (find-if #'evenp '(1 2 3 4 5) :from-end t) ;; 4 ;;; 2. ;; CL-USER> (find-if (lambda (s) (> (length s) 3)) ;; '(("rouge" . "red") ("vert" . "green") ("jaune" . "yellow")) ;; :key #'cdr) ;; ("vert" . "green") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Exercice 2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; 1. ;; CL-USER> (macroexpand-1 '(none (eq 'a 'a) (zerop 3))) ;; (NOT (OR (EQ 'A 'A) (ZEROP 3))) ;; T ;;; 2. ;; CL-USER> (none (eq 'a 'a) (zerop 3)) ;; NIL ;;; 3. ;; CL-USER> (macroexpand-1 '(once (eq 'a 'a) (zerop 3))) ;; (IF (EQ 'A 'A) (NONE (ZEROP 3)) (ONCE (ZEROP 3))) ;; T ;;; 4. ;; CL-USER> (once (eq 'a 'a) (zerop 3)) ;; T ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Exercice 3 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; 1. ;;; Une solution récursive (defun check-multiplicity (pmul l) (or (endp pmul) (and (= (caar pmul) (count (cdar pmul) l)) (check-multiplicity (cdr pmul) l)))) ;;; Une solution itérative (defun check-multiplicity (pmul l) (loop for m in pmul when (/= (car m) (count (cdr m) l)) do (return-from check-multiplicity nil)) t) ;;; 2. ;;; Une solution récursive (defun multiplicity (l) (if (endp l) '() (let ((e (car l))) (cons (cons (count e l) e) (multiplicity (remove e l)))))) ;;; Une solution itérative (defun multiplicity (l) (labels ((aux (x mul) (if (endp mul) (list (cons 1 x)) (if (= (cdar mul) x) (cons (cons (1+ (caar mul)) x) (cdr mul)) (cons (car mul) (aux x (cdr mul))))))) (if (endp l) '() (aux (car l) (multiplicity (cdr l)))))) ;;; 3. ;; CL-USER> (sort '((3 . 0) (4 . 1) (2 . 3)) #'< :key #'car) ;; ((2 . 3) (3 . 0) (4 . 1)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Exercice 4 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; 1. (defmethod (setf radius) :after (val (circle circle)) (declare (ignore val)) (setf (modified *current-buffer*) t) (setf (slot-value circle 'area) nil)) (defmethod (setf center) :after (center (circle circle)) (declare (ignore center) (ignore circle)) (setf (modified *current-buffer*) t)) ;;; 2. (defmacro define-saved-class (name super-classes slots &rest options) `(progn (defclass ,name ,super-classes ,(mapcar (lambda (slot) (remove ':save slot)) slots) ,@options) ,@(mapcar (lambda (slot) `(defmethod (setf ,(car slot)) :after ((,name ,name) val) (declare (ignore ,name) (ignore val)) (setf (modified *current-buffer*) t))) (remove-if (lambda (slot) (or (atom slot) (not (member ':save slot)))) slots))))