;;;;;;;;;;;;;;;;;corrige_cc2.lisp;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;Q1;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun lmultiplesdo(d inf sup) ;;liste des entiers inf <= dn <= sup (do ((res nil (cons i res)) (i (* d (ceiling (/ inf d))) (+ i d))) ((> i sup) (nreverse res)))) ;CL-USER> (lmultiplesdo 3 5 14) ;(NIL 6 9 12) (defun lmultiplesloop(d inf sup) ;;liste des entiers inf <= dn <= sup (loop with res = nil and i = (* d (ceiling (/ inf d))) until (> i sup) do (setf res (cons i res)) do (setf i (+ i d)) finally (return (nreverse res)))) ;CL-USER> (lmultiplesloop 3 5 14) ;(NIL 6 9 12) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;; Ensembles d'entiers;;;;;;;;;;;;;; ;;;;;;;;;;;initial-cc2.lisp;;;;;;;;;;;;;;;;;; (defconstant +deb+ nil) ;;on represente un ensemble par une liste qui commence par +deb+ (defconstant +emptyset+ (list +deb+)) (defun set-emptyp (s) (endp (cdr s))) (defun set-member (e s) (member e (cdr s) :test #'eq)) (defun set-adjoin (e s) ;;renvoie l'union de s et de {e} (if (set-member e s) s (cons +deb+ (cons e (cdr s))))) ;CL-USER> (set-adjoin 5 (list +deb+ 1 2 3 4)) ;(NIL 5 1 2 3 4) ;;;;;;;;;;;;;;;;;;;;;;;;Q2;;;;;;;;;;;;;;;;;;;;;;; (defun nset-adjoin (e s) ;;remplace s par l'union de s et de {e} (if (set-member e s) t (progn (setf (cdr s) (cons e (cdr s))) nil))) (defparameter *ens* (list +deb+)) ;CL-USER> (nset-adjoin 2 *ens*) ;NIL ;CL-USER> (nset-adjoin 3 *ens*) ;NIL ;CL-USER> (nset-adjoin 2 *ens*) ;T ;CL-USER> *ens* ;(NIL 3 2) ;;;;;;;;;;;;;;;;;;;;;;;;Q3;;;;;;;;;;;;;;;;;;;;;;; (defun smultiples(d inf sup) (cons +deb+ (lmultiplesdo d inf sup))) ;CL-USER> (smultiples 3 5 14) ;(NIL 6 9 12) ;;;;;;;;;;;;;;;;;;;;;;;;Q4;;;;;;;;;;;;;;;;;;;;;;; (defun set-uniondo (s1 s2) (do ((ajout (cdr s2) (cdr ajout)) (res s1 (set-adjoin (car ajout) res))) ((endp ajout) res))) ;CL-USER> (set-uniondo (list +deb+ 1 2 3 4) (list +deb+ 3 4 5 6)) ;(NIL 6 5 1 2 3 4) (defun set-unionloop (s1 s2) (loop with res = s1 and ajout = (cdr s2) until (endp ajout) do (setf res (set-adjoin (car ajout) res)) do (pop ajout) finally (return res))) ;CL-USER> (set-unionloop (list +deb+ 1 2 3 4) (list +deb+ 3 4 5 6)) ;(NIL 6 5 1 2 3 4) ;;;;;;;;;;;;;;;;;;;;;;;;Q5;;;;;;;;;;;;;;;;;;;;;;; (defun set-intersectiondo (s1 s2 ) (do* ((lcandidates s1 (cdr lcandidates)) (cand +deb+ (car lcandidates)) (res +emptyset+ (if (set-member cand s2) (set-adjoin cand res) res))) ((endp (cdr lcandidates)) (cons +deb+ (nreverse (cdr res)))))) ;CL-USER> (set-intersectiondo (list +deb+ 1 2 3 4) (list +deb+ 3 4 5 6)) ;(NIL 3 4) (defun set-intersectionloop (s1 s2) (loop with lcandidates = s1 and cand = +deb+ and res = +emptyset+ until (endp (cdr lcandidates)) do (setf lcandidates (cdr lcandidates)) do (setf cand (car lcandidates)) do (setf res (if (set-member cand s2) (set-adjoin cand res) res)) finally (return (cons +deb+ (nreverse (cdr res)))))) CL-USER> (set-intersectionloop (list +deb+ 1 2 3 4) (list +deb+ 3 4 5 6)) (NIL 3 4) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;Q6;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; CL-USER> (set-intersectiondo (smultiples 2 0 100) (smultiples 3 0 100)) (NIL 0 6 12 18 24 30 36 42 48 54 60 66 72 78 84 90 96)