;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Exercice 1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; 1- Le test pas défaut 'eql' ne permet pas de comparer des chaînes de caractères ;; 2- (defparameter *h* (make-hash-table :test #'equal)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Exercice 2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defmacro num-if (expr pos zero neg) (let ((g (gensym))) `(let ((,g ,expr)) (cond ((plusp ,g) ,pos) ((zerop ,g) ,zero) (t ,neg))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Exercice 3 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; 1- ((4 6) (1) ;; 2- (3 2 1 4) ;; 3- (defun fun-filter-do (l fun &optional (to-remove #'null)) (let ((ll '())) (dolist (e l (nreverse ll)) (let ((res (funcall fun e))) (unless (funcall to-remove res) (push res ll)))))) (defun fun-filter-loop (l fun &optional (to-remove #'null)) (loop for e in l and res = (funcall fun e) unless (funcall to-remove res) collect res)) ;; 4- ;; solution facile (defun fun-filter-easy (l fun &optional (to-remove #'null)) (remove-if to-remove (mapcar fun l))) ;; plus efficace (defun fun-filter-easy (l fun &optional (to-remove #'null)) (mapcan (lambda (e) (let ((res (funcall fun e))) (if (funcall to-remove res) '() (list res)))) l)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; Exercice 4 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; 1- (defmethod move ((circle circle) vector) (setf (center circle) (+ (center circle) vector))) (defmethod scale ((circle circle) scalar) (setf (center circle) (* scalar (center circle)) (radius circle) (* scalar (radius circle)))) (defmethod rotate ((circle circle) angle) (setf (center circle) (* (exp (* #c(0 1) angle)) (center circle)))) (defmethod bounding-box ((circle circle)) (let* ((radius (radius circle)) (center (center circle)) (x (realpart center)) (y (imagpart center))) (values (complex (- x radius) (- y radius)) (complex (+ x radius) (+ y radius))))) ;; 2- (defmethod scale ((region polygon) scalar) (setf (corners region) (mapcar (lambda (corner) (* corner scalar)) (corners region)))) (defmethod rotate ((polygon polygon) angle) (let ((z (exp (* #c(0 1) angle)))) (setf (corners polygon) (mapcar (lambda (point) (* point z)) (corners polygon))))) (defmethod bounding-box ((polygon polygon)) (let* ((corners (corners polygon)) (xs (mapcar #'realpart corners)) (ys (mapcar #'imagpart corners))) (values (complex (reduce #'min xs) (reduce #'min ys)) (complex (reduce #'max xs) (reduce #'max ys))))) ;; 3- (defclass region () ((bbox-min :accessor bbox-min) (bbox-max :accessor bbox-max) (bbox-valid-p :initform nil :accessor bbox-valid-p))) (defmethod scale :after ((region region) scalar) (declare (ignore scalar)) (setf (bbox-valid-p region) nil)) (defmethod move :after ((region region) scalar) (declare (ignore scalar)) (setf (bbox-valid-p region) nil)) (defmethod rotate :after ((region region) angle) (declare (ignore angle)) (setf (bbox-valid-p region) nil)) (defmethod bounding-box :around ((region region)) (unless (bbox-valid-p region) (multiple-value-bind (min max) (call-next-method) (setf (bbox-min region) min (bbox-max region) max (bbox-valid-p region) t))) (values (bbox-min region) (bbox-max region)))