;;;;;;;;;; Exercice 5.1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defstruct point x y) (defstruct (point (:print-function (lambda (p s k) (declare (ignore k)) (format s "(~A,~A)" (point-x p) (point-y p))))) (x 0) (y 0)) (defun on-the-same-line (p1 p2) (= (* (point-x p1) (point-y p2)) (* (point-y p1) (point-x p2)))) (defparameter *vector-list* (list (make-point :x 5 :y 8) (make-point :x 5 :y 6) (make-point :x 10 :y 16) (make-point :x 5/2 :y 3) (make-point :x 5 :y 6) (make-point :x 5 :y -8))) (set-from-list *vector-list* :test #'equalp) (defun quotient (vecteurs) (set-from-list vecteurs :test #'on-the-same-line)) (quotient *vector-list*) ;;;;;;;;;; Exercice 5.2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; tables de hachage (defstruct (color (:print-function (lambda (c s k) (declare (ignore k)) (format s "couleur{red=~d, green=~d, blue=~d}" (color-r c) (color-g c) (color-b c))))) "A color in RGB components (integers 0-255)" (r 0) (g 0) (b 0)) (defparameter *colors* (make-hash-table)) (describe *colors*) (setf (gethash 'red *colors*) (make-color :r 255)) (setf (gethash 'green *colors*) (make-color :g 255)) (setf (gethash 'blue *colors*) (make-color :b 255)) (setf (gethash 'white *colors*) (make-color :r 255 :g 255 :b 255)) (setf (gethash 'black *colors*) (make-color)) (setf (gethash 'gray *colors*) (make-color :r 128 :g 128 :b 128)) (setf (gethash 'orange *colors*) (make-color :r 255 :g 128)) (setf (gethash 'yellow *colors*) (make-color :r 255 :g 255)) (describe *colors*) (describe (gethash 'blue *colors*)) (defun keylist (table) (let ((l '())) (maphash #'(lambda (k v) (declare (ignore v)) (push k l)) table) (nreverse l))) (keylist *colors*) ;(YELLOW ORANGE GRAY BLACK WHITE BLUE GREEN RED) (with-hash-table-iterator (get-color *colors*) (get-color)) ;T ;RED ;couleur{red=255, green=0, blue=0} (with-hash-table-iterator (get-color *colors*) (get-color) (get-color)) ;T ;GREEN ;couleur{red=0, green=255, blue=0} (defun warm-colorp (color) (> (color-r color) (color-b color))) (warm-colorp (gethash 'red *colors*)) (warm-colorp (gethash 'blue *colors*)) (defun print-warm-colors (colors stream) (with-hash-table-iterator (get-color colors) (loop (multiple-value-bind (more k v) (get-color) (if more (when (warm-colorp v) (print k stream)) (return nil)))))) (print-warm-colors *colors* t) ; YELLOW ; RED ; ORANGE ; NIL ;; autre solution (pour s'entraîner à utiliser 'labels': ;; la boucle est simulée par un appel récursif (defun print-warm-colors (colors stream) (with-hash-table-iterator (get-color colors) (labels ((f () (multiple-value-bind (r k v) (get-color) (cond ((null r) nil) ;; v is warm ((warm-colorp v) (print k stream) (f)) ;; v is cold (t (f)))))) (f))))