;;;; finite sets in lisp (defconstant the-empty-set '()) ;;; emptyness (defun set-emptyp (s) (endp s)) ;;; membership (defun set-member (x s) (cond ((set-emptyp s) nil) ((eql x (car s)) t) (t (set-member x (cdr s))))) ;;; ou: (defun set-member (x s) (and (not set-emptyp s) (or (eql x (car s)) (set-member x (cdr s))))) ;;; union (defun set-union (s1 s2) (cond ((set-emptyp s1) s2) ((set-member (car s1) s2) (set-union (cdr s1) s2)) (t (cons (car s1) (set-union (cdr s1) s2))))) ;;; intersection (defun set-intersection (s1 s2) (cond ((set-emptyp s1) the-empty-set) ((set-member (car s1) s2) (cons (car s1) (set-intersection (cdr s1) s2))) (t (set-intersection (cdr s1) s2)))) ;;; difference (defun set-difference (s1 s2) (cond ((set-emptyp s1) the-empty-set) ((set-member (car s1) s2) (set-difference (cdr s1) s2)) (t (cons (car s1) (set-difference (cdr s1) s2))))) ;;; sets from lists (naive version !) (defun set-from-list (l) (cond ((endp l) the-empty-set) (t (let ((s (set-from-list (cdr l)))) (if (set-member (car l) s) s (cons (car l) s)))))) ;;;; ameliorations ;;; probleme de l'egalite (set-member '(8) '((2) (4) (8) (16))) ; nil (eql 6 12/2) (eql '(6) '(6)) (eq 6.0 (/ 12 2.0)) ;;; redefinition des fonctions avec mot clef (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)))) ;;; union (defun set-union (s1 s2 &key (test #'eql)) (cond ((set-emptyp s1) s2) ((set-member (car s1) s2 :test test) (set-union (cdr s1) s2 :test test)) (t (cons (car s1) (set-union (cdr s1) s2 :test test))))) ;;; intersection (defun set-intersection (s1 s2 &key (test #'eql)) (cond ((set-emptyp s1) the-empty-set) ((set-member (car s1) s2 :test test ) (cons (car s1) (set-intersection (cdr s1) s2 :test test ))) (t (set-intersection (cdr s1) s2 :test test )))) ;;; difference (defun set-difference (s1 s2 &key (test #'eql)) (cond ((set-emptyp s1) the-empty-set) ((set-member (car s1) s2 :test test) (set-difference (cdr s1) s2 :test test )) (t (cons (car s1) (set-difference (cdr s1) s2 :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)))))) ;;;; a particular test (defstruct point x y) (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 s (set-from-list l)) (setf s (set-from-list l :test #'on-the-same-line)) (describe s) (describe (car s))