1 665c255d 2023-08-04 jrmu (defun union-set (set1 set2)
 2 665c255d 2023-08-04 jrmu   (append
 3 665c255d 2023-08-04 jrmu    set1
 4 665c255d 2023-08-04 jrmu    (remove-if
 5 665c255d 2023-08-04 jrmu     (lambda (x)
 6 665c255d 2023-08-04 jrmu       (element-of-set? x set1))
 7 665c255d 2023-08-04 jrmu     set22)))
 8 665c255d 2023-08-04 jrmu (defun element-of-multiset? (x set)
 9 665c255d 2023-08-04 jrmu   (member x set :test #'equal))
10 665c255d 2023-08-04 jrmu (defun intersection-multiset (set1 set2)
11 665c255d 2023-08-04 jrmu   (cond ((or (null set1) (null set2)) '())
12 665c255d 2023-08-04 jrmu 	((element-of-multiset? (car set1) set2)
13 665c255d 2023-08-04 jrmu 	 (cons (car set1)
14 665c255d 2023-08-04 jrmu 	       (intersection-multiset (cdr set1) set2)))
15 665c255d 2023-08-04 jrmu 	(t (intersection-multiset (cdr set1) set2))))
16 665c255d 2023-08-04 jrmu (defun adjoin-multiset (x set)
17 665c255d 2023-08-04 jrmu   (cons x set))
18 665c255d 2023-08-04 jrmu (defun union-multiset (set1 set2)
19 665c255d 2023-08-04 jrmu   (append set1 set2))
20 665c255d 2023-08-04 jrmu 
21 665c255d 2023-08-04 jrmu (defun adjoin-set (x set)
22 665c255d 2023-08-04 jrmu   (cond ((null set) (cons x '()))
23 665c255d 2023-08-04 jrmu 	((< x (car set)) (cons x set))
24 665c255d 2023-08-04 jrmu 	((= x (car set)) set)
25 665c255d 2023-08-04 jrmu 	(t (cons (car set)
26 665c255d 2023-08-04 jrmu 		 (adjoin-set x (cdr set))))))
27 665c255d 2023-08-04 jrmu (defun union-set (set1 set2)
28 665c255d 2023-08-04 jrmu   (let ((x1 (car set1)) (x2 (car set2)))
29 665c255d 2023-08-04 jrmu     (cond ((null x1) set2)
30 665c255d 2023-08-04 jrmu 	  ((null x2) set1)
31 665c255d 2023-08-04 jrmu 	  ((= x1 x2)
32 665c255d 2023-08-04 jrmu 	   (cons x1 (union-set (cdr set1) (cdr set2))))
33 665c255d 2023-08-04 jrmu 	  ((< x1 x2)
34 665c255d 2023-08-04 jrmu 	   (cons x1 (union-set (cdr set1) set2)))
35 665c255d 2023-08-04 jrmu 	  (t
36 665c255d 2023-08-04 jrmu 	   (cons x2 (union-set set1 (cdr set2)))))))