The library fd.pl implements constraints over finite domains that can contain integer as well as atomic (i.e. atoms, strings, floats, etc.) and ground compound (e.g. f(a, b)) elements. Modules that use the library must start with the directive
:- use_module(library(fd)).
Some of the terms frequently used in this chapter are explained below.
If Vars is already a domain variable, its domain will be updated according to the new domain; if it is instantiated, the predicate checks if the value lies in the domain. Otherwise, if Vars is a free variable, it is converted to a domain variable. If Vars is a domain variable and Domain is free, it is bound to the list of elements and integer intervals representing the domain of the variable (see also dvar_domain/2 which returns the actual domain).
When a free variable obtains a finite domain or when the domain of a domain variable is updated, the constrained list of its suspend attribute is woken, if it has one.
The logical constraints can be used to combine simpler constraints and to build complex logical constraint expressions. These constraints are preprocessed by the system and transformed into a sequence of evaluation constraints and arithmetic constraints. The logical operators are declared with the following precedences:
:- op(750, fy, #\+). :- op(760, yfx, #/\). :- op(770, yfx, #\/). :- op(780, yfx, #=>). :- op(790, yfx, #<=>).
These constraint predicates evaluate the given constraint expression and associate its truth value with a boolean variable. They can be very useful for defining more complex constraints. They can be used both to test entailment of a constraint and to impose a constraint or its negation on the current constraint store.
B isd X #= Yis equivalent to
#=(X, Y, B)
These constraints, defined in the module fd_chip, are provided for CHIP v.3 compatibility and they are defined using native ECLiPSe constraints. Their source is available in the file fd_chip.pl.
List is a list of domain variables or integers. Integers are treated as if they were variables with singleton domains.
NOTE: This predicate should not be used in ECLiPSe programs, because all intervals in the domain will be expanded into element lists which causes unnecessary space and time overhead. Unless an explicit list representation is required, finite domains should be processed by the family of the dom_* predicates in sections 2.14.2 and 2.14.3.
These constraints are defined in the module fd_util and they consist of useful predicates that are often needed in constraint programs. Their source code is available in the file fd_util.pl.
A library of different search methods for finite domain problems is available as library(fd_search). See the Reference Manual for details.
The library fd_domain.pl contains output macros which cause an fd attribute as well as a domain to be printed as lists that represent the domain values. A domain variable is an attributed variable whose fd attribute has a print handler which prints it in the same format. For instance,
[eclipse 4]: X::1..10, dvar_attribute(X, A), A = fd{domain:D}. X = X{[1..10]} D = [1..10] A = [1..10] yes. [eclipse 5]: A::1..10, printf("%mw", A). A{[1..10]} A = A{[1..10]} yes.
The ECLiPSe debugger is a low-level debugger which is suitable only to debug small constraint programs or to debug small parts of larger programs. Typically, one would use this debugger to debug user-defined constraints and Prolog data processing. When they are known to work properly, this debugger may not be helpful enough to find bugs (correctness debugging) or to speed up a working program (performance debugging). For this, the display_matrix tool from tkeclipse may be the appropriate tool.
The ECLiPSe debugger supports
debugging and tracing of finite domain programs in various ways.
First of all, the debugger commands that handle suspended
goals can be used to display suspended constraints (d, ^
,
u) or
to skip to a particular constraint (w, i).
Note that most of the constraints are displayed using a write macro,
their internal form is different.
Successive updates of a domain variable can be traced using the debug event Hd. When used, the debugger prompts for a variable name and then it skips to the port at which the domain of this variable was reduced. When a newline is typed instead of a variable name, it skips to the update of the previously entered variable.
A sequence of woken goals can be skipped using the debug event Hw.
A very simple example of using the finite domains is the send more money puzzle:
:- use_module(library(fd)). send(List) :- List = [S, E, N, D, M, O, R, Y], List :: 0..9, alldifferent(List), 1000*S+100*E+10*N+D + 1000*M+100*O+10*R+E #= 10000*M+1000*O+100*N+10*E+Y, M #\= 0, S #\= 0, labeling(List).
The problem is stated very simply, one just writes down the conditions that must hold for the involved variables and then uses the default labeling procedure, i.e. the order in which the variables will be instantiated. When executing send/1, the variables S, M and O are instantiated even before the labeling procedure starts. When a consistent value for the variable E is found (5), and this value is propagated to the other variables, all variables become instantiated and thus the rest of the labeling procedure only checks groundness of the list.
A slightly more elaborate example is the eight queens puzzle. Let us show a solution for this problem generalised to N queens and also enhanced by a cost function that evaluates every solution. The cost can be for example coli - rowi for the i-th queen. We are now looking for the solution with the smallest cost, i.e. one for which the maximum of all coli - rowi is minimal:
:- use_module(library(fd)). % Find the minimal solution for the N-queens problem cqueens(N, List) :- make_list(N, List), List :: 1..N, constrain_queens(List), make_cost(1, List, C), min_max(labeling(List), C). % Set up the constraints for the queens constrain_queens([]). constrain_queens([X|Y]) :- safe(X, Y, 1), constrain_queens(Y). safe(_, [], _). safe(X, [Y|T], K) :- noattack(X, Y, K) , K1 is K + 1 , safe(X, T, K1). % Queens in rows X and Y cannot attack each other noattack(X, Y, K) :- X #\= Y, X + K #\= Y, X - K #\= Y. % Create a list with N variables make_list(0, []) :- !. make_list(N, [_|Rest]) :- N1 is N - 1, make_list(N1, Rest). % Set up the cost expression make_cost(_, [], []). make_cost(N, [Var|L], [N-Var|Term]) :- N1 is N + 1, make_cost(N1, L, Term). labeling([]) :- !. labeling(L) :- deleteff(Var, L, Rest), indomain(Var), labeling(Rest).
The approach is similar to the previous example: first we create the domain variables, one for each column of the board, whose values will be the rows. We state constraints which must hold between every pair of queens and finally we make the cost term in the format required for the min_max/2 predicate. The labeling predicate selects the most constrained variable for instantiation using the deleteff/3 predicate. When running the example, we get the following result:
[eclipse 19]: cqueens(8, X). Found a solution with cost 5 Found a solution with cost 4 X = [5, 3, 1, 7, 2, 8, 6, 4] yes.
The time needed to find the minimal solution is about five times shorter than the time to generate all solutions. This shows the advantage of the branch and bound method. Note also that the board for this ‘minimal’ solution looks very nice.
The send more money example already shows the general principle of solving problems using finite domain constraints:
The complexity of the program and the efficiency of the solving depends very much on the way these three points are performed. Quite frequently it is possible to state the same problem using different sets of variables with different domains. A guideline is that the search space should be as small as possible, and thus e.g. five variables with domain 1..10 (i.e. search space size is 105) are likely to be better than twenty variables with domain 0..1 (space size 220).
The choice of constraints is also very important. Sometimes a redundant constraint, i.e. one that follows from the other constraints, can speed up the search considerably. This is because the system does not propagate all information it has to all concerned variables, because most of the time this would not bring anything, and thus it would slow down the search. Another reason is that the library performs no meta-level reasoning on constraints themselves (unlike the CHR library). For example, the constraints
X + Y #= 10, X + Y + Z #= 14
allow only the value 4 for Z, however the system is not able to deduce this and thus it has to be provided as a redundant constraint.
The constraints should be stated in such a way that allows the system to propagate all important domain updates to the appropriate variables.
Another rule of thumb is that creation of choice points should be delayed as long as possible. Disjunctive constraints, if there are any, should be postponed as much as possible. Labeling, i.e. value choosing, should be done after all deterministic operations are carried out.
The choice of the labeling procedure is perhaps the most sensitive one. It is quite common that only a very minor change in the order of instantiated variables can speed up or slow down the search by several orders of magnitude. There are very few common rules available. If the search space is large, it usually pays off to spend more time in selecting the next variable to instantiate. The provided predicates deleteff/3 and deleteffc/3 can be used to select the most constrained variable, but in many problems it is possible to extract even more information about which variable to instantiate next.
Often it is necessary to try out several approaches and see how they work, if they do. The profiler and the statistics package can be of a great help here, it can point to predicates which are executed too often, or choice points unnecessarily backtracked over.
The fd.pl library defines a set of low-level predicates which allow the user to process domain variables and their domains, modify them and write new constraint predicates.
A domain variable is a metaterm. The fd.pl library defines a metaterm attribute
fd{domain:D, min:Mi, max:Ma, any:A}
which stores the domain information together with several suspension lists. The attribute arguments have the following meaning:
The suspension list names can be used in the predicate suspend/3 to denote an appropriate waking condition.
The attribute of a domain variable can be accessed with the predicate dvar_attribute/2 or by unification in a matching clause:
get_attribute(_{fd:Attr}, A) :- -?-> Attr = A.
Note however, that this matching clause succeeds even if the first argument is a metaterm but its fd attribute is empty. To succeed only for domain variables, the clause must be
get_attribute(_{fd:Attr}, A) :- -?-> nonvar(Attr), Attr = A.
or to access directly attribute arguments, e.g. the domain
get_domain(_{fd:fd{domain:D}}, Dom) :- -?-> D = Dom.
The dvar_attribute/2 has the advantage that it returns an attribute-like structure even if its argument is already instantiated, which is quite useful when coding fd constraints.
The attribute arguments can be accessed by macros from the structures.pl library, if e.g. Attr is the attribute of a domain variable, the max list can be obtained as
arg(max of fd, Attr, Max)
or, using a unification
Attr = fd{max:Max}
The domains are represented as abstract data types, the users are not supposed to access them directly, instead a number of predicates and macros are available to allow operations on domains.
The following predicates operate on domains alone, without modifying domain variables. Most of them return the size of the resulting domain which can be used to test if any modification was done.
The following predicates perform various operations:
When the domain of a domain variable is reduced, some suspension lists stored in the attribute have to be scheduled and woken.
NOTE: In the fd.pl library the suspension lists are woken precisely when the event associated with the list occurs. Thus e.g. the min list is woken if and only if the minimum value of the variable’s domain is changed, but it is not woken when the variable is instantiated to this minimum or when another element from the domain is removed. In this way, user-defined constraints can rely on the fact that when they are executed, the domain was updated in the expected way. On the other hand, user-defined constraints should also comply with this rule and they should take care not to wake lists when their waking condition did not occur. Most predicates in this section actually do all the work themselves so that the user predicates may ignore scheduling and waking completely.
The fd.pl library can be used as a basis for further extensions. There are several hooks that make the interfacing easier:
default_domain(Var) :- Var :: -10000000..10000000.
It is possible to change default domains by redefining this predicate in the fd module.
We will demonstrate creation of new constraints on the following example. To show that the constraints are not restricted to linear terms, we can take the constraint
X2 + Y2 ≤ C.
Assuming that X and Y are domain variables, we would like to define such a predicate that will be woken as soon as one or both variables’ domains are updated in such a way that would require updating the other variable’s domain, i.e. updates that would propagate via this constraint. For simplicity we assume that X and Y are nonnegative. We will define the predicate sq(X, Y, C) which will implement this constraint:
:- use_module(library(fd)). % A*A + B*B <= C sq(A, B, C) :- dvar_domain(A, DomA), dvar_domain(B, DomB), dom_range(DomA, MinA, MaxA), dom_range(DomB, MinB, MaxB), MiA2 is MinA*MinA, MaB2 is MaxB*MaxB, (MiA2 + MaB2 > C -> NewMaxB is fix(sqrt(C - MiA2)), dvar_remove_greater(B, NewMaxB) ; NewMaxB = MaxB ), MaA2 is MaxA*MaxA, MiB2 is MinB*MinB, (MaA2 + MiB2 > C -> NewMaxA is fix(sqrt(C - MiB2)), dvar_remove_greater(A, NewMaxA) ; NewMaxA = MaxA ), (NewMaxA*NewMaxA + NewMaxB*NewMaxB =< C -> true ; suspend(sq(A, B, C), 3, (A, B)->min) ), wake. % Trigger the propagation
The steps to be executed when this constraint becomes active, i.e. when the predicate sq/3 is called or woken are the following:
Here is what we get:
[eclipse 20]: [X,Y]::1..10, sq(X, Y, 50). X = X{[1..7]} Y = Y{[1..7]} Delayed goals: sq(X{[1..7]}, Y{[1..7]}, 50) yes. [eclipse 21]: [X,Y]::1..10, sq(X, Y, 50), X #> 5. Y = Y{[1..3]} X = X{[6, 7]} Delayed goals: sq(X{[6, 7]}, Y{[1..3]}, 50) yes. [eclipse 22]: [X,Y]::1..10, sq(X, Y, 50), X #> 5, Y #> 1. X = 6 Y = Y{[2, 3]} yes. [eclipse 23]: [X,Y]::1..10, sq(X, Y, 50), X #> 5, Y #> 2. X = 6 Y = 3 yes.
In this section we present some FD programs that show various aspects of the library usage.
The finite domain library gives the user the possibility to impose constraints on the value of a variable. How, in general, is it possible to impose constraints on two or more variables? For example, let us assume that we have a set of colours and we want to define that some colours fit with each other and others do not. This should work in such a way as to propagate possible changes in the domains as soon as this becomes possible.
Let us assume we have a symmetric relation that defines which colours fit with each other:
% The basic relation fit(yellow, blue). fit(yellow, red). fit(blue, yellow). fit(red, yellow). fit(green, orange). fit(orange, green).
The predicate nice_pair(X, Y) is a constraint and any change of the possible values of X or Y is propagated to the other variable. There are many ways in which this pairing can be defined in ECLiPSe. They are different solutions with different properties, but they yield the same results.
We use more or less directly the low-level primitives to handle finite domain variables. We collect all consistent values for the two variables, remove all other values from their domains and then suspend the predicate until one of its arguments is updated:
nice_pair(A, B) :- % get the domains of both variables dvar_domain(A, DA), dvar_domain(B, DB), % make a list of respective matching colours setof(Y, X^(dom_member(X, DA), fit(X, Y)), BL), setof(X, Y^(dom_member(Y, DB), fit(X, Y)), AL), % convert the lists to domains sorted_list_to_dom(AL, DA1), sorted_list_to_dom(BL, DB1), % intersect the lists with the original domains dom_intersection(DA, DA1, DA_New, _), dom_intersection(DB, DB1, DB_New, _), % and impose the result on the variables dvar_update(A, DA_New), dvar_update(B, DB_New), % unless one variable is already instantiated, suspend % and wake as soon as any element of the domain is removed (var(A), var(B) -> suspend(nice_pair(A, B), 2, [A,B]->any) ; true ). % Declare the domains colour(A) :- findall(X, fit(X, _), L), A :: L.
After defining the domains, we can state the constraints:
[eclipse 5]: colour([A,B,C]), nice_pair(A, B), nice_pair(B, C), A #\= green. B = B{[blue, green, red, yellow]} C = C{[blue, orange, red, yellow]} A = A{[blue, orange, red, yellow]} Delayed goals: nice_pair(A{[blue, orange, red, yellow]}, B{[blue, green, red, yellow]}) nice_pair(B{[blue, green, red, yellow]}, C{[blue, orange, red, yellow]})
This way of defining new constraints is often the most efficient one, but usually also the most tedious one.
In this case we use the available primitive in the fd library. Whenever it is necessary to associate a fd variable with some other fd variable, the element/3 constraint is a likely candidate. Sometimes it is rather awkward to use, because additional variables must be used, but it gives enough power:
nice_pair(A, B) :- element(I, [yellow, yellow, blue, red, green, orange], A), element(I, [blue, red, yellow, yellow, orange, green], B).
We define a new variable I which is a sort of index into the clauses of the fit predicate. The first colour list contains colours in the first argument of fit/2 and the second list contains colours from the second argument. The propagation is similar to that of the previous one.
When element/3 can be used, it is usually faster than the previous approach, because element/3 is partly implemented in C.
We can also encode directly the relations between elements in the domains of the two variables:
nice_pair(A, B) :- np(A, B), np(B, A). np(A, B) :- [A,B] :: [yellow, blue, red, orange, green], A #= yellow #=> B :: [blue, red], A #= blue #=> B #= yellow, A #= red #=> B #= yellow, A #= green #=> B #= orange, A #= orange #=> B #= green.
This method is quite simple and does not need any special analysis; on the other hand it potentially creates a huge number of auxiliary constraints and variables.
Propia is the first candidate to convert an existing relation into a constraint. One can simply use infers most to achieve the propagation:
nice_pair(A, B) :- fit(A, B) infers most.
Using Propia is usually very easy and the programs are short and readable, so that this style of constraints writing is quite useful e.g. for teaching. It is not as efficient as with user-defined constraints, but if the amount of propagation is more important that the efficiency of the constraint itself, it can yield good results, too.
The domain solver in CHR can be used directly with the element/3 constraint as well, however it is also possible to define directly domains consisting of pairs:
:- lib(chr). :- chr(lib(domain)). nice_pair(A, B) :- setof(X-Y, fit(X, Y), L), A-B :: L.
The pairs are then constrained accordingly:
[eclipse 2]: nice_pair(A, B), nice_pair(B, C), A ne orange. B = B C = C A = A Constraints: (9) A_g1484 - B_g1516 :: [blue - yellow, green - orange, red - yellow, yellow - blue, yellow - red] (10) A_g1484 :: [blue, green, red, yellow] (12) B_g1516 - C_g3730 :: [blue - yellow, orange - green, red - yellow, yellow - blue, yellow - red] (13) B_g1516 :: [blue, orange, red, yellow] (14) C_g3730 :: [blue, green, red, yellow]
Various kinds of puzzles can be easily solved using finite domains. We show here the classical Lewis Carrol’s puzzle with five houses and a zebra:
Five men with different nationalities live in the first five houses of a street. They practise five distinct professions, and each of them has a favourite animal and a favourite drink, all of them different. The five houses are painted in different colours. The Englishman lives in a red house. The Spaniard owns a dog. The Japanese is a painter. The Italian drinks tea. The Norwegian lives in the first house on the left. The owner of the green house drinks coffee. The green house is on the right of the white one. The sculptor breeds snails. The diplomat lives in the yellow house. Milk is drunk in the middle house. The Norwegian's house is next to the blue one. The violinist drinks fruit juice. The fox is in a house next to that of the doctor. The horse is in a house next to that of the diplomat. Who owns a Zebra, and who drinks water?
One may be tempted to define five variables Nationality, Profession, Colour, etc. with atomic domains to represent the problem. Then, however, it is quite difficult to express equalities over these different domains. A much simpler solution is to define 5x5 integer variables for each mentioned item, to number the houses from one to five and to represent the fact that e.g. Italian drinks tea by equating Italian = Tea. The value of both variables represents then the number of their house. In this way, no special constraints are needed and the problem is very easily described:
:- lib(fd). zebra([zebra(Zebra), water(Water)]) :- Sol = [Nat, Color, Profession, Pet, Drink], Nat = [English, Spaniard, Japanese, Italian, Norwegian], Color = [Red, Green, White, Yellow, Blue], Profession = [Painter, Sculptor, Diplomat, Violinist, Doctor], Pet = [Dog, Snails, Fox, Horse, Zebra], Drink = [Tea, Coffee, Milk, Juice, Water], % we specify the domains and the fact % that the values are exclusive Nat :: 1..5, Color :: 1..5, Profession :: 1..5, Pet :: 1..5, Drink :: 1..5, alldifferent(Nat), alldifferent(Color), alldifferent(Profession), alldifferent(Pet), alldifferent(Drink), % and here follow the actual constraints English = Red, Spaniard = Dog, Japanese = Painter, Italian = Tea, Norwegian = 1, Green = Coffee, Green #= White + 1, Sculptor = Snails, Diplomat = Yellow, Milk = 3, Dist1 #= Norwegian - Blue, Dist1 :: [-1, 1], Violinist = Juice, Dist2 #= Fox - Doctor, Dist2 :: [-1, 1], Dist3 #= Horse - Diplomat, Dist3 :: [-1, 1], flatten(Sol, List), labeling(List).
In this type of problems the goal is to pack a certain amount of different things into the minimal number of bins under specific constraints. Let us solve an example given by Andre Vellino in the Usenet group comp.lang.prolog, June 93:
glass, plastic, steel, wood, copper
red, blue, green
wood requires plastic
To solve this problem, it is not enough to state constraints on some variables and to start a labeling procedure on them. The variables are namely not known, because we don’t know how many bins we should take. One possibility would be to take a large enough number of bins and to try to find a minimum number. However, usually it is better to generate constraints for an increasing fixed number of bins until a solution is found.
The predicate solve/1 returns the solution for this particular problem, solve_bin/2 is the general predicate that takes an amount of components packed into a cont/5 structure and it returns the solution.
solve(Bins) :- solve_bin(cont(1, 2, 1, 3, 2), Bins).
solve_bin/2 computes the sum of all components which is necessary as a limit value for various domains, calls bins/4 to generate a list Bins with an increasing number of elements and finally it labels all variables in the list:
solve_bin(Demand, Bins) :- Demand = cont(G, P, S, W, C), Sum is G + P + S + W + C, bins(Demand, Sum, [Sum, Sum, Sum, Sum, Sum, Sum], Bins), label(Bins).
The predicate to generate a list of bins with appropriate constraints works as follows: first it tries to match the amount of remaining components with zero and the list with nil. If this fails, a new bin represented by a list
[Colour, Glass, Plastic, Steel, Wood, Copper]
is added to the bin list, appropriate constraints are imposed on all the new bin’s variables, its contents is subtracted from the remaining number of components, and the predicate calls itself recursively:
bins(cont(0, 0, 0, 0, 0), 0, _, []). bins(cont(G0, P0, S0, W0, C0), Sum0, LastBin, [Bin|Bins]) :- Bin = [_Col, G, P, S, W, C], bin(Bin, Sum), G2 #= G0 - G, P2 #= P0 - P, S2 #= S0 - S, W2 #= W0 - W, C2 #= C0 - C, Sum2 #= Sum0 - Sum, ordering(Bin, LastBin), bins(cont(G2, P2, S2, W2, C2), Sum2, Bin, Bins).
The ordering/2 constraints are strictly necessary because this problem has a huge number of symmetric solutions.
The constraints imposed on a single bin correspond exactly to the problem statement:
bin([Col, G, P, S, W, C], Sum) :- Col :: [red, blue, green], [Capacity, G, P, S, W, C] :: 0..4, G + P + S + W + C #= Sum, Sum #> 0, % no empty bins Sum #<= Capacity, capacity(Col, Capacity), contents(Col, G, P, S, W, C), requires(W, P), exclusive(G, C), exclusive(C, P), at_most(1, red, Col, W), at_most(2, green, Col, W).
We will code all of the special constraints with the maximum amount of propagation to show how this can be achieved. In most programs, however, it is not necessary to propagate all values everywhere which simplifies the code quite considerably. Often it is also possible to use some of the built-in symbolic constraints of ECLiPSe, e.g. element/3 or atmost/3.
capacity(Color, Capacity) should instantiate the capacity if the colour is known, and reduce the colour values if the capacity is known to be greater than some values. If we use evaluation constraints, we can code the constraint directly, using equivalences:
capacity(Color, Capacity) :- Color #= blue #<=> Capacity #= 1, Color #= green #<=> Capacity #= 4, Color #= red #<=> Capacity #= 3.
A more efficient code would take into account the ordering on the capacities. Concretely, if the capacity is greater than 1, the colour cannot be blue and if it is greater than 3, it must be green:
capacity(Color, Capacity) :- var(Color), !, dvar_domain(Capacity, DC), dom_range(DC, MinC, _), (MinC > 1 -> Color #\= blue, (MinC > 3 -> Color = green ; suspend(capacity(Color, Capacity), 3, (Color, Capacity)->inst) ) ; suspend(capacity(Color, Capacity), 3, [Color->inst, Capacity->min]) ). capacity(blue, 1). capacity(green, 4). capacity(red, 3).
Note that when suspended, the predicate waits for colour instantiation or for minimum of the capacity to be updated (except that 3 is one less than the maximum capacity and thus waiting for its instantiation is equivalent).
The containment constraints are stated as logical expressions and this is also the easiest way to medel them. The important point to remember is that a condition like red can contain glass, wood, copper actually means red cannot contain plastic or steel which can be written as
contents(Col, G, P, S, W, _) :- Col #= red #=> P #= 0 #/\ S #= 0, Col #= blue #=> P #= 0 #/\ W #= 0, Col #= green #=> G #= 0 #/\ S #= 0.
If we want to model the containment with low-level domain predicates, it is easier to state them in the equivalent conjugate form:
or in a further equivalent form that uses at most one bin colour:
contents(Col, G, P, S, W, _) :- not_contained_in(Col, G, green), contained_in(Col, P, green), contained_in(Col, S, blue), not_contained_in(Col, W, blue).
contained_in(Color, Component, In) states that if Color is different from In, there can be no such component in it, i.e. Component is zero:
contained_in(Col, Comp, In) :- nonvar(Col), !, (Col \== In -> Comp = 0 ; true ). contained_in(Col, Comp, In) :- dvar_domain(Comp, DM), dom_range(DM, MinD, _), (MinD > 0 -> Col = In ; suspend(contained_in(Col, Comp, In), 2, [Comp->min, Col->inst]) ).
not_contained_in(Color, Component, In) states that if the bin is of the given colour, the component cannot be contained in it:
not_contained_in(Col, Comp, In) :- nonvar(Col), !, (Col == In -> Comp = 0 ; true ). not_contained_in(Col, Comp, In) :- dvar_domain(Comp, DM), dom_range(DM, MinD, _), (MinD > 0 -> Col #\= In ; suspend(not_contained_in(Col, Comp, In), 2, [Comp->min, Col->any]) ).
As you can see again, modeling with the low-level domain predicates might give a faster and more precise programs, but it is much more difficult than using constraint expressions and evaluation constraints. A good approach is thus to start with constraint expressions and only if they are not efficient enough, to (stepwise) recode some or all constraints with the low-level predicates.
The constraint ‘A requires B’ is written as
requires(A, B) :- A #> 0 #=> B #> 0.
With low-level predicates, the constraint ‘A requires B’ is woken as soon as some A is present or B is known:
requires(A, B) :- nonvar(B), !, ( B = 0 -> A = 0 ; true ). requires(A, B) :- dvar_domain(A, DA), dom_range(DA, MinA, _), ( MinA > 0 -> B #> 0 ; suspend(requires(A, B), 2, [A->min, B->inst]) ).
The exclusive constraint can be written as
exclusive(A, B) :- A #> 0 #=> B #= 0, B #> 0 #=> A #= 0.
however a simple form with one disjunction is enough:
exclusive(A, B) :- A #= 0 #\/ B #= 0.
With low-level domain predicates, the exclusive constraint defines a suspension which is woken as soon as one of the two components is present:
exclusive(A, B) :- dvar_domain(A, DA), dom_range(DA, MinA, MaxA), ( MinA > 0 -> B = 0 ; MaxA = 0 -> % A == 0 true ; dvar_domain(B, DB), dom_range(DB, MinB, MaxB), ( MinB > 0 -> A = 0 ; MaxB = 0 -> % B == 0 true ; suspend(exclusive(A, B), 3, (A,B)->min) ) ).
at_most(N, In, Colour, Components) states that if Colour is equal to In, then there can be at most N Components and vice versa, if there are more than N Components, the colour cannot be In. With constraint expressions, this can be simply coded as
at_most(N, In, Col, Comp) :- Col #= In #=> Comp #<= N.
A low-level solution looks as follows:
at_most(N, In, Col, Comp) :- nonvar(Col), !, (In = Col -> Comp #<= N ; true ). at_most(N, In, Col, Comp) :- dvar_domain(Comp, DM), dom_range(DM, MinM, _), (MinM > N -> Col #\= In ; suspend(at_most(N, In, Col, Comp), 2, [In->inst, Comp->min]) ).
To filter out symmetric solutions we can e.g. impose a lexicographic ordering on the bins in the list, i.e. the second bin must be lexicographically greater or equal than the first one etc. As long as the corresponding most significant variables in two consecutive bins are not instantiated, we cannot constrain the following ones and thus we suspend the ordering on the inst lists:
ordering([], []). ordering([Val1|Bin1], [Val2|Bin2]) :- Val1 #<= Val2, (integer(Val1) -> (integer(Val2) -> (Val1 = Val2 -> ordering(Bin1, Bin2) ; true ) ; suspend(ordering([Val1|Bin1], [Val2|Bin2]), 2, Val2->inst) ) ; suspend(ordering([Val1|Bin1], [Val2|Bin2]), 2, Val1->inst) ).
There is a problem with the representation of the colour:
If the colour is represented by an atom, we cannot apply
the #<=
/2 predicate on it.
To keep the ordering predicate simple and still have a symbolic
representation of the colour in the program, we can define
input macros that transform the colour atoms into integers:
:- define_macro(no_macro_expansion(blue)/0, tr_col/2, []). :- define_macro(no_macro_expansion(green)/0, tr_col/2, []). :- define_macro(no_macro_expansion(red)/0, tr_col/2, []). tr_col(no_macro_expansion(red), 1). tr_col(no_macro_expansion(green), 2). tr_col(no_macro_expansion(blue), 3).
A straightforward labeling would be to flatten the list with the bins and use e.g. deleteff/3 to label a variable out of it. However, for this example not all variables have the same importance — the colour variables propagate much more data when instantiated. Therefore, we first filter out the colours and label them before all the component variables:
label(Bins) :- colours(Bins, Colors, Things), flatten(Things, List), labeleff(Colors), labeleff(List). colours([], [], []). colours([[Col|Rest]|Bins], [Col|Cols], [Rest|Things]) :- colours(Bins, Cols, Things). labeleff([]). labeleff(L) :- deleteff(V, L, Rest), indomain(V), labeleff(Rest).
Note also that we need a special version of flatten/3 that works with nonground lists.