1%   File   : ORDSET.PL
    2%   Author : R.A.O'Keefe, Neil Smith
    3%   Updated: 28 February 2000
    4%   Purpose: Ordered set manipulation utilities
    5
    6
    7%   In this module, sets are represented by ordered lists with no
    8%   duplicates.  Thus {c,r,a,f,t} would be [a,c,f,r,t].  The default ordering
    9%   is defined by the @< family of term comparison predicates, which
   10%   is the ordering used by sort/2 and setof/3.
   11 
   12%   If required, all of these predicates can be given a comparator predicate
   13%   for defining sets with custom ordering.  This must have the same interface
   14%   as the standard compare/3 predicate, ie
   15%        my_compare(?Rel, +Item1, +Item2) with Rel one of { <, =, > }
   16
   17%   The benefit of the ordered representation is that the elementary
   18%   set operations can be done in time proportional to the Sum of the
   19%   argument sizes rather than their Product.  Some of the unordered
   20%   set routines, such as member/2, length/2, select/3 can be used
   21%   unchanged.  The main difficulty with the ordered representation is
   22%   remembering to use it!
   23 
   24:- module(ordered_set_utilities, 
   25      [ insert_merge/3,         %  Ordset x Item -> Ordset			!!Does NOT preserve sets!!
   26	insert_merge/4,         %  Ordset x Item x Comparator -> Ordset 	!!Does NOT preserve sets!!
   27	merge/3,                %  OrdList x OrdList -> OrdList 		!!Does NOT preserve sets!!
   28	merge/4,                %  OrdList x OrdList x Comparator -> OrdList 	!!Does NOT preserve sets!!
   29	list_to_ord_set/2,      %  List -> Set
   30	list_to_ord_set/3,      %  List x Comparator -> Set
   31	insert/3,               %  Ordset x Item -> Ordset
   32	insert/4,               %  Ordset x Item x Comparator -> Ordset 
   33	ord_disjoint/2,         %  Set x Set ->
   34	ord_disjoint/2,         %  Set x Set x Comparator ->
   35	ord_intersect_chk/2,    %  Set x Set -> 
   36	ord_intersect_chk/3,    %  Set x Set x Comparator -> 
   37	ord_intersect/3,        %  Set x Set -> Set
   38	ord_intersect/4,        %  Set x Set x Comparator -> Set
   39	ord_seteq/2,            %  Set x Set ->
   40	%ord_seteq/3,            %  Set x Set x Comparator ->
   41	ord_subset/2,           %  Set x Set ->
   42	ord_subset/3,           %  Set x Set x Comparator ->
   43	ord_subtract/3,         %  Set x Set -> Set
   44	ord_subtract/4,         %  Set x Set x Comparator -> Set
   45	%ord_symdiff/3,          %  Set x Set -> Set
   46	ord_symdiff/4,          %  Set x Set x Comparator -> Set
   47	ord_union/3,            %  Set x Set -> Set
   48	ord_union/4,            %  Set x Set x Comparator -> Set
   49	ord_union_and_new/4,    %  Set x Set -> Set x Set
   50	ord_union_and_new/5     %  Set x Set x Comparator -> Set x Set
   51      ]).   52
   53:- ensure_loaded((utils_higher_order)).   54
   55/**************
   56 * :- mode
   57 * 	list_to_ord_set(+, ?),
   58 * 	merge(+, +, -),
   59 * 	ord_disjoint(+, +),
   60 * 	    ord_disjoint(+, +, +, +, +),
   61 * 	ord_intersect(+, +),
   62 * 	    ord_intersect(+, +, +, +, +),
   63 * 	ord_intersect(+, +, ?),
   64 * 	    ord_intersect(+, +, +, +, +, ?),
   65 * 	ord_seteq(+, +),
   66 * 	ord_subset(+, +),
   67 * 	    ord_subset(+, +, +, +, +),
   68 * 	ord_subtract(+, +, ?),
   69 * 	    ord_subtract(+, +, +, +, +, ?),
   70 * 	ord_symdiff(+, +, ?),
   71 * 	    ord_symdiff(+, +, +, +, +, ?),
   72 * 	ord_union(+, +, ?),
   73 * 	    ord_union(+, +, +, +, +, ?).
   74 **************/
   75 
   76
   77%   insert_merge(+List, +Item, -Merged)
   78%   insert_merge(+List, +Item, +Comparator, -Merged)
   79%   is true when Merged is the stable merge of Item into List.
   80%   If the two lists are not ordered, the merge doesn't mean a great
   81%   deal.  Merging is perfectly well defined when the inputs contain
   82%   duplicates, and all copies of an element are preserved in the
   83%   output, e.g. insert_merge([1,2,2,3,5,7], 3, [1,2,2,3,3,5,7]). 
   84%   New items are placed before existing items to which they are equal. 
   85%   Study this routine carefully, as it is the basis for all the rest.
   86
   87insert_merge(Set0, Item, Set):-
   88	insert_merge(Set0, Item, compare, Set).
   89
   90insert_merge([], Item, _, [Item]).
   91insert_merge([Element|Set0], Item, Comparator, Set):-
   92	call(Comparator, Order, Element, Item),
   93	insert_merge2(Order, Element, Item, Set0, Comparator, Set).
   94
   95	insert_merge2(<, Element, Item, Set0, Comparator, [Element|Set]):-
   96		insert_merge(Set0, Item, Comparator, Set).
   97	insert_merge2(=, Element, Item, Set,  _,          [Item, Element|Set]).
   98	insert_merge2(>, Element, Item, Set,  _,          [Item, Element|Set]).
   99
  100 
  101%   merge(+List1, +List2, -Merged)
  102%   merge(+List1, +List2, +Comparator, -Merged)
  103%   is true when Merged is the stable merge of the two given lists.
  104%   If the two lists are not ordered, the merge doesn't mean a great
  105%   deal.  Merging is perfectly well defined when the inputs contain
  106%   duplicates, and all copies of an element are preserved in the
  107%   output, e.g. merge("122357", "34568", "12233455678").  Study this
  108%   routine carefully, as it is the basis for all the rest.
  109
  110merge(List1, List2, Merged):-
  111	merge(List1, List2, compare, Merged).
  112
  113merge(List1, List2, Comparator, Merged):-
  114	foldl(List1, 
  115		[Merged0, Element, Merged1]^insert_merge(Merged0, Element, Comparator, Merged1), 
  116		List2, Merged).
  117
  118
  119%   insert(+Set0, +Item, ?Set)
  120%   insert(+Set0, +Item, +Comparator, ?Set)
  121%   is true when Set is the union of Set0 and the singleton set [Item]
  122%   if Item already exists in Set0, it is not replaced with the new item
  123
  124insert(Set0, Item, Set):-
  125	insert(Set0, Item, compare, Set).
  126
  127insert([], Item, _, [Item]).
  128insert([Element|Set0], Item, Comparator, Set):-
  129	call(Comparator, Order, Element, Item),
  130	insert2(Order, Element, Item, Set0, Comparator, Set).
  131
  132	insert2(<, Element, Item, Set0, Comparator, [Element|Set]):-
  133		insert(Set0, Item, Comparator, Set).
  134	insert2(=, Element, _,    Set,  _,          [Element|Set]).
  135	insert2(>, Element, Item, Set,  _,          [Item, Element|Set]).
  136
  137
  138%   list_to_ord_set(+List, ?Set)
  139%   list_to_ord_set(+List, +Comparator, ?Set)
  140%   is true when Set is the ordered representation of the set represented
  141%   by the unordered representation List.  The only reason for giving it
  142%   a name at all is that you may not have realised that sort/2 could be
  143%   used this way.
  144 
  145list_to_ord_set(List, Set) :-
  146	sort(List, Set).
  147
  148% Oh look, an insertion sort!
  149list_to_ord_set(List, Comparator, Set):-
  150	foldl(List, [Set0, Element, Set1]^insert(Set0, Element, Comparator, Set1), [], Set).
  151
  152
  153%   ord_intersect_chk(+Set1, +Set2)
  154%   ord_intersect_chk(+Set1, +Set2, +Comparator)
  155%   is true when the two ordered sets have at least one element in common.
  156%   Note that the test is == rather than = .
  157 
  158ord_intersect_chk(Set1, Set2):-
  159	ord_intersect_chk(Set1, Set2, compare).
  160
  161ord_intersect_chk([H1|T1], Set2, Comparator):-
  162	ord_intersect_chk2(Set2, H1, T1, Comparator).
  163
  164	ord_intersect_chk2([H2|T2], H1, T1, Comparator):-
  165		call(Comparator, Order, H1, H2),
  166		ord_intersect_chk3(Order, H1, T1, H2, T2, Comparator).
  167
  168	ord_intersect_chk3(<, _H1, T1,  H2, T2, Comparator):-
  169		ord_intersect_chk2(T1,  H2, T2, Comparator).
  170	ord_intersect_chk3(=,  _,  _,  _,   _, _).
  171	ord_intersect_chk3(>,  H1, T1, _H2, T2, Comparator):-
  172		ord_intersect_chk2(T2,  H1, T1, Comparator).
  173
  174
  175
  176%   ord_intersect(+Set1, +Set2, ?Intersection)
  177%   ord_intersect(+Set1, +Set2, +Comparator, ?Intersection)
  178%   is true when Intersection is the ordered representation of Set1
  179%   and Set2, provided that Set1 and Set2 are ordered sets.
  180 
  181ord_intersect(Set1, Set2, Intersection):-
  182	ord_intersect(Set1, Set2, compare, Intersection).
  183
  184ord_intersect([], _, _, []).
  185ord_intersect([H1|T1], Set2, Comparator, Intersection):-
  186	ord_intersect2(Set2, H1, T1, Comparator, Intersection).
  187
  188	ord_intersect2([], _, _, _, []).
  189	ord_intersect2([H2|T2], H1, T1, Comparator, Intersection):-
  190		call(Comparator, Order, H1, H2),
  191		ord_intersect3(Order, H1, T1, H2, T2, Comparator, Intersection).
  192
  193	ord_intersect3(<, _H1, T1, H2, T2, Comparator, Intersection):-
  194		ord_intersect2(T1, H2, T2, Comparator, Intersection).
  195	ord_intersect3(=, H,  T1, _H,  T2, Comparator, [H|Intersection]):-
  196		ord_intersect(T1, T2, Comparator, Intersection).
  197	ord_intersect3(>, H1, T1, _H2, T2, Comparator, Intersection):-
  198		ord_intersect2(T2, H1, T1, Comparator, Intersection).
  199
  200
  201 
  202%   ord_seteq(+Set1, +Set2)
  203%   is true when the two arguments represent the same set.  Since they
  204%   are assumed to be ordered representations, they must be identical.
  205 
  206 
  207ord_seteq(Set1, Set2) :-
  208	Set1 == Set2.
  209 
  210
  211
  212%   ord_disjoint(+Set1, +Set2)
  213%   ord_disjoint(+Set1, +Set2, +Comparator)
  214%   is true when the two ordered sets have no element in common.  If the
  215%   arguments are not ordered, I have no idea what happens.
  216
  217ord_disjoint(Set1, Set2):-
  218	ord_disjoint(Set1, Set2, compare).
  219
  220ord_disjoint([], _, _).
  221ord_disjoint([H1|T1], Set2, Comparator):-
  222	ord_disjoint2(Set2, H1, T1, Comparator).
  223
  224	ord_disjoint2([], _, _, _).
  225	ord_disjoint2([H2|T2], H1, T1, Comparator):-
  226		call(Comparator, Order, H1, H2),
  227		ord_disjoiont3(Order, H1, T1, H2, T2, Comparator).
  228
  229	ord_disjoint3(<, _H1, T1,  H2, T2, Comparator):-
  230		ord_disjoint2(T1,  H2, T2, Comparator).
  231	ord_disjoint3(>,  H1, T1, _H2, T2, Comparator):-
  232		ord_disjoint2(T2,  H1, T1, Comparator).
  233
  234
  235
  236%   ord_subset(+Set1, +Set2)
  237%   ord_subset(+Set1, +Set2, +Comparator)
  238%   is true when every element of the ordered set Set1 appears in the
  239%   ordered set Set2.
  240 
  241ord_subset(Set1, Set2):-
  242	ord_subset(Set1, Set2, compare).
  243
  244ord_subset([], _, _).
  245ord_subset([H1|T1], Set2, Comparator):-
  246	ord_subset2(Set2, H1, T1, Comparator).
  247
  248	ord_subset2([H2|T2], H1, T1, Comparator):-
  249		call(Comparator, Order, H1, H2),
  250		ord_subset3(Order, H1, T1, H2, T2, Comparator).
  251
  252	ord_subset3(=, _H, T1, _H, T2, Comparator):-
  253		ord_subset(T1, T2, Comparator).
  254	ord_subset3(>, H1, T1, _H2, T2, Comparator):-
  255		ord_subset2(T2, H1, T1, Comparator).
  256
  257
  258
  259%   ord_subtract(+Set1, +Set2, ?Difference)
  260%   ord_subtract(+Set1, +Set2, +Comparator, ?Difference)
  261%   is true when Difference contains all and only the elements of Set1
  262%   which are not also in Set2.
  263 
  264ord_subtract(Set1, Set2, Difference):-
  265	ord_subtract(Set1, Set2, compare, Difference).
  266
  267ord_subtract([], _, _, []).
  268ord_subtract([H1|T1], Set2, Comparator, Difference):-
  269	ord_subtract2(Set2, H1, T1, Comparator, Difference).
  270
  271	ord_subtract2([], H1, T1, _, [H1|T1]).
  272	ord_subtract2([H2|T2], H1, T1, Comparator, Difference):-
  273		call(Comparator, Order, H1, H2),
  274		ord_subtract3(Order, H1, T1, H2, T2, Comparator, Difference).
  275
  276	ord_subtract2a([], _, _, _, []).
  277	ord_subtract2a([H1|T1], H2, T2, Comparator, Difference):-
  278		call(Comparator, Order, H1, H2),
  279		ord_subtract3(Order, H1, T1, H2, T2, Comparator, Difference).
  280
  281	ord_subtract4(<, H1, T1, H2, T2, Comparator, [H1|Difference]):-
  282		ord_subtract2a(T1, H2, T2, Comparator, Difference).
  283	ord_subtract4(=, _H, T1, _H, T2, Comparator, Difference):-
  284		ord_subtract(T1, T2, Comparator, Difference).
  285	ord_subtract4(>, H1, T1, _H2, T2, Comparator, Difference):-
  286		ord_subtract2(T2, H1, T1, Comparator, Difference).
  287
  288
  289%   ord_symdiff(+Set1, +Set2, ?Difference)
  290%   ord_symdiff(+Set1, +Set2, +Comparator, ?Difference)
  291%   is true when Difference is the symmetric difference of Set1 and Set2.
  292%   That is, ord_symdiff(Set1, Set2) = union(Set1, Set2) - intersection(Set1, Set2)
  293 
  294ord_symmdiff(Set1, Set2, Difference):-
  295	ord_symmdiff(Set1, Set2, compare, Difference).
  296
  297ord_symdiff([], Set2, _, Set2).
  298ord_symdiff([H1|T1], Set2, Comparator, Difference):-
  299	ord_symdiff2(Set2, H1, T1, Comparator, Difference).
  300
  301	ord_symdiff2([], H1, T1, _, [H1|T1]).
  302	ord_symdiff2([H2|T2], H1, T1, Comparator, Difference):-
  303		call(Comparator, Order, H1, H2),
  304		ord_symdiff3(Order, H1, T1, H2, T2, Comparator, Difference).
  305
  306	ord_symdiff3(<, H1, T1, H2, T2, Comparator, [H1|Difference]):-
  307		ord_symdiff2(T1, H2, T2, Comparator, Difference).
  308	ord_symdiff3(=, _H, T1, _H, T2, Comparator, Difference):-
  309		ord_symdiff(T1, T2, Comparator, Difference).
  310	ord_symdiff3(>, H1, T1, H2, T2, Comparator, [H2|Difference]):-
  311		ord_symdiff2(T2, H1, T1, Comparator, Difference).
  312
  313
  314
  315%   ord_union(+Set1, +Set2, ?Union)
  316%   ord_union(+Set1, +Set2, +Comparator, ?Union)
  317%   is true when Union is the union of Set1 and Set2.  Note that when
  318%   something occurs in both sets, we want to retain only one copy.
  319
  320ord_union(Set1, Set2, Union):-
  321	ord_union(Set1, Set2, compare, Union).
  322
  323ord_union(Set1, Set2, Comparator, Union):-
  324	foldl(Set1, 
  325		[SetA, Element, SetB]^insert(SetA, Element, Comparator, SetB), 
  326		Set2, Union).
  327
  328
  329
  330%   ord_union_and_new(+Set1, +Set2, ?Union, ?ReallyNew)
  331%   ord_union_and_new(+Set1, +Set2, +Comparator, ?Union, ?ReallyNew)
  332%   is true when Union is the union of Set1 and Set2 and ReallyNew
  333%   are those elements of Set2 that are not in Set1.  Note that when
  334%   something occurs in both sets, we want to retain only one copy.
  335
  336ord_union_and_new(Set1, Set2, Union, ReallyNew):-
  337	ord_union_and_new(Set1, Set2, compare, Union, ReallyNew).
  338
  339ord_union_and_new([], Set2, _, Set2, Set2).
  340ord_union_and_new([H1|T1], Set2, Comparator, Union, ReallyNew):-
  341	ord_union_and_new_2(Set2, H1, T1, Comparator, Union, ReallyNew).
  342
  343	ord_union_and_new_2([], H1, T1, _, [H1|T1], []).
  344	ord_union_and_new_2([H2|T2], H1, T1, Comparator, Union, ReallyNew):-
  345		call(Comparator, Order, H1, H2),
  346		ord_union_and_new_3(Order, H1, T1, H2, T2, Comparator, Union, ReallyNew).
  347
  348	ord_union_and_new_2a([], H2, T2, _, [H2|T2], [H2|T2]).
  349	ord_union_and_new_2a([H1|T1], H2, T2, Comparator, Union, ReallyNew):-
  350		call(Comparator, Order, H1, H2), 
  351		ord_union_and_new_3(Order, H1, T1, H2, T2, Comparator, Union, ReallyNew).
  352
  353	ord_union_and_new_3(<, H1, T1, H2, T2, Comparator, [H1|Union], ReallyNew):-
  354		ord_union_and_new_2a(T1, H2, T2, Comparator, Union, ReallyNew).
  355	ord_union_and_new_3(=, H1, T1, _H2, T2, Comparator, [H1|Union], ReallyNew):-
  356		ord_union_and_new(T1, T2, Comparator, Union, ReallyNew).
  357	ord_union_and_new_3(>, H1, T1, H2, T2, Comparator, [H2|Union], [H2|ReallyNew]):-
  358		ord_union_and_new_2(T2, H1, T1, Comparator, Union, ReallyNew)