;; VERSION 2 DES POLYGONES EN CLOS ;; Celle-ci met en exergue le probleme du calcul de certaines proprietes ;; des instances d'une classe. Ici, il s'agit de l'aire d'un triangle, ;; qui ne devrait pas avoir a etre recalcul'ee si elle l'a ete. ;; La version qui suit est la solution la plus simple: ajouter un ;; attribut dans la classe qui stocke la valeur calculee d`es la ;; construction ou lors d'une modification de la forme du triangle. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; polygones (classe abstraite) (defclass polygon () ()) ;; une simple racine du DAG d'heritage (defgeneric get-sides ((f polygon)) ;; accesseur virtuel (:documentation "returns the list of sides of a polygon")) (defgeneric perimeter ((f polygon))) ;; methode virtuelle de base (defmethod perimeter ((f polygon)) ;; implementation par defaut (reduce #'+ (get-sides f))) ;; generique par "get-sides" ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; triangles: une sous-classe (egalement abstraite) de polygone qui ;;;; represente le minimum de ce qu'on peut dire sur un triangle. (defclass triangle (polygon) ((number-of-sides :initform 3 :allocation :class) (ar :initarg :ar ;; NOUVEL ATTRIBUT POUR L'AIRE :accessor ar))) (defmethod area ((tri triangle)) ;; implementation par defaut (ar tri)) ;; APPEL A L'ATTRIBUT... ;;;; quelques fonctions auxiliaires generales de calcul pour les triangles: (defun three-sides-to-angle (a b c) (acos (/ (- (+ (expt b 2) (expt c 2)) (expt a 2)) (* 2 b c)))) (defun area-of-triangle (a b c) (let ((angle-C (three-sides-to-angle c a b))) (* a b (sin angle-C) .5))) ;;;; quelques fonctions auxiliaires de controle de validit'e ;;;; lors de la construction et des acces en ecriture: (defun triangular-inequality (a b c) (and (<= a (+ b c)) (>= a (abs (- b c))))) (defun correct-sides (a b c) (and (> a 0) (> b 0) (> c 0) (triangular-inequality a b c))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; triangles quelconques, i.e. scalenes : une sous-classe ;;;; (concrete cette fois) de triangle (defclass triangle-scalene (triangle) ((side-a :initarg :side-a :reader side-a) (side-b :initarg :side-b :reader side-b) (side-c :initarg :side-c :reader side-c))) (defun make-triangle-scalene (a b c) ;; constructeur avec controle + AIRE CALCULEE (assert (correct-sides a b c)) (let ((tmp (area-of-triangle a b c))) (make-instance 'triangle-scalene :side-a a :side-b b :side-c c :ar tmp))) (defmethod get-sides ((s triangle-scalene)) ;;concretis. de l'access. aux cot'es (list (side-a s) (side-b s) (side-c s))) ;;;; accesseurs en ecriture avec controle: (defmethod resize-a ((s triangle-scalene) new-a) (let ((b (side-b s)) (c (side-c s))) (assert (correct-sides new-a b c)) (setf (slot-value s 'side-a) new-a) (setf (slot-value s 'ar) (area-of-triangle new-a b c)) s)) (defmethod resize-b ((s triangle-scalene) new-b) (let ((a (side-a s)) (c (side-c s))) (assert (correct-sides a new-b c)) (setf (slot-value s 'side-b) new-b) (setf (slot-value s 'ar) (area-of-triangle a new-b c)) s)) (defmethod resize-c ((s triangle-scalene) new-c) ;;idem ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; triangles isoceles : une autre sous-classe ;;;; concrete de triangle. Ici, seuls deux slots sont ;;;; necessaires pour stocker les cot'es. (defclass triangle-isocele (triangle) ((eq-side :initarg :eq-side :reader eq-side) (base-side :initarg :base-side :reader base-side))) (defun make-triangle-isocele (eq base) ;;constructeur avec controle + AIRE CALCULEE (assert (correct-sides eq eq base)) (let ((tmp (area-of-triangle eq eq base))) (make-instance 'triangle-isocele :eq-side eq :base-side base :ar tmp))) (defmethod get-sides ((i triangle-isocele)) (list (eq-side i) (eq-side i) (base-side i))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; triangles equilateres: une autre sous-classe ;;;; concrete de triangle. Ici, seul un slot est ;;;; necessaire pour stocker les cot'es. (defclass triangle-equilateral (triangle) ((side :initarg :side :reader side))) (defun make-triangle-equilateral (side) ;;constructeur avec controle + AIRE CALCULEE (assert (> side 0)) (let ((tmp (* side side (/ (sqrt 3.0) 4)))) (make-instance 'triangle-equilateral :side side :ar tmp))) (defmethod get-sides ((e triangle-equilateral)) (make-list 3 :initial-element (side e))) (defmethod perimeter ((e triangle-equilateral));; redef. du calcul du perimetre (* 3 (side e))) ;; i.e. une optimisation ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; triangles rectangles: une autre sous-classe ;;;; concrete de triangle. Ici, trois slots sont utilis'es, ;;;; mais le constructeur n'en necessite que deux. En fait, ;;;; l'hypothenuse est un attribut calcul'e (sans etre necessaire) (defclass triangle-rectangle (triangle) ((side-b :initarg :side-b :reader side-b) (side-c :initarg :side-c :reader side-c) (hypo :initarg :hypo :reader hypo))) (defun make-triangle-rectangle (b c) ;;constructeur avec controle + AIRE CALCULE (assert (and (> b 0) (> c 0))) (let ((h (sqrt (+ (* b b) (* c c)))) (tmp (* b c .5))) (make-instance 'triangle-rectangle :side-b b :side-c c :hypo h :ar tmp))) (defmethod get-sides ((tr triangle-rectangle)) (list (side-b tr) (side-c tr) (hypo tr))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; Test: une liste heterogene d'instances de triangles ;;;; est construite sur laquelle sont appliqu'ees les fonctions ;;;; de calcul de permimetre et d'aire: le polymorphisme marche. (defvar *l* (list (make-triangle-scalene 3 5 2) (make-triangle-isocele 3 4) (make-triangle-rectangle 3 4))) (mapcar #'area *l*) ;; (0.0 4.472136 6.0 314.1592653589793d0) (mapcar #'perimeter *l*) ;; (10 10 12.0 62.83185307179586d0)