Note: As of ECLiPSe release 5.1, the library described
in this chapter is being phased out and replaced by the new set solver
library lib(ic_sets). See the corresponding chapters in the
Library Manual and the
Reference Manual
for details.
Conjunto is a system to solve set constraints over finite set domain terms. It has been developed using the kernel of ECLiPSe based on metaterms. It contains the finite domain library of ECLiPSe. The library conjunto.pl implements constraints over set domain terms that contain herbrand terms as well as ground sets. Modules that use the library must start with the directive
:- use_module(library(conjunto))
For those who are already familiar with the ECLiPSe constraint library manual this manual follows the finite domain library structure.
For further information about this library, please email to c.gervet@icparc.ic.ac.uk.
The computation domain of Conjunto is finite so set domain and set term will stand respectively for finite set domain and finite set term in the following. Here are defined some of the terms mainly used in the predicate description.
Ground set
A known finite set containing only atoms from the Herbrand Universe or its powerset but without any variable.
A discrete lattice or powerset D attached to a set variable S. D is defined by {S ∈ 2lubs ∣ glbs ⊆ S} under inclusion specified by the notation Glbs .. Lubs. Glbs and Lubs represent respectively the intersection and union of elements of D. Thus they are both ground sets. S is then called a set domain variable.
A specific set domain WD attached to a set variable S where each element of WD is of the form e(s,w). s is a ground set representing a possible value of the set variable and w is the weight or cost associated to this value. e.g.D would have been:WD = {e(1,50),e({1,3},20)}..{e(1,50),e({1,3},20),e(f(a),100)}.{1,{1,3}}..{1,{1,3},f(a)}.
A composition of set domain variables or ground sets together with set operator symbols which are the standard ones coming from set theory.S ::= S1 ∩ S2 ∣ S1 ∪ S2 ∣ S1 ∖ S2
Any term of the followings: (1) a ground set, (2) a set domain variable or (3) a set expression. All set built-in predicates deal with set terms thus with any of the three cases.
{
and }
, e.g.
S = {1,3,{a,g}, f(2)}
The Conjunto solver acts in a data driven way using a relation between states. The transformation performs interval reduction over the set domain bounds. The set expression domains are approximated in terms of the domains of the set variables involved. From a constraint propagation viewpoint this means that constraints over set expressions can be approximated in terms of constraints over set variables. A failure is detected in the constraint propagation phase as soon as one domain lower bound glbs is not included in its associated upper bound lubs. Once a solved form has been reached all the constraints which are not definitely solved are delayed and attached to the concerned set variables.
?Svar `::
++Glb..++Lub
attaches a domain to the set variable or to a list of set variables Svar. If Glb ⊈Lub it fails. If Svar is already a domain variable its domain will be updated according to the new domain; if Svar is instantiated it fails. Otherwise if Svar is free it becomes a set variable.
succeeds if Term is a ground set.
The value of the set term S is equal to the value of the set term S1.
The element E is an element of S. If E is ground it is added to the lower bound of the domain of S, otherwise the constraint is delayed. If E is ground and does not belong to the upper bound of S domain, it fails.
The element E does not belong to S. If E is ground it is removed from the upper bound of S, otherwise the constraint is delayed. If E is ground and belongs to the upper bound of the domain of S, it is removed from the upper bound and the constraint is solved. If E is ground and belongs to the lower bound of S domain, it fails.
The value of the set term S is a subset of the value of the set term S1. If the two terms are ground sets it just checks the inclusion and succeeds or fails. If the lower bound of the domain of S is not included in the upper bound of S1 domain, it fails. Otherwise it checks the inclusion over the bounds. The constraint is then delayed.
The domains of S and S1 are disjoint (intersection empty).
Lsets is a list of set variables or ground sets. S is a set term which is the union of all these sets. If S is a free variable, it becomes a set variable and its attached domain is defined from the union of the domains or ground sets in Lsets.
Lsets is a list of set variables of ground sets. All the sets are pairwise disjoint.
S is a set term and C its cardinality. C can be a free variable, a finite domain variable or an integer. If C is free, this predicate is a mean to access the set cardinality and attach it to C. If not, the cardinality of S is constrained to be C.
S is a set variable whose domain is a weighted domain. W is the weight of S. If W is a free variable, this predicate is a mean to access the set weight and attach it to W. If not, the weight of S is constrained to be W. e.g.S `:: {e(2,3)}..{e(2,3), e(1,4)}, sum_weight(S, W)returns W :: 3..7.
If Svar is a set variable, it labels Svar to its first possible domain value. If there are several instances of Svar, it creates choice points. If Svar is a ground set, nothing happens. Otherwise it fails.
First we give a very simple example to demonstrate the expressiveness of set constraints and the propagation mechanism.
:- use_module(library(conjunto)). [eclipse 2]: Car `:: {renault} .. {renault, bmw, mercedes, peugeot}, Type_french = {renault, peugeot} , Choice `= Car /\ Type_french. Choice = Choice{{renault} .. {peugeot, renault}} Car = Car{{renault} .. {bmw, mercedes, peugeot, renault}} Type_french = {peugeot, renault} Delayed goals: inter_s({peugeot, renault}, Car{{renault}..{bmw, mercedes, peugeot, renault}}, Choice{{renault} .. {peugeot, renault}}) yes.
If now we add one cardinality constraint:
[eclipse 3]: Car `:: {renault} .. {renault, bmw, mercedes, peugeot}, Type_french = {renault, peugeot} , Choice `= Car /\ Type_french, #(Choice, 2). Car = Car{{peugeot, renault} .. {bmw, mercedes, peugeot, renault}} Type_french = {peugeot, renault} Choice = {peugeot, renault} yes.
The first example gives a set of cars from which we know
renault
belongs to. The other labels
{renault, bmw, mercedes, peugeot}
are possible elements of this set. The
Type_french
set is ground and
Choice
is the set term resulting from the intersection of the
first two sets. The first execution tells us that
renault
is element of Choice
and peugeot
might be
one. The intersection constraint is partially satisfied and might be
reconsidered if one of the domain of the set terms involved changes.
The cosntraint is delayed.
In the second example an additional constraint restricts the cardinality of
Choice
to 2. Satisfying this constraint implies setting the
Choice
set to {peugeot, renault}
. The domain of this
set has been modified so is the intersection constraint activated and
solved again. The final result adds peugeot
to the Car
set variable. The intersection constraint is now satisfied and removed
from the constraint store.
A more elaborate example is a small decision problem. We are given a finite weighted set and a target t ∈ N. We ask whether there is a subset s′ of S whose weight is t. This also corresponds to having a single weighted set domain and to look for its value such that its weight is t.
This problem is NP-complete. It is approximated in Integer Programming using a procedure which "trims" a list according to a given parameter. For example, the set variable
S `:: {}..{e(a,104), e(b,102), e(c,201) ,e(d,101)}
is approximated by the set variable
S' `:: {}..{e(c,201) ,e(d, 101)}
if the parameter delta is 0.04 (0.04 = 0.2 ÷ n where n = # S).
:- use_module(library(conjunto)). % Find the optimal solution to the subset-sum problem solve(S1, Sum) :- getset(S), S1 `:: {}.. S, trim(S, S1), constrain_weight(S1, Sum), sum_weight(S1, W), Cost = Sum - W, min_max(labeling(S1), Cost). % The set weight has to be less than Sum constrain_weight(S1, Sum) :- sum_weight(S1, W), W #<= Sum. % Get rid of a set of elements of the set according to a given delta trim(S, S1) :- set2list(S, LS), trim1(LS, S1). trim1(LS, S1) :- sort(2, =<, LS, [E | LSorted]), getdelta(D), testsubsumed(D, E, LSorted, S1). testsubsumed(_, _, [], _). testsubsumed(D, E, [F | LS], S1) :- el_weight(E, We), el_weight(F, Wf), ( We =< (1 - D) * Wf -> testsubsumed(D, F, LS, S1) ; F notin S1, testsubsumed(D, E, LS, S1) ). % Instantiation procedure labeling(Sub) :- set(Sub),!. labeling(Sub) :- max_weight(Sub, X), ( X in Sub ; X notin Sub ), labeling(Sub). % Some sample data getset(S) :- S = {e(a,104), e(b,102), e(c,201), e(d,101), e(e,305), e(f,50), e(g,70),e(h,102)}. getdelta(0.05).
The approach is is the following: first create the set domain
variable(s), here there is only one which is the set we want to find.
We state constraints which limit the weight of the set. We apply the
“trim” heuristics which removes possible elements of the set domain.
And finally we define the cost term as a finite domain used in the
min_
max/2 predicate. The cost term is an integer. The
conjunto.pl library makes sure that any modification of an fd
term involved with a set term is propagated on the set domain. The
labeling procedure refines a set domain by selecting the element of
the set domain which has the biggest weight using
max_weight(Sub, X),
and by adding it to the lower bound of the set
domain. When running the example, we get the following result:
[eclipse 3]: solve(S, 550). Found a solution with cost 44 Found a solution with cost 24 S = {e(d, 101), e(e, 305), e(f, 50), e(g, 70)} yes.
An interesting point is that in set based problems, the optimization criteria mainly concern the cardinality or the weight of a set term. So in practice we just need to label the set term while applying the fd optimization predicates upon the set cardinality or the set weight. There is no need to define additional optimization predicates.
A ternary Steiner system of order n is a set of n * (n−1) ∖ 6 triplets of distinct elements taking their values between 1 and n, such that all the pairs included in two different triplets are different.
This problem is very well dedicated to be solved using set constraints: (i) no order is required in the triplet elements and (ii) the constraint of the problem can be easily written with set constraints saying that any intersection of two set terms contains at most one element. With a finite domain approach, the list of domain variables which should be distinct requires to be given explicitely, thus the problem modelling is would be bit ad-hoc and not valid for any n.
:- use_module(library(conjunto)). % Gives one solution to the ternary steiner problem. % n has to be congruent to 1 or 3 modulo 6. steiner(N, LS) :- make_nbsets(N,NB), make_domain(N, Domain), init_sets(NB, Domain, LS), card_all(LS, 3), labeling(LS, []). labeling([], _). labeling([S | LS], L) :- refine(S), (LS = [] ; LS = [L2 | _Rest], all_distincts([S | L], L2), labeling(LS, [S | L])). % the labeled sets are distinct from the set to be labeled % this constraint is a disjonction so it is useless to put it % before the labeling as no information would be deduced anyway all_distincts([], _). all_distincts([S1 |L], L2) :- distinctsfrom(S1, L2), all_distincts(L, L2). distinctsfrom(S, S1) :- #(S /\ S1,C), fd:(C #<= 1). % creates the required number of set variables according to n make_nbsets(N,NB) :- NB is N * (N-1) // 6. % initializes the domain of the variables according to n make_domain(N, Domain) :- D :: 1.. N, dom(D, L), list2set(L, Domain). init_sets(0, _Domain, []) :- !. init_sets(NB, Domain, Sol) :- NB1 is NB-1, init_sets(NB1, Domain, Sol1), S `:: {} .. Domain, Sol = [S | Sol1]. % constrains the cardinality of each set variable to be equal to V (=3) card_all([], _V). card_all([Set1|LSets], V) :- #(Set1, V), card_all(LSets, V).
The approach with sets is the following: first we create the number of set variables required according to the initial problem definition such that each set variable is a triplet. Then to initialize the domain of these set variables we use the fd predicates which allow to define a domain by an implicit enumeration approach 1..n. This process is cleaner than enumerating a list of integer between 1 and n. Once all the domain variables are created, we constrain their cardinality to be equal to three. Then starts the labeling procedure where all the sets are labeled one after the other. Each time one set is labeled, constraints are stated between the labeled set and the next one to be labeled. This constraint states that two sets have at most one element in common. The semantics of #(S ∩ S1 ,C), C ≤ 1 is equivalent to a disjunction between set values. This implies that in the contraint propagation phase, no information can be deduced until one of the set is ground and some element has been added to the second one. No additional heuristics or tricks have been added to this simple example so it works well for n = 7, 9 but with the value 13 it becomes quite long. When running the example, we get the following result:
[eclipse 4]: steiner(7, S). 6 backtracks 0.75 S = [{1, 2, 3}, {1, 4, 5}, {1, 6, 7}, {2, 4, 6}, {2, 5, 7}, {3, 4, 7}, {3, 5, 6}] yes.
The subset-sum example shows that the general principle of solving problems using set domain constraints works just like finite domains:
subset-sum
example the
labeling only concerns a single set, but it can deal with a list of
set terms like in the steiner
example. Although the choice for the
element to be added can be done without specific criterion like in the
steiner
example, some user defined heuristics can be embedded
in the labeling procedure like in the subset-sum
example. Then
the user needs to define his own refine
procedure.
Set constraints propose a new modelling of already solved problems or allows (like for the subset-sum example) to solve new problems using CLP. Therefore, one should take into account the problem semantics in order to define the initial search space as small as possible and to make a powerful use of set constraints. The objective of this library is to bring CLP to bear on graph-theorical problems like the steiner problem which is a hypergraph computation problem, thus leading to a better specification and solving of problems as, packing and partitioning which find their application in many real life problems. A partial list includes: railroad crew scheduling, truck deliveries, airline crew scheduling, tanker-routing, information retrieval,time tabling problems, location problems, assembly line balancing, political districting,etc.
Sets seem adequate for problems where one is not interested in each element as a specific individual but in a collection of elements where no specific distinction is made and thus where symmetries among the element values need to be avoided (eg. steiner problem). They are also useful when heterogeneous constraints are involved in the problem like weight constraints combined with some disjointness constraints.
To define constraints based on set domains one needs to access the properties of a set term like its domain, its cardinality, its possible weight. As the set variable is a metaterm i.e. an abstract data structure, some built-in predicates allow the user to process the set variables and their domains, modify them and write new constraint predicates.
A set domain variable is a metaterm. The conjunto.pl library defines a metaterm attribute
set{setdom:[Glb,Lub], card:C, weight:W, del_
inst:Dinst,
del_
glb:Dglb, del_
lub:Dlub, del_
any:Dany}
This attribute stores information regarding the set domain, its cardinality, and weight (null if undefined) and together with four suspension lists. The attribute arguments have the following meaning:
_
inst A suspension list that should be woken
when the domain is reduced to a single set value.
_
glb A suspension list that should be woken when
the lower bound of the set domain is updated.
_
lub a suspension list that should be woken when
the upper bound of the set domain is updated.
_
any a suspension list that should be woken when
any reduction of the domain is inferred.
The attribute of a set domain variable can be accessed with the
predicate svar_
attribute/2 or by unification
in a matching clause:
get_attribute(_{set: Attr}, A) :- -?-> nonvar(Attr), Attr = A.
The attribute arguments can be accessed by macros from the ECLiPSestructures.pl library, if e.g. Attr is the attribute of a
set domain variable, the del_
inst list can be obtained by:
arg(del_inst of set, Attr, Dinst)
or by using a unification:
Attr = set{del_inst: Dinst}
The domains are represented as abstract data types, and the users are not supposed to access them directly. So we provide a number of predicates to allow operations on set domains.
If Svar is a set domain variable, it returns the lower and upper bounds of its domain. Otherwise it fails.
If Svar is a set domain variable, it returns the lower bound of its domain. Otherwise it fails.
If Svar is a set domain variable, it returns the upper bound of its domain. Otherwise it fails.
If E is element of a weighted domain, it returns the weight associated to E. Otherwise it fails.
If Svar is a set variable, it returns the element of its domain which belongs to the set resulting from the difference of the upper bound and the lower bound and which has the greatest weight. If Svar is a ground set, it returns the element with the biggest weight. Otherwise it fails.
Two specific predicates make a link between a ground set and a list.
If S is a ground set, it returns the corresponding list. If L is also ground it checks if it is the corresponding list. If not, or if S is not ground, it fails.
If L is a ground list, it returns the corresponding set. If S is also ground it checks if it is the corresponding set. If not, or if L is not ground, it fails.
A specific predicate operate on the set domain variables. When a set domain is reduced, some suspension lists have to be scheduled and woken depending on the bound modified.
NOTE: Their are 4 suspension lists in the conjunto.pl library, which are woken precisely when the event associated with each list occurs. For example, if the lower bound of a set variable is modified, two suspension lists will be woken: the one associated to a glb modification and the one associated to any modification. This allows user-defined constraints to be handled efficiently.
modify_
bound(Ind, ?S, ++Newbound)
Ind is a flag which should take the value lub or glb, otherwise it fails ! If S is a ground set, it succeeds if we have Newbound equal to S. If S is a set variable, its new lower or upper bound will be updated. For monotonicity reasons, domains can only get reduced. So a new upper bound has to be contained in the old one and a new lower bound has to contain the old one. Otherwise it fails.
The following example demonstrates how to create a new set constraint. To show that set inclusion is not restricted to ground herbrand terms we can take the following constraint which defines lattice inclusion over lattice domains:
S_1 incl S
Assuming that S and S1 are specific set variables of the form
S `:: {} ..{{a,b,c},{d,e,f}}, ..., S_1 `:: {} ..{{c},{d,f},{g,f}}
we would like to define such a predicate
that will be woken as soon as one or both set variables’ domains are
updated in such a way that would require updating the other variable’s
domain by propagating the constraint. This constraint definition also
shows that if one wants to iterate over a ground set (set of known
elements) the transformation to a list is convenient. In fact
iterations do not suit sets and benefit much more from a list
structure. We define the predicate incl(S,S1)
which corresponds
to this constraint:
:- use_module(library(conjunto)). incl(S,S1) :- set(S),set(S1), !, check_incl(S, S1). incl(S, S1) :- set(S), set_range(S1, Glb1, Lub1), !, check_incl(S, Lub1), S + Glb1 `= S1NewGlb, modify_bound(glb, S1, S1NewGlb). incl(S, S1) :- set(S1), set_range(S, Glb, Lub), !, check_incl(Glb, S1), large_inter(S1, Lub, SNewLub), modify_bound(lub, S, SNewLub). incl(S,S1) :- set_range(S, Glb, Lub), set_range(S1, Glb1, Lub1), check_incl(Glb, Lub1), Glb \/ Glb1 `= S1NewGlb, large_inter(Lub, Lub1, SNewLub), modify_bound(glb, S1, S1NewGlb), modify_bound(lub, S, SNewLub), ( (set(S) ; set(S1)) -> true ; make_suspension(incl(S, S1),2, Susp), insert_suspension([S,S1], Susp, del_any of set, set) ), wake. large_inter(Lub, Lub1, NewLub) :- set2list(Lub, Llub), set2list(Lub1, Llub1), largeinter(Llub, Llub1, LNewLub), list2set(LNewLub, NewLub). largeinter([], _, []). largeinter([S | List_set], Lub1, Snew) :- largeinter(List_set, Lub1, Snew1), ( contained(S, Lub1) -> Snew = [S | Snew1] ; Snew = Snew1 ). check_incl({}, _S) :-!. check_incl(Glb, Lub1) :- set2list(Glb, Lsets), set2list(Lub1, Lsets1), all_union(Lsets, Union), all_union(Lsets1, Union1), Union `< Union1,!, checkincl(Lsets,Lsets1). checkincl([], _Lsets1). checkincl([S | Lsets],Lsets1):- contained(S, Lsets1), checkincl(Lsets,Lsets1). contained(_S, []) :- fail,!. contained(S, [Ss | Lsets1]) :- (S `< Ss -> true ; contained(S, Lsets1) ).
The execution of this constraint is dynamic, i.e., the
predicate incl
/2
is called and woken following the
following steps:
set
. If so
we just check deterministically if the first one is included (lattice
inclusion) in the second one check_incl
. This
predicate checks that any element of a ground set (which is a set
itself in this case) is a subset of at least one element of the second
set. If not it fails.
check_incl
is called over the first
ground set and the upper bound of the second set. If it succeeds then
the lower bound of the set variable might not be consistent any more,
we compute the new lower bound (i.e., adding elements from the
ground set in it (by using the union predicate) and we modify the bound
modify_bound
. This predicate also wakes all concerned
suspension lists and instantiates the set variable if its domain is
reduced to a single set (upper bound = lower bound).
check_incl
is called over the lower bound of
the first set and the second ground set. If it succeeds then the upper
bound of the set variable might not be consistent any more. The new
upper bound is computed by intersecting the first set with the upper
bound of the set variable in the lattice acceptation large_inter
and
is updated modify_bound
.
check
/incl
. If it
succeeds, then if the lower bound the second set is no more consistent
we compute the new one by making the union with first sec lower bound.
In the same way, the upper bound of the first set might not be
consistent any more. If so, we compute the new one by intersecting (in
the lattice acceptation) the both upper bounds to compute the new
upper bound of the first set large_inter
. The upper bound of
the first set variable is updated as well as the lower bound of the
second set modify_bound
.
make_suspension
/3
can be used for any ECLiPSe module
based on a meta-term structure. It creates a suspension, and then the
predicate insert_suspension
/4
, puts this suspension into
the appropriate lists (woken when any bound is updated) of both set
variables.
wake
triggers the execution of all goals that are
waiting for the updates we have made. These goals should be woken
after inserting the new suspension, otherwise the new updates coming
from these woken goals won’t be propagated on this constraint !
The library conjunto.pl contains output macros which print a set variable as well as a ground set respectively as an interval of sets or a set. The setdom attribute of a set domain variable (metaterm) is printed in the simplified form of just the glb..lub interval, e.g.
[eclipse 2]: S `:: {}..{a,v,c}, svar_attribute(S,A), A = set{setdom : D}. S = S{{} .. {a, c, v}} A = {} .. {a, c, v} D = [{}, {a, c, v}] yes.
The ECLiPSe debugger which supports debugging and tracing of finite domain programs in various ways, can just be used the same way for set domain programs. No specific set domain debugger has been implemented for this release.