;;;;;;;;;;Exercice 1;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defconstant the-empty-set '()) (defun set-emptyp (s) (endp s)) (defun set-member (x s &key (test #'eql) ) (cond ((set-emptyp s) nil) ((funcall test x (car s)) t) (t (set-member x (cdr s) :test test)))) ;;; sets from lists (naive version !) (defun set-from-list (l &key (test #'eql)) (cond ((endp l) the-empty-set) (t (let ((s (set-from-list (cdr l) :test test))) (if (set-member (car l) s :test test) s (cons (car l) s)))))) ;(set-from-list '(1 2 1 2 2 2 1 1) :test #'=) ;(2 1) ;;;different version (defun set-from-list2 (l &key (test #'eql)) (do ((l l (cdr l)) (acc nil (adjoin (first l) acc :test test))) ((endp l) acc))) ;(set-from-list2 '(1 2 1 2 2 2 1 1) :test #'=) ;(2 1) ;;;;;;;;;;Exercice 2;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defstruct (point (:print-function (lambda (p s k) (format s "(x part:~A, y part:~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)))) (setf l (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 -8))) (setf pointset (set-from-list l)) (setf quotiented_pointset (set-from-list l :test #'on-the-same-line)) ;;;;;;;;;;Exercice 3;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; essai de hash tables (defstruct (color (:print-function (lambda (c s 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)) (defvar *colortable* (make-hash-table :test #'eq)) (describe *colortable*) (setf (gethash 'red *colortable*) (make-color :r 255)) (setf (gethash 'green *colortable*) (make-color :g 255)) (setf (gethash 'blue *colortable*) (make-color :b 255)) (setf (gethash 'white *colortable*) (make-color :r 255 :g 255 :b 255)) (setf (gethash 'black *colortable*) (make-color)) (setf (gethash 'gray *colortable*) (make-color :r 128 :g 128 :b 128)) (setf (gethash 'orange *colortable*) (make-color :r 255 :g 128)) (setf (gethash 'yellow *colortable*) (make-color :r 255 :g 255)) (describe *colortable*) (describe (gethash 'blue *colortable*)) (defun tablelist (table) (let ((acc '())) (maphash #'(lambda (key val) (push key acc)) table) acc)) (tablelist *colortable*) ;(YELLOW ORANGE GRAY BLACK WHITE BLUE GREEN RED) (with-hash-table-iterator (get-color *colortable*) (get-color)) ;T ;RED ;couleur{red=255, green=0, blue=0} (with-hash-table-iterator (get-color *colortable*) (get-color) (get-color)) ;T ;GREEN ;couleur{red=0, green=255, blue=0} (defun print-warm-colors (stream) (with-hash-table-iterator (get-color *colortable*) (labels ((f () (multiple-value-bind (r k v) (get-color) (cond ((null r) nil) ;; v is warm ((> (color-r v) (color-b v)) (print v stream) (f)) ;; v is cold (t (f)))))) (f)))) (print-warm-colors t) ; couleur{red=255, green=0, blue=0} ; couleur{red=255, green=255, blue=0} ; couleur{red=255, green=128, blue=0} ; ; NIL