;;;CC1-PARTIE1 (defparameter *pas* (/ 1 1000000)) (defun DERIVE (f) (lambda (u) (/(-(funcall f (+ u *pas*))(funcall f (+ u 0))) *pas*))) (defun make-trinome (a b c) (lambda(x) (+ (* a x x) (* b x) c))) (defparameter *foo* (make-trinome 2 1 2)) (funcall *foo* 0) (defun c0(trin) (funcall trin 0)) ;CL-USER> (c0 (make-trinome 2 1 5)) ;5 (defun c1(trin) (funcall (DERIVE trin) 0)) ;CL-USER> (c1 (make-trinome 2 1 5)) ;500001/500000 (defun c2(trin) (/ (funcall (DERIVE (DERIVE trin)) 0) 2)) (c2 (make-trinome 2 1 5)) ;;CL-USER> (c2 *foo*) ;;2 ;;CL-USER> (c0 *foo*) ;;2 ;;CL-USER> (c1 *foo*) ;;500001/500000 (defun affine-p(trin) (zerop (c2 trin))) ;;CL-USER> (affine-p *foo*) ;;NIL ;;CL-USER> (affine-p (make-trinome 0 1 2)) ;;T ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;CC1-PARTIE2 ;;; A zone is represented as a function that takes a point in 2-dimensional ;;; space as a parameter (represented as a complex number), and returns T ;;; if and only if the point is in the zone, and NIL otherwise. ;;; To determine whether a point is in a zone, just call this function (defun point-in-zone-p (point zone) (funcall zone point)) ;;; Create a circular zone with center in (0,0) with the indicated radius. (defun make-disk (radius) (lambda (p) (<= (abs p) radius))) ;;; Given a zone, move it by a vector indicated as a complex number ;;; passed as the argument. (defun move-zone (zone vector) (lambda (p) (point-in-zone-p (- p vector) zone))) ;;renvoie le produit scalaire de u par v (defun scal(u v) (+ (* (realpart u) (realpart v)) (* (imagpart u) (imagpart v)))) ;;renvoie la projection sur la droite vectorielle engendree par v (defun proj(v) (lambda(p) (/ (* v (scal p v)) (scal v v)))) ;;renvoie la symetrie par rapport a la droite vectorielle engendree par v (defun sym(v) (lambda(p) (- (* 2 (funcall (proj v) p)) p))) ;;applique a zone la symetrie par rapport a la droite vectorielle engendree par v (defun symz(zone v) (lambda(p) (funcall zone (funcall (sym v) p)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;tests ;CL-USER> (scal #C(0 1) #C(2 1)) ;1 ;CL-USER> (funcall (proj #C(1 1)) #C(2 2)) ;#C(2 2) ;CL-USER> (funcall (proj #C(1 1)) #C(2 0)) ;#C(1 1) ;CL-USER> (funcall (sym #C(1 1)) #C(5 0)) ;#C(0 5) ;(defparameter *Z1* (make-disk 2)) ;(setf *Z1* (move-zone *Z1* #C(1 0))) ;(setf *Z1* (symz *Z1* #C(0 1))) ;CL-USER> (point-in-zone-p #C(0.5 0) *Z1*) ;T ;CL-USER> (point-in-zone-p #C(1.5 0) *Z1*) ;NIL