1;; Support for Maxima sets.
2;; Author: Barton Willis
3;; Send bug reports to willisb@unk.edu
4
5;; This code is in the public domain.  It has no warranty. Use this
6;; code at your own risk.
7
8(in-package :maxima)
9
10;; Use the predicate canonlt to order the elements of a set.  The
11;; default is $charsets_unorderedp.  The predicate $charsets_unorderedp always
12;; returns true; when canonlt is its default value, sets are
13;; never sorted. Other choices for $charsets_canonlt include $ordergreatp
14;; and $orderlessp.
15
16(defun $charsets_unorderedp (a b) t)
17(defmvar $charsets_canonlt '$charsets_unorderedp)
18
19;; The set package doesn't distinguish between sets and lists.  We're
20;; in trouble if we need to work simultaneously with a set of
21;; lists and a set of sets.  The commerical Macsyma seems to treat
22;; all set elements as lists; thus setify([[1,2],[2,1]) returns
23;; [[1,2],[2,1]] because [1,2] and [2,1] are treated as lists
24;; (and consequently they are not equal).  In this package, the
25;; user may decide if set elements that are lists are treated as
26;; lists or as sets.  When $charsets_set_elements_can_be_sets is true
27;; (the default),  set elements that are lists are treated
28;; as sets; otherwise,  when  $charsets_set_elements_can_be_sets is
29;; false, set elements that are lists are treated as lists.
30
31(defmvar $charsets_set_elements_can_be_sets t)
32
33;; For non-lists x and y, equalp(x,y) returns is(ratsimp(x-y)=0).
34;; Signal an error if either x or y is a list. Since equalp uses
35;; ratsimp, equalp(x/x,1) is true and equalp(x^(a*b),(x^a)^b)
36;; is false.
37
38(defun $charsets_equalp (x y)
39  (cond ((or ($listp x) ($listp y))
40	 (merror "Both arguments to `equalp' must be non-lists."))
41	(t ($charsets_xequalp x y))))
42
43;; If you are certain that x and y are not lists, you might call
44;; (at Maxima level) ?xequalp instead of equalp.
45
46(defun $charsets_xequalp (x y)
47  (like 0 ($ratsimp (add* x (*mminus y)))))
48
49;; If x and y are not lists, $charsets_elem_equalp(x,y) returns
50;; equalp(x,y).  If x and y are both lists, return
51;; setequality(x,y) if set_elements_can_be_sets; otherwise
52;; return equalp(x[1],y[1]) and equalp(x[2],y[2]) and ....
53;; Finally, if exactly one of x or y is a list, return false.
54
55(defun $charsets_elem_equalp (x  y)
56  (cond ((and ($listp x) ($listp y))
57	 (cond ($charsets_set_elements_can_be_sets
58		($charsets_setequality x y))
59	       ((and ($charsets_emptyp x) ($charsets_emptyp y)) t)
60	       (t
61		(and
62		 (= ($length x) ($length y))
63		 ($charsets_elem_equalp ($first x) ($first y))
64		 ($charsets_elem_equalp ($rest x) ($rest y))))))
65	((or ($listp x) ($listp y)) nil)
66	(t ($charsets_xequalp x y))))
67
68;;  Adjoin x to the Maxima list a; use equalp for the equality test.
69;;  When a isn't a list, signal an error.
70;;  Name this function charsets_adjoin2 to distinguish from 3-arg function
71;;  of same name in charsets.mac.
72
73(defun $charsets_adjoin2 (x a)
74  (cond (($listp a)
75	 (cons '(mlist) (adjoin x (margs a) :test #'$charsets_elem_equalp)))
76	(t (merror "The second argument to `charsets_adjoin2' must be a list"))))
77
78;; Setify removes duplicates from a Maxima list and sorts the
79;; list using the partial ordering function canonlt. To remove the
80;; duplicates from the list, we use element_equalp to test for equality.
81;; When the argument isn't a list, signal an error.
82
83(defun $charsets_setify (a)
84  (cond (($listp a)
85	 (charsets_mysort (cons '(mlist) (remove-duplicates (margs a) :test #'$charsets_elem_equalp))))
86	(t (merror "The argument to `setify' must be a list."))))
87
88;; When $charsets_canonlt is $charsets_unorderedp, don't sort; when $charsets_canonlt isn't
89;; $charsets_unorderedp, sort the list using the predicate $charsets_canonlt.
90
91(defun charsets_mysort (a)
92  (cond ((eq $charsets_canonlt '$charsets_unorderedp) a)
93	(t ($sort a $charsets_canonlt))))
94
95;; The maxima function call union(a1,a2,...an) forms the union of the
96;; sets a1,a2,...an.
97
98(defmfun $charsets_union ( &rest a)
99  ; (setq a (margs a)) this is buggy
100  (cond ((member nil (mapcar #'$listp a))
101	 (merror "Each argument to `union' must be a list."))
102	(t
103	 (cons '(mlist) (remove-duplicates (apply 'append  (map 'list 'rest a)) :test #'$charsets_elem_equalp)))))
104
105;; Remove elements of b from a.  Signal an error if a or b aren't lists.
106;; Use element_equalp for the equality test.
107
108(defun $charsets_setdifference (a b)
109  (cond ((and ($listp a) ($listp b))
110	 (cons '(mlist) (set-difference (margs a) (margs b) :test #'$charsets_elem_equalp)))
111	(t (merror "Both arguments to `setdifference' must be lists."))))
112
113;; Return the intersection of lists a and b.  Use element_equalp for the
114;; equality test. Signal an error if a or b aren't lists.
115
116(defmfun $charsets_intersection ( &rest a)
117  (setq a (margs a))
118  (cond ((member nil (mapcar #'$listp a))
119	 (merror "Each argument to `intersection' must be a list."))
120	(t
121	 (setq a (mapcar #'margs a))
122	 (cons '(mlist)
123	       (reduce #'(lambda (x y)
124			   (intersection x y :test #'$charsets_elem_equalp))
125		       a :from-end nil)))))
126
127;; Return true iff a is a subset of b.  Signal an error if
128;; a or b aren't Maxima lists.
129
130(defun $charsets_subsetp (a b)
131  (cond ((and ($listp a) ($listp b))
132	 (charsets_xsubsetp (margs a) b))
133	(t (merror "Both arguments to `subsetp' must be lists."))))
134
135;; charsets_xsubsetp returns true if and only if each element of the Lisp
136;; list a is a member of the Maxima list b.  This function isn't
137;; inteneded to be a user function; it doesn't check whether b is a
138;; Maxima list. Notice that the empty set is a subset of every
139;; set.
140
141(defun charsets_xsubsetp (a b)
142  (cond ((null a) t)
143	(t
144	 (and ($charsets_elementp (car a) b) (charsets_xsubsetp (cdr a) b)))))
145
146;; Return true iff a is a subset of b and b is a subset of a; return
147;; false if a or b are not lists.
148
149(defun $charsets_setequality (a b)
150  (cond ((and ($listp a) ($listp b))
151	 (if (and ($charsets_subsetp a b) ($charsets_subsetp b a)) t nil))
152	(t nil)))
153
154
155;; Return true iff x as an element of the list a; use $charsets_elem_equalp
156;; to test for equality if x isn't a list and use $charsets_setequality to
157;; test for equality if x is a list.  Return false if a isn't a list.
158
159(defun $charsets_elementp (x a)
160  (cond (($listp a)
161	 (cond (($listp x)
162		(cond ($charsets_set_elements_can_be_sets
163		       (if (member x (margs a) :test #'$charsets_setequality) t nil))
164		      (t
165		       (if (member x (margs a) :test #'$charsets_elem_equalp) t nil))))
166	       (t
167		(if (member x (margs a) :test #'$charsets_elem_equalp) t nil))))
168	(t nil)))
169
170;; Return true if e is an empty Maxima list; otherwise, signal an
171;; error.
172
173(defun $charsets_emptyp(e)
174  (cond (($listp e)
175	 (like e '((mlist))))
176	(t (merror "Argument to `emptyp' must be a list."))))
177
178;; Return an n element Maxima list [e,e,e,...e]. When n < 0 or
179;; n isn't an integer, signal an error.
180
181(defun $charsets_dupe (e n)
182  (cond ((and (integerp n) (> n -1))
183	 (cons '(mlist) (make-list n :initial-element e)))
184	(t (merror "Second argument to `dupe' must be a nonnegative integer."))))
185
186;; Return true if and only if the lists a and b are disjoint;
187;; signal an error if a or b aren't lists.
188
189(defun $charsets_disjointp (a b)
190  (cond ((and ($listp a) ($listp b))
191	 (not (intersection (margs a) (margs b) :test #'$charsets_elem_equalp)))
192	(t (merror "Both arguments to `disjointp' must be lists."))))
193
194;; Return those elements of a for which the predicate f evaluates
195;; to true; signal an error if a isn't a list.
196
197;; Return the union of a - b and b - a; signal an error if a or b
198;; aren't lists.
199
200(defun $charsets_symmdifference (a b)
201  (cond ((and ($listp a) ($listp b))
202	 (mfuncall '$charsets_union ($charsets_setdifference a b) ($charsets_setdifference b a)))
203	(t (merror "Both arguments to `symmdifference' must be lists."))))
204
205;; Return a list of the elements in b that are not in a.
206
207(defun $charsets_complement (a b)
208  (cond ((and ($listp a) ($listp b))
209	 ($charsets_setdifference b a))
210	(t (merror "Both arguments to `complement' must be lists."))))
211
212;; Return true if and only if the argument is a Maxima list and the
213;; list does not have duplicate elements.  charsets_setp doesn't check that
214;; the list is ordered according to canonlt.
215
216(defun $charsets_setp (a)
217  (and ($listp a) (charsets_setp (margs a))))
218
219(defun charsets_setp (a)
220  (cond ((null a) t)
221	(t (and (charsets_setp (cdr a)) (not (member (car a) (cdr a) :test #'$charsets_elem_equalp))))))
222
223;; Return the set of all subsets of a.  If a has n elements, charsets_powerset(a) has
224;; 2^n elements.  Signal an error if the argument isn't a Maxima list.
225
226(defun $charsets_powerset (a)
227  (cond (($listp a)
228	 (setq a ($charsets_setify a))
229	 (cons '(mlist) (mapcar #'(lambda (x) (cons '(mlist) x))
230				(charsets_powerset (margs a)))))
231	(t (merror "Argument to `charsets_powerset' must be a list."))))
232
233(defun charsets_powerset (a)
234  (cond ((null a) (list nil))
235	(t
236	 (let ((x (car a))
237	       (b (charsets_powerset (cdr a))))
238	   (append b (mapcar #'(lambda (u) (cons x u)) b))))))
239
240;; Return the set of all subsets of a that have exactly n elements.
241;; Signal an error if the first argument isn't a Maxima list or if
242;; the second argument isn't a nonnegative integer.
243
244(defun $charsets_subpowerset (a n)
245  (cond (($listp a)
246	 (setq a ($charsets_setify a))
247	 (cond ((and (integerp n) (> n -1))
248		(cons '(mlist) (mapcar #'(lambda (x) (cons '(mlist) x))
249				       (charsets_subpowerset (margs a) n))))
250	       (t
251		(merror "Second argument to SUBPOWERSET must
252be a nonnegative integer."))))
253	(t (merror "First argument to `charsets_subpowerset' must be a list."))))
254
255(defun charsets_subpowerset (a n)
256  (cond ((or (< n 1) (null a))
257	 nil)
258	((= n 1) (mapcar #'list a))
259	(t (let ((x (car a))
260		 (b (charsets_subpowerset (cdr a) (- n 1))))
261	     (append (charsets_subpowerset (cdr a) n)
262		     (mapcar #'(lambda (u) (cons x u)) b))))))
263
264