YAP 7.1.0
ordsets.yap
Go to the documentation of this file.
1/**
2 * @file ordsets.yap
3 * @author : R.A.O'Keefe
4 * @date 22 May 1983
5 * @author VITOR SANTOS COSTA <vsc@VITORs-MBP.lan>
6 * @date 1999
7 * @brief
8 *
9 *
10*/
11% This file has been included as an YAP library by Vitor Santos Costa, 1999
12
13:- module(ordsets, [
14 list_to_ord_set/2, % List -> Set
15 merge/3, % OrdList x OrdList -> OrdList
16 ord_add_element/3, % Set x Elem -> Set
17 ord_del_element/3, % Set x Elem -> Set
18 ord_disjoint/2, % Set x Set ->
19 ord_insert/3, % Set x Elem -> Set
20 ord_member/2, % Set -> Elem
21 ord_intersect/2, % Set x Set ->
22 ord_intersect/3, % Set x Set -> Set
23 ord_intersection/3, % Set x Set -> Set
24 ord_intersection/4, % Set x Set -> Set x Set
25 ord_seteq/2, % Set x Set ->
26 ord_setproduct/3, % Set x Set -> Set
27 ord_subset/2, % Set x Set ->
28 ord_subtract/3, % Set x Set -> Set
29 ord_symdiff/3, % Set x Set -> Set
30 ord_union/2, % Set^2 -> Set
31 ord_union/3, % Set x Set -> Set
32 ord_union/4, % Set x Set -> Set x Set,
33 ord_empty/1, % -> Set
34 ord_memberchk/2 % Element X Set
35 ]).
36
37/** @defgroup ordsets Ordered Sets
38 * @ingroup YAPLibrary
39 * @{
40
41The following ordered set manipulation routines are available once
42included with the `use_module(library(ordsets))` command. An
43ordered set is represented by a list having unique and ordered
44elements. Output arguments are guaranteed to be ordered sets, if the
45relevant inputs are. This is a slightly patched version of Richard
46O'Keefe's original library.
47
48In this module, sets are represented by ordered lists with no
49duplicates. Thus {c,r,a,f,t} would be [a,c,f,r,t]. The ordering
50is defined by the @< family of term comparison predicates, which
51is the ordering used by sort/2 and setof/3.
52
53The benefit of the ordered representation is that the elementary
54set operations can be done in time proportional to the Sum of the
55argument sizes rather than their Product. Some of the unordered
56set routines, such as member/2, length/2, select/3 can be used
57unchanged. The main difficulty with the ordered representation is
58remembering to use it!
59
60
61*/
62
63
64/** @pred ord_add_element(+ _Set1_, + _Element_, ? _Set2_)
65
66
67Inserting _Element_ in _Set1_ returns _Set2_. It should give
68exactly the same result as `merge(Set1, [Element], Set2)`, but a
69bit faster, and certainly more clearly. The same as ord_insert/3.
70
71
72*/
73/** @pred ord_del_element(+ _Set1_, + _Element_, ? _Set2_)
74
75
76Removing _Element_ from _Set1_ returns _Set2_.
77
78
79*/
80/** @pred ord_disjoint(+ _Set1_, + _Set2_)
81
82
83Holds when the two ordered sets have no element in common.
84
85
86*/
87/** @pred ord_insert(+ _Set1_, + _Element_, ? _Set2_)
88
89
90Inserting _Element_ in _Set1_ returns _Set2_. It should give
91exactly the same result as `merge(Set1, [Element], Set2)`, but a
92bit faster, and certainly more clearly. The same as ord_add_element/3.
93
94
95*/
96/** @pred ord_intersect(+ _Set1_, + _Set2_)
97
98
99Holds when the two ordered sets have at least one element in common.
100
101
102*/
103/** @pred ord_intersection(+ _Set1_, + _Set2_, ? _Intersection_)
104
105Holds when Intersection is the ordered representation of _Set1_
106and _Set2_.
107
108
109*/
110/** @pred ord_intersection(+ _Set1_, + _Set2_, ? _Intersection_, ? _Diff_)
111
112Holds when Intersection is the ordered representation of _Set1_
113and _Set2_. _Diff_ is the difference between _Set2_ and _Set1_.
114
115
116*/
117/** @pred ord_member(+ _Element_, + _Set_)
118
119
120Holds when _Element_ is a member of _Set_.
121
122
123*/
124/** @pred ord_seteq(+ _Set1_, + _Set2_)
125
126
127Holds when the two arguments represent the same set.
128
129
130*/
131/** @pred ord_setproduct(+ _Set1_, + _Set2_, - _Set_)
132
133
134If Set1 and Set2 are ordered sets, Product will be an ordered
135set of x1-x2 pairs.
136
137
138*/
139/** @pred ord_subset(+ _Set1_, + _Set2_)
140
141
142Holds when every element of the ordered set _Set1_ appears in the
143ordered set _Set2_.
144
145
146*/
147/** @pred ord_subtract(+ _Set1_, + _Set2_, ? _Difference_)
148
149
150Holds when _Difference_ contains all and only the elements of _Set1_
151which are not also in _Set2_.
152
153
154*/
155/** @pred ord_symdiff(+ _Set1_, + _Set2_, ? _Difference_)
156
157
158Holds when _Difference_ is the symmetric difference of _Set1_
159and _Set2_.
160
161
162*/
163/** @pred ord_union(+ _Set1_, + _Set2_, ? _Union_)
164
165Holds when _Union_ is the union of _Set1_ and _Set2_.
166
167
168*/
169/** @pred ord_union(+ _Set1_, + _Set2_, ? _Union_, ? _Diff_)
170
171Holds when _Union_ is the union of _Set1_ and _Set2_ and
172 _Diff_ is the difference.
173
174
175
176
177 */
178/** @pred ord_union(+ _Sets_, ? _Union_)
179
180
181Holds when _Union_ is the union of the lists _Sets_.
182
183
184*/
185
186/*
187:- mode
188 list_to_ord_set(+, ?),
189 merge(+, +, -),
190 ord_disjoint(+, +),
191 ord_disjoint(+, +, +, +, +),
192 ord_insert(+, +, ?),
193 ord_insert(+, +, +, +, ?),
194 ord_intersect(+, +),
195 ord_intersect(+, +, +, +, +),
196 ord_intersect(+, +, ?),
197 ord_intersect(+, +, +, +, +, ?),
198 ord_seteq(+, +),
199 ord_subset(+, +),
200 ord_subset(+, +, +, +, +),
201 ord_subtract(+, +, ?),
202 ord_subtract(+, +, +, +, +, ?),
203 ord_symdiff(+, +, ?),
204 ord_symdiff(+, +, +, +, +, ?),
205 ord_union(+, +, ?),
206 ord_union(+, +, +, +, +, ?).
207*/
208
209
210%% @pred list_to_ord_set(+List, ?Set)
211% is true when Set is the ordered representation of the set represented
212% by the unordered representation List. The only reason for giving it
213% a name at all is that you may not have realised that sort/2 could be
214% used this way.
215
216list_to_ord_set(List, Set) :-
217 sort(List, Set).
218
219
220%% @ored merge(+List1, +List2, -Merged)
221% is true when Merged is the stable merge of the two given lists.
222% If the two lists are not ordered, the merge doesn't mean a great
223% deal. Merging is perfectly well defined when the inputs contain
224% duplicates, and all copies of an element are preserved in the
225% output, e.g. merge("122357", "34568", "12233455678"). Study this
226% routine carefully, as it is the basis for all the rest.
227
228merge([Head1|Tail1], [Head2|Tail2], [Head2|Merged]) :-
229 Head1 @> Head2, merge,
230 merge([Head1|Tail1], Tail2, Merged).
231merge([Head1|Tail1], List2, [Head1|Merged]) :-
232 List2 \== [], ,
233 merge(Tail1, List2, Merged).
234merge([], List2, List2) :- merge.
235merge(List1, [], List1).
236
237
238
239%% @ored ord_disjoint(+Set1, +Set2)
240% is true when the two ordered sets have no element in common. If the
241% arguments are not ordered, I have no idea what happens.
242
243ord_disjoint([], _) :- ord_disjoint.
244ord_disjoint(_, []) :- ord_disjoint.
245ord_disjoint([Head1|Tail1], [Head2|Tail2]) :-
246 compare(Order, Head1, Head2),
247 ord_disjoint(Order, Head1, Tail1, Head2, Tail2).
248
249ord_disjoint(<, _, Tail1, Head2, Tail2) :-
250 ord_disjoint(Tail1, [Head2|Tail2]).
251ord_disjoint(>, Head1, Tail1, _, Tail2) :-
252 ord_disjoint([Head1|Tail1], Tail2).
253
254
255
256%% @ored ord_insert(+Set1, +Element, ?Set2)
257% ord_add_element(+Set1, +Element, ?Set2)
258% is the equivalent of add_element for ordered sets. It should give
259% exactly the same result as merge(Set1, [Element], Set2), but a bit
260% faster, and certainly more clearly.
261
262ord_add_element([], Element, [Element]).
263ord_add_element([Head|Tail], Element, Set) :-
264 compare(Order, Head, Element),
265 ord_insert(Order, Head, Tail, Element, Set).
266
267
268ord_insert([], Element, [Element]).
269ord_insert([Head|Tail], Element, Set) :-
270 compare(Order, Head, Element),
271 ord_insert(Order, Head, Tail, Element, Set).
272
273
274ord_insert(<, Head, Tail, Element, [Head|Set]) :-
275 ord_insert(Tail, Element, Set).
276ord_insert(=, Head, Tail, _, [Head|Tail]).
277ord_insert(>, Head, Tail, Element, [Element,Head|Tail]).
278
279
280
281%% @pred ord_intersect(+Set1, +Set2)
282% is true when the two ordered sets have at least one element in common.
283% Note that the test is == rather than = .
284
285ord_intersect([Head1|Tail1], [Head2|Tail2]) :-
286 compare(Order, Head1, Head2),
287 ord_intersect(Order, Head1, Tail1, Head2, Tail2).
288
289ord_intersect(=, _, _, _, _).
290ord_intersect(<, _, Tail1, Head2, Tail2) :-
291 ord_intersect(Tail1, [Head2|Tail2]).
292ord_intersect(>, Head1, Tail1, _, Tail2) :-
293 ord_intersect([Head1|Tail1], Tail2).
294
295ord_intersect(L1, L2, L) :-
296 ord_intersection(L1, L2, L).
297
298
299%% @pred ord_intersection(+Set1, +Set2, ?Intersection)
300% is true when Intersection is the ordered representation of Set1
301% and Set2, provided that Set1 and Set2 are ordered sets.
302
303ord_intersection([], _, []) :- ord_intersection.
304ord_intersection([_|_], [], []) :- ord_intersection.
305ord_intersection([Head1|Tail1], [Head2|Tail2], Intersection) :-
306 ( Head1 == Head2 ->
307 Intersection = [Head1|Tail],
308 ord_intersection(Tail1, Tail2, Tail)
309 ;
310 Head1 @< Head2 ->
311 ord_intersection(Tail1, [Head2|Tail2], Intersection)
312 ;
313 ord_intersection([Head1|Tail1], Tail2, Intersection)
314 ).
315
316%% @pred ord_intersection(+Set1, +Set2, ?Intersection, ?Difference)
317% is true when Intersection is the ordered representation of Set1
318% and Set2, provided that Set1 and Set2 are ordered sets.
319
320ord_intersection([], L, [], L) :- ord_intersection.
321ord_intersection([_|_], [], [], []) :- ord_intersection.
322ord_intersection([Head1|Tail1], [Head2|Tail2], Intersection, Difference) :-
323 ( Head1 == Head2 ->
324 Intersection = [Head1|Tail],
325 ord_intersection(Tail1, Tail2, Tail, Difference)
326 ;
327 Head1 @< Head2 ->
328 ord_intersection(Tail1, [Head2|Tail2], Intersection, Difference)
329 ;
330 Difference = [Head2|HDifference],
331 ord_intersection([Head1|Tail1], Tail2, Intersection, HDifference)
332 ).
333
334
335% ord_seteq(+Set1, +Set2)
336% is true when the two arguments represent the same set. Since they
337% are assumed to be ordered representations, they must be identical.
338
339
340ord_seteq(Set1, Set2) :-
341 Set1 == Set2.
342
343
344
345% ord_subset(+Set1, +Set2)
346% is true when every element of the ordered set Set1 appears in the
347% ordered set Set2.
348
349ord_subset([], _) :- ord_subset.
350ord_subset([Head1|Tail1], [Head2|Tail2]) :-
351 compare(Order, Head1, Head2),
352 ord_subset(Order, Head1, Tail1, Head2, Tail2).
353
354ord_subset(=, _, Tail1, _, Tail2) :-
355 ord_subset(Tail1, Tail2).
356ord_subset(>, Head1, Tail1, _, Tail2) :-
357 ord_subset([Head1|Tail1], Tail2).
358
359
360
361% ord_subtract(+Set1, +Set2, ?Difference)
362% is true when Difference contains all and only the elements of Set1
363% which are not also in Set2.
364
365
366ord_subtract(Set1, [], Set1) :- ord_subtract.
367ord_subtract([], _, []) :- ord_subtract.
368ord_subtract([Head1|Tail1], [Head2|Tail2], Difference) :-
369 compare(Order, Head1, Head2),
370 ord_subtract(Order, Head1, Tail1, Head2, Tail2, Difference).
371
372ord_subtract(=, _, Tail1, _, Tail2, Difference) :-
373 ord_subtract(Tail1, Tail2, Difference).
374ord_subtract(<, Head1, Tail1, Head2, Tail2, [Head1|Difference]) :-
375 ord_subtract(Tail1, [Head2|Tail2], Difference).
376ord_subtract(>, Head1, Tail1, _, Tail2, Difference) :-
377 ord_subtract([Head1|Tail1], Tail2, Difference).
378
379
380% ord_del_element(+Set1, Element, ?Rest)
381% is true when Rest contains the elements of Set1
382% except for Set1
383
384
385ord_del_element([], _, []).
386ord_del_element([Head1|Tail1], Head2, Rest) :-
387 compare(Order, Head1, Head2),
388 ord_del_element(Order, Head1, Tail1, Head2, Rest).
389
390ord_del_element(=, _, Tail1, _, Tail1).
391ord_del_element(<, Head1, Tail1, Head2, [Head1|Difference]) :-
392 ord_del_element(Tail1, Head2, Difference).
393ord_del_element(>, Head1, Tail1, _, [Head1|Tail1]).
394
395
396
397%% @pred ord_symdiff(+Set1, +Set2, ?Difference)
398% is true when Difference is the symmetric difference of Set1 and Set2.
399
400ord_symdiff(Set1, [], Set1) :- ord_symdiff.
401ord_symdiff([], Set2, Set2) :- ord_symdiff.
402ord_symdiff([Head1|Tail1], [Head2|Tail2], Difference) :-
403 compare(Order, Head1, Head2),
404 ord_symdiff(Order, Head1, Tail1, Head2, Tail2, Difference).
405
406ord_symdiff(=, _, Tail1, _, Tail2, Difference) :-
407 ord_symdiff(Tail1, Tail2, Difference).
408ord_symdiff(<, Head1, Tail1, Head2, Tail2, [Head1|Difference]) :-
409 ord_symdiff(Tail1, [Head2|Tail2], Difference).
410ord_symdiff(>, Head1, Tail1, Head2, Tail2, [Head2|Difference]) :-
411 ord_symdiff([Head1|Tail1], Tail2, Difference).
412
413
414
415% ord_union(+Set1, +Set2, ?Union)
416% is true when Union is the union of Set1 and Set2. Note that when
417% something occurs in both sets, we want to retain only one copy.
418
419ord_union([S|Set1], [], [S|Set1]).
420ord_union([], Set2, Set2).
421ord_union([Head1|Tail1], [Head2|Tail2], Union) :-
422 compare(Order, Head1, Head2),
423 ord_union(Order, Head1, Tail1, Head2, Tail2, Union).
424
425ord_union(=, Head, Tail1, _, Tail2, [Head|Union]) :-
426 ord_union(Tail1, Tail2, Union).
427ord_union(<, Head1, Tail1, Head2, Tail2, [Head1|Union]) :-
428 ord_union(Tail1, [Head2|Tail2], Union).
429ord_union(>, Head1, Tail1, Head2, Tail2, [Head2|Union]) :-
430 ord_union([Head1|Tail1], Tail2, Union).
431
432
433%% @pred ord_union(+Set1, +Set2, ?Union, ?Difference)
434% is true when Union is the union of Set1 and Set2 and Difference is the
435% difference between Set2 and Set1.
436
437ord_union(Set1, [], Set1, []) :- ord_union.
438ord_union([], Set2, Set2, Set2) :- ord_union.
439ord_union([Head1|Tail1], [Head2|Tail2], Union, Diff) :-
440 compare(Order, Head1, Head2),
441 ord_union(Order, Head1, Tail1, Head2, Tail2, Union, Diff).
442
443ord_union(=, Head, Tail1, _, Tail2, [Head|Union], Diff) :-
444 ord_union(Tail1, Tail2, Union, Diff).
445ord_union(<, Head1, Tail1, Head2, Tail2, [Head1|Union], Diff) :-
446 ord_union(Tail1, [Head2|Tail2], Union, Diff).
447ord_union(>, Head1, Tail1, Head2, Tail2, [Head2|Union], [Head2|Diff]) :-
448 ord_union([Head1|Tail1], Tail2, Union, Diff).
449
450
451
452%% @pred ord_setproduct(+Set1, +Set2, ?Product)
453% is in fact identical to setproduct(Set1, Set2, Product).
454% If Set1 and Set2 are ordered sets, Product will be an ordered
455% set of x1-x2 pairs. Note that we cannot solve for Set1 and
456% Set2, because there are infinitely many solutions when
457% Product is empty, and may be a large number in other cases.
458
459ord_setproduct([], _, []).
460ord_setproduct([H|T], L, Product) :-
461 ord_setproduct(L, H, Product, Rest),
462 ord_setproduct(T, L, Rest).
463
464ord_setproduct([], _, L, L).
465ord_setproduct([H|T], X, [X-H|TX], TL) :-
466 ord_setproduct(T, X, TX, TL).
467
468
469ord_member(El,[H|T]):-
470 compare(Op,El,H),
471 ord_member(Op,El,T).
472
473ord_member(=,_,_).
474ord_member(>,El,[H|T]) :-
475 compare(Op,El,H),
476 ord_member(Op,El,T).
477
478ord_union([], []).
479ord_union([Set|Sets], Union) :-
480 length([Set|Sets], NumberOfSets),
481 ord_union_all(NumberOfSets, [Set|Sets], Union, []).
482
483ord_union_all(N,Sets0,Union,Sets) :-
484 ( N=:=1 -> Sets0=[Union|Sets]
485 ; N=:=2 -> Sets0=[Set1,Set2|Sets],
486 ord_union(Set1,Set2,Union)
487 ; A is N>>1,
488 Z is N-A,
489 ord_union_all(A, Sets0, X, Sets1),
490 ord_union_all(Z, Sets1, Y, Sets),
491 ord_union(X, Y, Union)
492 ).
493
494ord_empty([]).
495
496ord_memberchk(Element, [E|_]) :- E == Element, ord_memberchk.
497ord_memberchk(Element, [_|Set]) :-
498 ord_memberchk(Element, Set).
499
500/** @} */
501
502
sort(+ L,- S)
length(? L,? S)
list_to_ord_set(+List, ?Set)
ord_add_element(+ Set1, + Element, ? Set2)
ord_del_element(+ Set1, + Element, ? Set2)
ord_disjoint(+ Set1, + Set2)
ord_insert(+ Set1, + Element, ? Set2)
ord_intersect(+ Set1, + Set2)
ord_intersection(+ Set1, + Set2, ? Intersection)
ord_intersection(+ Set1, + Set2, ? Intersection, ? Diff)
ord_member(+ Element, + Set)
ord_seteq(+ Set1, + Set2)
ord_setproduct(+ Set1, + Set2, - Set)
ord_subset(+ Set1, + Set2)
ord_subtract(+ Set1, + Set2, ? Difference)
ord_symdiff(+ Set1, + Set2, ? Difference)
ord_union(+ Sets, ? Union)
ord_union(+ Set1, + Set2, ? Union)
ord_union(+ Set1, + Set2, ? Union, ? Diff)