1(* ========================================================================= *)
2(* FINITE SETS IMPLEMENTED WITH RANDOMLY BALANCED TREES                      *)
3(* Copyright (c) 2004 Joe Hurd, distributed under the BSD License            *)
4(* ========================================================================= *)
5
6structure Set :> Set =
7struct
8
9(* ------------------------------------------------------------------------- *)
10(* A type of finite sets.                                                    *)
11(* ------------------------------------------------------------------------- *)
12
13type ('elt,'a) map = ('elt,'a) Map.map;
14
15datatype 'elt set = Set of ('elt,unit) map;
16
17(* ------------------------------------------------------------------------- *)
18(* Converting to and from maps.                                              *)
19(* ------------------------------------------------------------------------- *)
20
21fun dest (Set m) = m;
22
23fun mapPartial f =
24    let
25      fun mf (elt,()) = f elt
26    in
27      fn Set m => Map.mapPartial mf m
28    end;
29
30fun map f =
31    let
32      fun mf (elt,()) = f elt
33    in
34      fn Set m => Map.map mf m
35    end;
36
37fun domain m = Set (Map.transform (fn _ => ()) m);
38
39(* ------------------------------------------------------------------------- *)
40(* Constructors.                                                             *)
41(* ------------------------------------------------------------------------- *)
42
43fun empty cmp = Set (Map.new cmp);
44
45fun singleton cmp elt = Set (Map.singleton cmp (elt,()));
46
47(* ------------------------------------------------------------------------- *)
48(* Set size.                                                                 *)
49(* ------------------------------------------------------------------------- *)
50
51fun null (Set m) = Map.null m;
52
53fun size (Set m) = Map.size m;
54
55(* ------------------------------------------------------------------------- *)
56(* Querying.                                                                 *)
57(* ------------------------------------------------------------------------- *)
58
59fun peek (Set m) elt =
60    case Map.peekKey m elt of
61      SOME (elt,()) => SOME elt
62    | NONE => NONE;
63
64fun member elt (Set m) = Map.inDomain elt m;
65
66fun pick (Set m) =
67    let
68      val (elt,_) = Map.pick m
69    in
70      elt
71    end;
72
73fun nth (Set m) n =
74    let
75      val (elt,_) = Map.nth m n
76    in
77      elt
78    end;
79
80fun random (Set m) =
81    let
82      val (elt,_) = Map.random m
83    in
84      elt
85    end;
86
87(* ------------------------------------------------------------------------- *)
88(* Adding.                                                                   *)
89(* ------------------------------------------------------------------------- *)
90
91fun add (Set m) elt =
92    let
93      val m = Map.insert m (elt,())
94    in
95      Set m
96    end;
97
98local
99  fun uncurriedAdd (elt,set) = add set elt;
100in
101  fun addList set = List.foldl uncurriedAdd set;
102end;
103
104(* ------------------------------------------------------------------------- *)
105(* Removing.                                                                 *)
106(* ------------------------------------------------------------------------- *)
107
108fun delete (Set m) elt =
109    let
110      val m = Map.delete m elt
111    in
112      Set m
113    end;
114
115fun remove (Set m) elt =
116    let
117      val m = Map.remove m elt
118    in
119      Set m
120    end;
121
122fun deletePick (Set m) =
123    let
124      val ((elt,()),m) = Map.deletePick m
125    in
126      (elt, Set m)
127    end;
128
129fun deleteNth (Set m) n =
130    let
131      val ((elt,()),m) = Map.deleteNth m n
132    in
133      (elt, Set m)
134    end;
135
136fun deleteRandom (Set m) =
137    let
138      val ((elt,()),m) = Map.deleteRandom m
139    in
140      (elt, Set m)
141    end;
142
143(* ------------------------------------------------------------------------- *)
144(* Joining.                                                                  *)
145(* ------------------------------------------------------------------------- *)
146
147fun union (Set m1) (Set m2) = Set (Map.unionDomain m1 m2);
148
149fun unionList sets =
150    let
151      val ms = List.map dest sets
152    in
153      Set (Map.unionListDomain ms)
154    end;
155
156fun intersect (Set m1) (Set m2) = Set (Map.intersectDomain m1 m2);
157
158fun intersectList sets =
159    let
160      val ms = List.map dest sets
161    in
162      Set (Map.intersectListDomain ms)
163    end;
164
165fun difference (Set m1) (Set m2) =
166    Set (Map.differenceDomain m1 m2);
167
168fun symmetricDifference (Set m1) (Set m2) =
169    Set (Map.symmetricDifferenceDomain m1 m2);
170
171(* ------------------------------------------------------------------------- *)
172(* Mapping and folding.                                                      *)
173(* ------------------------------------------------------------------------- *)
174
175fun filter pred =
176    let
177      fun mpred (elt,()) = pred elt
178    in
179      fn Set m => Set (Map.filter mpred m)
180    end;
181
182fun partition pred =
183    let
184      fun mpred (elt,()) = pred elt
185    in
186      fn Set m =>
187         let
188           val (m1,m2) = Map.partition mpred m
189         in
190           (Set m1, Set m2)
191         end
192    end;
193
194fun app f =
195    let
196      fun mf (elt,()) = f elt
197    in
198      fn Set m => Map.app mf m
199    end;
200
201fun foldl f =
202    let
203      fun mf (elt,(),acc) = f (elt,acc)
204    in
205      fn acc => fn Set m => Map.foldl mf acc m
206    end;
207
208fun foldr f =
209    let
210      fun mf (elt,(),acc) = f (elt,acc)
211    in
212      fn acc => fn Set m => Map.foldr mf acc m
213    end;
214
215(* ------------------------------------------------------------------------- *)
216(* Searching.                                                                *)
217(* ------------------------------------------------------------------------- *)
218
219fun findl p =
220    let
221      fun mp (elt,()) = p elt
222    in
223      fn Set m =>
224         case Map.findl mp m of
225           SOME (elt,()) => SOME elt
226         | NONE => NONE
227    end;
228
229fun findr p =
230    let
231      fun mp (elt,()) = p elt
232    in
233      fn Set m =>
234         case Map.findr mp m of
235           SOME (elt,()) => SOME elt
236         | NONE => NONE
237    end;
238
239fun firstl f =
240    let
241      fun mf (elt,()) = f elt
242    in
243      fn Set m => Map.firstl mf m
244    end;
245
246fun firstr f =
247    let
248      fun mf (elt,()) = f elt
249    in
250      fn Set m => Map.firstr mf m
251    end;
252
253fun exists p =
254    let
255      fun mp (elt,()) = p elt
256    in
257      fn Set m => Map.exists mp m
258    end;
259
260fun all p =
261    let
262      fun mp (elt,()) = p elt
263    in
264      fn Set m => Map.all mp m
265    end;
266
267fun count p =
268    let
269      fun mp (elt,()) = p elt
270    in
271      fn Set m => Map.count mp m
272    end;
273
274(* ------------------------------------------------------------------------- *)
275(* Comparing.                                                                *)
276(* ------------------------------------------------------------------------- *)
277
278fun compareValue ((),()) = EQUAL;
279
280fun equalValue () () = true;
281
282fun compare (Set m1, Set m2) = Map.compare compareValue (m1,m2);
283
284fun equal (Set m1) (Set m2) = Map.equal equalValue m1 m2;
285
286fun subset (Set m1) (Set m2) = Map.subsetDomain m1 m2;
287
288fun disjoint (Set m1) (Set m2) = Map.disjointDomain m1 m2;
289
290(* ------------------------------------------------------------------------- *)
291(* Converting to and from lists.                                             *)
292(* ------------------------------------------------------------------------- *)
293
294fun transform f =
295    let
296      fun inc (x,l) = f x :: l
297    in
298      foldr inc []
299    end;
300
301fun toList (Set m) = Map.keys m;
302
303fun fromList cmp elts = addList (empty cmp) elts;
304
305(* ------------------------------------------------------------------------- *)
306(* Pretty-printing.                                                          *)
307(* ------------------------------------------------------------------------- *)
308
309fun toString set =
310    "{" ^ (if null set then "" else Int.toString (size set)) ^ "}";
311
312(* ------------------------------------------------------------------------- *)
313(* Iterators over sets                                                       *)
314(* ------------------------------------------------------------------------- *)
315
316type 'elt iterator = ('elt,unit) Map.iterator;
317
318fun mkIterator (Set m) = Map.mkIterator m;
319
320fun mkRevIterator (Set m) = Map.mkRevIterator m;
321
322fun readIterator iter =
323    let
324      val (elt,()) = Map.readIterator iter
325    in
326      elt
327    end;
328
329fun advanceIterator iter = Map.advanceIterator iter;
330
331end
332