1%   File   : set_utilities.PL
    2%   Author : Lawrence Byrd + R.A.O'Keefe
    3%   Updated: 15 November 1983
    4%   Purpose: Set manipulation utilities
    5
    6% Updated by Neil Smith, for compatability with LPA Prolog 
    7
    8%   Sets are represented as lists with no repeated elements.
    9%   An ordered representation could be much more efficient, but
   10%   these routines were designed before sort/2 entered the language.
   11 
   12:- module(set_utilities,
   13      [ add_element/3,		%  Elem x Set -> Set
   14	del_element/3,		%  Elem x Set -> Set
   15	disjoint/1,		%  List ->
   16	disjoint/2,		%  Set x Set ->
   17	intersect/2,		%  Set x Set ->
   18	intersect/3,		%  Set x Set -> Set
   19	listtoset/2,		%  List -> Set
   20	% member/2,		%  Elem <- Set
   21	memberchk/2,		%  Elem x Set ->
   22	pairfrom/4,		%  Set -> Elem x Elem x Set
   23	select/3,		%  Elem <- Set -> Set
   24	seteq/2,		%  Set x Set ->
   25	subset/2,		%  Set x Set ->
   26	subtract/3,		%  Set x Set -> Set
   27	symdiff/3,		%  Set x Set -> Set
   28	union/3 		%  Set x Set -> Set
   29      ]).   30
   31:- ensure_loaded((utils_for_swi)).   32
   33/**********************
   34 *:- mode
   35*	memberchk(+, +),
   36*	pairfrom(?, ?, ?, ?),
   37*	select(?, ?, ?),
   38*	add_element(+, +, -),
   39*	del_element(+, +, -),
   40*	disjoint(+),
   41*	disjoint(+, +),
   42*	intersect(+, +),
   43*	subset(+, +),
   44*	seteq(+, +),
   45*	listtoset(+, ?),
   46*	intersect(+, +, ?),
   47*	subtract(+, +, ?),
   48*	symdiff(+, +, ?),
   49*	    symdiff(+, +, ?, ?),
   50*	union(+, +, ?).
   51**************************/ 
   52
   53 
   54%   memberchk(+Element, +Set)
   55%   means the same thing as member/2, but may only be used to test 
   56%   whether a known Element occurs in a known Set.  In return for 
   57%   this limited use, it is more efficient when it is applicable.
   58 
   59% memberchk(Element, [Element|_]) :- !.
   60% memberchk(Element, [_|Rest]) :-
   61% 	memberchk(Element, Rest).
   62
   63memberchk(Element, List) :-
   64	one member(Element, List).
   65 
   66 
   67 
   68%   add_element(Elem, Set1, Set2)
   69%   is true when Set1 and Set2 are sets represented as unordered lists,
   70%   and Set2 = Set1 U {Elem}.  It may only be used to calculate Set2
   71%   given Elem and Set1.  However, if Set1 is a list with a variable at
   72%   the end, it may still be used, and will add new elements at the end.
   73 
   74add_element(Elem, Set, Set) :-
   75	memberchk(Elem, Set),
   76	!.
   77add_element(Elem, Set, [Elem|Set]).
   78 
   79 
   80%   del_element(Elem, Set1, Set2)
   81%   is true when Set1 and Set2 are sets represented as unordered lists,
   82%   and Set2 = Set1 \ {Elem}.  It may only be used to calculate Set2
   83%   given Elem and Set1.  If Set1 does not contain Elem, Set2 and Set1
   84%   will be equal.  I wanted to call this predicate 'delete', but other
   85%   Prologs have used that for 'select'.  If Set1 is not an unordered
   86%   set, but contains more than one copy of Elem, only the first will
   87%   be removed.
   88 
   89del_element(Elem, [Elem|Set2], Set2) :- !.
   90del_element(Elem, [X|Set1], [X|Set2]) :- !,
   91	del_element(Elem, Set1, Set2).
   92del_element(_, [], []).
   93 
   94 
   95%   disjoint(+Set)
   96%   is true when Set is a list that contains no repeated elements.
   97%   disjoint/1 and disjoint/2 used to be defined using \+, but for
   98%   speed (as the Dec-10 compiler does not understand \+), this is
   99%   no longer so.  Sorry 'bout the !,fails, the price of speed.
  100 
  101disjoint([Head|Tail]) :-
  102	memberchk(Head, Tail),
  103	!, fail.
  104disjoint([_|Tail]) :- !,
  105	disjoint(Tail).
  106disjoint([]).
  107 
  108 
  109 
  110%   disjoint(+Set1, +Set2)
  111%   is true when the two given sets have no elements in common.
  112%   It is the opposite of intersect/2.
  113 
  114disjoint(Set1, Set2) :-
  115	member(Element, Set1),
  116	memberchk(Element, Set2),
  117	!, fail.
  118disjoint(_, _).
  119 
  120 
  121 
  122%   select(?Element, ?Set, ?Residue)
  123%   is true when Set is a list, Element occurs in Set, and Residue is
  124%   everything in Set except Element (things stay in the same order).
  125 
  126select(Element, [Element|Rest], Rest).
  127select(Element, [Head|Tail], [Head|Rest]) :-
  128	select(Element, Tail, Rest).
  129 
  130 
  131 
  132%   pairfrom(?Set, ?Element1, ?Element2, ?Residue)
  133%   is true when Set is a list, Element1 occurs in list, Element2
  134%   occurs in list after Element1, and Residue is everything in Set
  135%   bar the two Elements.  The point of this thing is to select
  136%   pairs of elements from a set without selecting the same pair
  137%   twice in different orders.
  138 
  139pairfrom([Element1|Set], Element1, Element2, Residue) :-
  140	select(Element2, Set, Residue).
  141pairfrom([Head|Tail], Element1, Element2, [Head|Rest]) :-
  142	pairfrom(Tail, Element1, Element2, Rest).
  143 
  144 
  145 
  146%   intersect(Set1, Set2)
  147%   is true when the two sets have a member in common.  It assumes
  148%   that both sets are known, and that you don't care which element
  149%   it is that they share.
  150 
  151intersect(Set1, Set2) :-
  152	member(Element, Set1),		%  generates Elements from Set1
  153	memberchk(Element, Set2),	%  tests them against Set2
  154	!.				%  if it succeeds once, is enough.
  155 
  156 
  157 
  158%   subset(+Set1, +Set2)
  159%   is true when each member of Set1 occurs in Set2.
  160%   It can only be used to test two given sets; it cannot be used
  161%   to generate subsets.  At the moment there is NO predicate for
  162%   generating subsets, but select/3 takes you part-way.
  163 
  164subset([], _).
  165subset([Element|Residue], Set) :-
  166	memberchk(Element, Set), !,
  167	subset(Residue, Set).
  168 
  169 
  170 
  171%   seteq(+Set1, +Set2)
  172%   is true when each Set is a subset of the other.  There are two
  173%   ways of doing this.  One is commented out.
  174 
  175seteq(Set1, Set2) :-
  176	subset(Set1, Set2),
  177	subset(Set2, Set1).
  178%	sort(Set1, Ord1),
  179%	sort(Set2, Ord2),
  180%	Ord1 == Ord2.
  181 
  182 
  183 
  184%   listtoset(+List, ?Set)
  185%   is true when List and Set are lists, and Set has the same elements
  186%   as List in the same order, except that it contains no duplicates.
  187%   The two are thus equal considered as sets.  If you really want to
  188%   convert a list to a set, list_to_ord_set is faster, but this way
  189%   preserves as much of the original ordering as possible.
  190 
  191listtoset([], []).
  192listtoset([Head|Tail], Set) :-
  193	memberchk(Head, Tail), !,
  194	listtoset(Tail, Set).
  195listtoset([Head|Tail], [Head|Set]) :-
  196	listtoset(Tail, Set).
  197 
  198 
  199 
  200%   intersect(+Set1, +Set2, ?Intersection)
  201%   is true when Intersection is the intersection of Set1 and Set2,
  202%   *taken in a particular order*.  In fact it is precisely the
  203%   elements of Set1 taken in that order, with elements not in Set2
  204%   deleted.  If Set1 contains duplicates, so may Intersection..
  205 
  206intersect([], _, []).
  207intersect([Element|Residue], Set, [Element|Intersection]) :-
  208	memberchk(Element, Set), !,
  209	intersect(Residue, Set, Intersection).
  210intersect([_|Rest], Set, Intersection) :-
  211	intersect(Rest, Set, Intersection).
  212 
  213 
  214 
  215%   subtract(+Set1, +Set2, ?Difference)
  216%   is like intersect, but this time it is the elements of Set1 which
  217%   *are* in Set2 that are deleted.
  218 
  219subtract([], _, []).
  220subtract([Element|Residue], Set, Difference) :-
  221	memberchk(Element, Set), !,
  222	subtract(Residue, Set, Difference).
  223subtract([Element|Residue], Set, [Element|Difference]) :-
  224	subtract(Residue, Set, Difference).
  225 
  226 
  227 
  228%   symdiff(+Set1, +Set2, ?Diff)
  229%   is true when Diff is the symmetric difference of Set1 and Set2,
  230%   that is, if each element of Union occurs in one of Set1 and Set2,
  231%   but not both.  The construction method is such that the answer
  232%   will contain no duplicates even if the Sets do.
  233 
  234symdiff(Set1, Set2, Diff) :-
  235	symdiff(Set1, Set2, Diff, Mid),
  236	symdiff(Set2, Set1, Mid, []).
  237 
  238symdiff([Elem|Rest], Avoid, Diff, Tail) :-
  239	memberchk(Elem, Avoid), !,
  240	symdiff(Rest, Avoid, Diff, Tail).
  241symdiff([Elem|Rest], Avoid, [Elem|Diff], Tail) :- !,
  242	symdiff(Rest, [Elem|Avoid], Diff, Tail).
  243symdiff([], _, Tail, Tail).
  244 
  245 
  246 
  247%   union(+Set1, +Set2, ?Union)
  248%   is true when subtract(Set1,Set2,Diff) and append(Diff,Set2,Union),
  249%   that is, when Union is the elements of Set1 that do not occur in
  250%   Set2, followed by all the elements of Set2.
  251 
  252union([], Set2, Set2).
  253union([Element|Residue], Set, Union) :-
  254	memberchk(Element, Set), !,
  255	union(Residue, Set, Union).
  256union([Element|Residue], Set, [Element|Union]) :-
  257	union(Residue, Set, Union)