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.
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.
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.
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.
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.
:- 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]
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).
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) :-
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).
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.
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])
).
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, 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])
).
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).
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.