Simple Prolog setof - prolog

this is simple yet cannot seem to grasp it
I have these "colors"
color(blue).
color(red).
color(white).
using setof I need to get all possible combinations of these colors in a list
It would be great if you can provide a brief explanation. I tried this query
setof(X,color(X),Colors). which failed obviously
Thanks


I suppose you meant this with combinations:
?- setof((X,Y), (color(X), color(Y)), ColorsCombined).
ColorsCombined = [ (blue, blue), (blue, green), (blue, red), (green, blue), (green, green), (green, red), (red, blue), (red, green), (..., ...)].
Or did you mean the superset?
subset([Element|Set], [Element|Subset]):- subset(Set, Subset).
subset([_|Set], Subset):- subset(Set, Subset).
subset([], []).
superset(Set, Superset) :- setof(Subset, subset(Set, Subset), Superset).
This is the output:
?- superset([1,2,3], Superset).
Superset = [[], [1], [1, 2], [1, 2, 3], [1, 3], [2], [2, 3], [3]].


You mean like this ?
all_permutations(Permutations) :-
% get all colors into a list
setof(Color, color(Color), One_Color_List),
% find all combinations using permutation/2 on One_Color_List
setof(Permutation,
permutation(One_Color_List, Permutation),
Permutations).
Results:
?- all_permutations(X).
X = [[blue, red, white], [blue, white, red], [red, blue, white], [red, white, blue], [white, blue, red], [white, red, blue]].
The trick is to get the facts into a list - as you did, then use permutation/2 to generate all permutations of that list.
If that's what you wanted.. wasn't clear...

Related

Prolog: Finding all possible permutations of a list of elements with only two states

I am trying to instantiate multiple lists in Prolog of elements with only two states, the states being red and blue. Initially, I instantiate a list of elements that are only blue by creating a list of size n:
generate_list(0, []) :- !.
generate_list(N, [H | T]) :-
N2 is N-1,
H = blue,
generate_list(N2, T).
I have also defined a predicate to change the state of colors
flip(blue, red).
flip(red, blue).
I would like to use this predicate to change the color during the instantiation of a new list, however I am stuck on how to approach this problem. The default permutation and combination predicate requires you use separate predefined elements to instantiate the new list, however I have a list of elements already generated.

It's not clear from your question what you mean by "changing" the color "during the instantiation". It would be great if you could update it with a concrete example of what you want.
However, here is something that may or may not go into the direction of what you want:
color(red).
color(blue).
colorlist([]).
colorlist([C|Cs]) :-
color(C),
colorlist(Cs).
The definition of colorlist/2 says that its argument is a list, with elements satisfying color/1. Either color is fine, so any list of any permutation of elements from red and blue is a solution. We can use this already to check color lists:
?- colorlist([red, blue, blue]).
true.
And also to try to enumerate them, although the enumeration is not fair, i.e., some things that are solutions (in this case, any list containing blue) will never be generated:
?- colorlist(Cs).
Cs = [] ;
Cs = [red] ;
Cs = [red, red] ;
Cs = [red, red, red] ;
Cs = [red, red, red, red] ;
Cs = [red, red, red, red, red] . % etc.
To solve the fairness problem, we can enumerate by length: First all the length-0 lists, then all the length-1 lists, all the length-2 ones, etc. If we expose the length as a parameter, we get something that at least has the same interface as the predicate you are trying to write:
length_colorlist(N, Cs) :-
length(Cs, N),
colorlist(Cs).
This can enumerate solutions fairly and generally:
?- length_colorlist(N, Cs).
N = 0,
Cs = [] ;
N = 1,
Cs = [red] ;
N = 1,
Cs = [blue] ;
N = 2,
Cs = [red, red] ;
N = 2,
Cs = [red, blue] ;
N = 2,
Cs = [blue, red] .
And also answer more specific queries restricted by length:
?- length_colorlist(8, Cs).
Cs = [red, red, red, red, red, red, red, red] ;
Cs = [red, red, red, red, red, red, red, blue] ;
Cs = [red, red, red, red, red, red, blue, red] ;
Cs = [red, red, red, red, red, red, blue, blue] ;
Cs = [red, red, red, red, red, blue, red, red] ;
Cs = [red, red, red, red, red, blue, red, blue] ;
Cs = [red, red, red, red, red, blue, blue, red] ;
Cs = [red, red, red, red, red, blue, blue, blue] ;
Cs = [red, red, red, red, blue, red, red, red] ;
Cs = [red, red, red, red, blue, red, red, blue] .
Note: No cuts needed, and the final definition is built up as a simple composition of more generic, individually useful parts. When stuck on a problem, especially in Prolog, always try to solve individual subparts first. In this case, "how do I define lists (of any length) containing colors?" and "how do I generate lists of specific lengths?" are two distinct subproblems that are best solved separately.

How to check the repeatable variables in a list in prolog

I'm working on this Prolog question where I have to design a program that creates a grid of wizard hats of 4 different colours (blue, red, green, and yellow) where each hat has one of 4 different letters (w, x, y, and z). The hats have to be arranged in such a way that no row or column has two hats with the same colour or hats with the same letter in them.
I have to write a predicate validRow that is true if a row is valid, i.e., if no two hats have the same color or the same letter.
ex:
?- validRow([(1, 1, red, w), (1, 2, green, x), (1, 3, yellow, y), (1, 4, blue, z)]).
true.
This is my code so far
validRow([(R,C1,Colour1,Letter1), (R,C2,Colour2,Letter2),(R,C3,Colour3,Letter3), (R,C4,Colour4,Letter4)]) :-
isValid([Colour1,Colour2,Colour3,Colour4], [Letter1,Letter2,Letter3,Letter4]).
isValid([HC|TC],[HL|TL]) :-
not(member(HC,TC)),
not(member(HL,TL)),
isValid(TC,TL).
This doesn't give me the correct answer. How can i fix this?

Recursion requires a base case; you have not specified one for isValid.

Mastermind in Prolog - backtracking

EDIT 2:
I solved it using list in list. Thanks for help.
I try to make Mastermind in Prolog. I have a function
guess(Colors, Size, Possibilities, Answer, Black, White)
which takes count of used colors, size of game field, list of colors and user evaluation of answer. It may looks like:
guess(4, 6, P, [red, red, blue, green, green, yellow], 2, 3)
which means there are 4 colors, 6 places for pegs and the guess
[red, red, blue, green, green, yellow] gets 2 black pegs and 3 white.
When I call this these functions directly like
guess(4, 6, O, [red, red, blue, green, green, yellow], 2, 3),
guess(4, 6, O, [red, yellow, green, blue, red, blue], 0, 4),
guess(4, 6, O, [green, blue, yellow, red, green, yellow], 4, 2),
guess(4, 6, O, [yellow, blue, red, yellow, green, yellow], 5, 0).
it gives me correct answer O = [green, blue, red, yellow, green, yellow]
Now I try to make it more interactive, so I created functions
play:-
write('Size: '), read(Size), nl,
write('Colors: '), read(Colors), nl,
createFirstGuess(Size, Colors, [], A), //initial guess
run(Colors, Size, _, A).
run(Colors, Size, P, A) :-
tryGuess(Colors, Size, J, A), //Possibilities in J
copy(J, X), //First possible result J -> X
J = P, //Unification of all results
run(Colors, Size, J, X). //loop
tryGuess(_, _, _, []) :- !.
tryGuess(Colors, Size, P, A) :-
write('Evaluation of: '), write(A), nl,
write('Black pegs: '), read(B), nl,
write('White pegs: '), read(W), nl,
guess(Colors, Size, P, A, B, W).
copy([],[]) :- !. //Copy list T1 to T2
copy([H|T1],[H|T2]) :- !, copy(T1,T2).
createFirstGuess(0, _, L, L) :- !. //Initial guess (just field of the same colors)
createFirstGuess(N, Colors, R, L) :-
N > 0, N1 is N - 1, color(Colors, H), createFirstGuess(N1, Colors, [H|R], L).
I run 'play', set size and count of colors a start play.
Evaluation of: [red, red, red, red, red, red] //Initial guess
Black pegs: 1.
White pegs: 0.
Evaluation of: [red, green, green, green, green, green] //OK
Black pegs: 1.
White pegs: 2.
Evaluation of: [red, green, green, green, green, blue] //Bad, it goes through the list one-by-one
Black pegs: 1.
White pegs: 2.
Evaluation of: [red, green, green, green, green, yellow] //Bad
Black pegs: 2.
White pegs: 2.
Evaluation of: [red, green, green, green, blue, green] //Bad
Black pegs: 0.
White pegs: 4.
It seems the first two answers are good (one is initial, second is computed), but the next one just goes through all possibilities one-by-one. I think there is a problem with backtracking, so there should be some cuts (!), but I am unable to find where to put them.
Thanks for any help.
EDIT:
Thank you for help.
I would like to get output like this:
Evaluation of: [red, red, red, red, red, red] //Initial guess
Black pegs: 1.
White pegs: 0.
Evaluation of: [red, green, green, green, green, green]
Black pegs: 1.
White pegs: 2.
Evaluation of: [green, red, blue, yellow, green, blue]
Black pegs: 3.
White pegs: 2.
Evaluation of: [green, blue, yellow, yellow, green, red]
Black pegs: 4.
White pegs: 2.
Evaluation of: [green, blue, red, yellow, green, yellow]
Black pegs: 6.
White pegs: 0.
End of Game
But, in my case prolog goes through the list of all possibilities one-by-one but when I use guess (as shown above) it works great. There must be a problem with unification and backtracking. At first I use initial list and get correct possible results. Then I take first of results and let player to evaluate it. This first result with player evaluation I use for next guess, but there is a problem. As I see, because of backtracking is this result (answer) reunified, so player must go through the list one-by-one, no matter the evaluation.
I think, it should work, if the answer, evaluated by player, won't be reunified, but I cannot find a way to do so.

OK, I finally solved it using lists in lists for saving Answers and evaluations. Then I just expand those lists and use it for building more precise solution.

How to model Einstein's Riddle in a Constraint Satisfaction manner (Prolog)

My IA assignment is to solve the Einstein Problem.
I must solve it using a CSP model in Prolog. I am not given the model, but only the problem and some input data. My solution must be a general one, I mean, for some input data I must offer a solution. The dimension of the problem is N, for example N may be 5(we have 5 houses), but it can vary.
Many solutions I have found on the Internet put the constrains directly in code, but I need to generate them using the input data. The problem must be solved using the MAC(Maintain Arc-Consistency) algorithm.
I have read a lot about it (Einstein's riddle). To implement the problem I need a representation of the problem.
The problem is, I don't know exactly how to represent the problem in Prolog(I know basic Prolog, haven't used additional libraries, we are not allowed to use clpfd library - the prolog clp solver).
I know I should create constraints form the input(the 14 clues) + the constrains that say all the variables from the same group(e.g. Nationality) should be different, I could implement I predicate like:
my_all_different(like all_different/1 offered by clpfd).
For example:
Attributes = ['Color', 'Nationality', 'Drink', 'Smoke', 'Pet'].
Values = [['Blue', 'Green', 'Ivory', 'Red', 'Yellow'],
['Englishman', 'Japanese', 'Norwegian', 'Spaniard', 'Ukrainian'],
['Coffee', 'Milk', 'Orange juice', 'Tea', 'Water'],
['Chesterfield', 'Kools', 'Lucky Strike', 'Old Gold', 'Parliament'],
['Dog', 'Fox', 'Horse', 'Snails', 'Zebra']
]).
Statements = 'The Englishman lives in the red house',
'The Spaniard owns the dog',
'Coffee is drunk in the green house',
'The Ukrainian drinks tea',
'The green house is immediately to the right of the ivory house',
'The Old Gold smoker owns snails',
'Kools are smoked in the yellow house',
'Milk is drunk in the middle house',
'The Norwegian lives in the first house',
'The man who smokes Chesterfield lives in the house next to the man with the fox',
'Kools are smoked in the house next to the house where the horse is kept',
'The Lucky Strike smoker drinks orange juice',
'The Japanese smokes Parliament',
'The Norwegian lives next to the blue house'
]).
Question = 'Who owns a zebra'?
Now, I managed to parse this input and obtained a list of lists:
R = [[red,englishman]
[spaniard,dog]
[green,coffee]
[ukrainian,tea]
[green,ivory,right]
[old,snails]
[yellow,kools]
[milk,middle]
[norwegian,first]
[chesterfield,fox,next]
[kools,horse,next]
[orange,lucky]
[japanese,parliament]
[blue,norwegian,next]].
Now I suppose I need to use this generated info to construct some constrains, from what I have read it would be a good idea to use binary constrains(represented as predicates I think), but I have some unary constraints too, so how should I represent constrains to include all of them?
Another problem is: how to represent the variables (where I'll have the computed data) so that I won't need to search and modify the lists(because in prolog you can't modify lists like in imperative languages).
So I thought using a list of variables, where each variable/element is represented by a 3-tuple: (var, domain, attrV), where var contains the current value of a variable, domain is a list say: [1, 2, 3, 4, .., N], and attrV is one value(of N) of the corresponding attribute(e.g. red). One element would be: (C, [1, 2, 3, 4, 5], red).
Other problems: How should I implement an MAC algorithm in prolog(uses AC-3 alorithm), because I'll have a queue of tuples and this queue will be modified if the constrains aren't met, and this means modifying the variables list, and again how should I modify the lists in Prolog.
Any help would be appreciated!
I tried to solve a particular version of the problem using the CSP solver from the link you gave above, but still I can't get to a solution,I want to obtain the solution, because in this manner, I 'll know how to represent correctly the constraints for the general version.
Added code:
% Computational Intelligence: a logical approach.
% Prolog Code.
% A CSP solver using arc consistency (Figure 4.8)
% Copyright (c) 1998, Poole, Mackworth, Goebel and Oxford University Press.
% csp(Domains, Relations) means that each variable has
% an instantiation to one of the values in its Domain
% such that all the Relations are satisfied.
% Domains represented as list of
% [dom(V,[c1,...,cn]),...]
% Relations represented as [rel([X,Y],r(X,Y)),...]
% for some r
csp(Doms,Relns) :-
write('CSP Level'), nl,
ac(Doms,Relns).
% ac(Dom,Relns) is true if the domain constrants
% specified in Dom and the binary relations
% constraints specified in Relns are satisfied.
ac(Doms,Relns) :-
make_arcs(Relns,A),
consistent(Doms,[],A,A),
write('Final Doms '), write(Doms), nl, %test
write('Final Arcs '), write(A), nl. %test
% make_arcs(Relns, Arcs) makes arcs Arcs corresponding to
% relations Relns. There are acrs for each ordering of
% variables in a relations.
make_arcs([],[]).
make_arcs([rel([X,Y],R)|O],
[rel([X,Y],R),rel([Y,X],R)|OA]) :-
make_arcs(O,OA).
% consistent(Doms,CA,TDA,A) is true if
% Doms is a set of domains
% CA is a set of consistent arcs,
% TDA is a list of arcs to do
% A is a list of all arcs
consistent(Doms,CA,TDA,A) :-
consider(Doms,RedDoms,CA,TDA),
write('Consistent Doms '), write(RedDoms), nl, %test
solutions(RedDoms,A),
write('Consistent Doms '), write(RedDoms), nl, %test
write('Consistent Arcs '), write(A), nl. %test
% consider(D0,D1,CA,TDA)
% D0 is the set of inital domains
% D1 is the set of reduced domains
% CA = consistent arcs,
% TDA = to do arcs
consider(D,D,_,[]).
consider(D0,D3,CA,[rel([X,Y],R)|TDA]) :-
choose(dom(XV,DX),D0,D1),X==XV,
% write('D0 '), write(D0),
% write('D1 '), write(D1), nl,
choose(dom(YV,DY),D1,_),Y==YV, !,
prune(X,DX,Y,DY,R,NDX),
( NDX = DX
->
consider(D0,D3,[rel([X,Y],R)|CA],TDA)
; acc_todo(X,Y,CA,CA1,TDA,TDA1),
consider([dom(X,NDX)|D1],D3,
[rel([X,Y],R)|CA1],TDA1)).
% prune(X,DX,Y,DY,R,NDX)
% variable X had domain DX
% variable Y has domain DY
% R is a relation on X and Y
% NDX = {X in DX | exists Y such that R(X,Y) is true}
prune(_,[],_,_,_,[]).
prune(X,[V|XD],Y,YD,R,XD1):-
\+ (X=V,member(Y,YD),R),!,
prune(X,XD,Y,YD,R,XD1).
prune(X,[V|XD],Y,YD,R,[V|XD1]):-
prune(X,XD,Y,YD,R,XD1).
% acc_todo(X,Y,CA,CA1,TDA,TDA1)
% given variables X and Y,
% updates consistent arcs from CA to CA1 and
% to do arcs from TDA to TDA1
acc_todo(_,_,[],[],TDA,TDA).
acc_todo(X,Y,[rel([U,V],R)|CA0],
[rel([U,V],R)|CA1],TDA0,TDA1) :-
( X \== V
; X == V,
Y == U),
acc_todo(X,Y,CA0,CA1,TDA0,TDA1).
acc_todo(X,Y,[rel([U,V],R)|CA0],
CA1,TDA0,[rel([U,V],R)|TDA1]) :-
X == V,
Y \== U,
acc_todo(X,Y,CA0,CA1,TDA0,TDA1).
% solutions(Doms,Arcs) given a reduced set of
% domains, Dome, and arcs Arcs, solves the CSP.
solutions(Doms,_) :-
solve_singletons(Doms),
write('Single Doms '), write(Doms), nl. %test
solutions(Doms,A) :-
my_select(dom(X,[XV1,XV2|XVs]),Doms,ODoms),
split([XV1,XV2|XVs],DX1,DX2),
acc_todo(X,_,A,CA,[],TDA),
( consistent([dom(X,DX1)|ODoms],CA,TDA,A)
; consistent([dom(X,DX2)|ODoms],CA,TDA,A)).
% solve_singletons(Doms) is true if Doms is a
% set of singletom domains, with the variables
% assigned to the unique values in the domain
solve_singletons([]).
solve_singletons([dom(X,[X])|Doms]) :-
solve_singletons(Doms).
% select(E,L,L1) selects the first element of
% L that matches E, with L1 being the remaining
% elements.
my_select(D,Doms,ODoms) :-
select(D,Doms,ODoms), !.
% choose(E,L,L1) chooses an element of
% L that matches E, with L1 being the remaining
% elements.
choose(D,Doms,ODoms) :-
select(D,Doms,ODoms).
% split(L,L1,L2) splits list L into two lists L1 and L2
% with the about same number of elements in each list.
split([],[],[]).
split([A],[A],[]).
split([A,B|R],[A|R1],[B|R2]) :-
split(R,R1,R2).
/* -------------------------------------------------------------------*/
cs1(V, V). %A1 = A2
cs2(V1, V2) :- (V1 is V2 - 1; V2 is V1 - 1). %next
cs3(V1, V2) :- V1 is V2 + 1. %right
zebra(English,Spaniard,Ukrainian,Norwegian,Japanese,
Red,Green,Ivory,Yellow,Blue,
Dog,Snails,Fox,Horse,Zebra,
Coffee,Tea,Milk,Orange_Juice,Water,
Old_Gold,Kools,Chesterfields,Lucky_Strike,Parliaments) :-
csp([dom(English, [1, 2, 3, 4, 5]),
dom(Spaniard, [1, 2, 3, 4, 5]),
dom(Ukrainian, [1, 2, 3, 4, 5]),
dom(Norwegian, [1, 2, 3, 4, 5]),
dom(Japanese, [1, 2, 3, 4, 5]),
dom(Red, [1, 2, 3, 4, 5]),
dom(Green, [1, 2, 3, 4, 5]),
dom(Ivory, [1, 2, 3, 4, 5]),
dom(Yellow, [1, 2, 3, 4, 5]),
dom(Blue, [1, 2, 3, 4, 5]),
dom(Dog, [1, 2, 3, 4, 5]),
dom(Snails, [1, 2, 3, 4, 5]),
dom(Fox, [1, 2, 3, 4, 5]),
dom(Horse, [1, 2, 3, 4, 5]),
dom(Zebra, [1, 2, 3, 4, 5]),
dom(Coffee, [1, 2, 3, 4, 5]),
dom(Tea, [1, 2, 3, 4, 5]),
dom(Milk, [1, 2, 3, 4, 5]),
dom(Orange_Juice, [1, 2, 3, 4, 5]),
dom(Water, [1, 2, 3, 4, 5]),
dom(Old_Gold, [1, 2, 3, 4, 5]),
dom(Kools, [1, 2, 3, 4, 5]),
dom(Chesterfields, [1, 2, 3, 4, 5]),
dom(Lucky_Strike, [1, 2, 3, 4, 5]),
dom(Parliaments, [1, 2, 3, 4, 5])],
[rel([English, Red], cs1(English,Red)),
rel([Spaniard, Dog], cs1(Spaniard,Dog)),
rel([Coffee, Green], cs1(Coffee,Green)),
rel([Ukrainian, Tea], cs1(Ukrainian,Tea)),
rel([Green, Ivory], cs3(Green,Ivory)),
rel([Old_Gold, Snails], cs1(Old_Gold,Snails)),
rel([Kools, Yellow], cs1(Kools,Yellow)),
rel([Milk, Milk], Milk = 3),
rel([Norwegian, Norwegian], Norwegian = 1), %here is the problem
rel([Chesterfields, Fox], cs2(Chesterfields,Fox)),
rel([Kools, Horse], cs2(Kools,Horse)),
rel([Lucky_Strike, Orange_juice], cs1(Lucky_Strike,Orange_juice)),
rel([Japanese, Parliaments], cs1(Japanese,Parliaments)),
rel([Norwegian, Blue], cs2(Norwegian,Blue))]).

I've done some search, then I suggest some reading about
a constraint satisfaction using arc consistency with sample data
edit again here the effort so far. Alas, adding the last constraint invalidate the result. Tomorrow I'll try to understand why
good news!! I found the stupid bug in next/2
:- include(csp).
next(V1, V2) :-
succ(V1, V2) ; succ(V2, V1).
dom(I, O, D) :-
maplist(dom, I, O),
alldiff(I, [], D).
dom(V, dom(V, [1,2,3,4,5])).
alldiff([], D, D).
alldiff([V|Vs], S, D) :-
maplist(rdiff(V), Vs, Ds),
append(S, Ds, As),
alldiff(Vs, As, D).
rdiff(A, B, D) :- rel(A \= B, D).
rel(R, rel([A, B], R)) :- R =.. [_, A, B].
zebra :-
People = [English, Spaniard, Ukrainian, Norwegian, Japanese],
Color = [Red, Green, Ivory, Yellow, Blue],
Pet = [Dog, Snails, Fox, Horse, Zebra],
Drink = [Coffee, Tea, Milk, Orange_Juice, _Water],
Smoke = [Old_Gold, Kools, Chesterfields, Lucky_Strike, Parliaments],
maplist(dom, [People, Color, Pet, Drink, Smoke], DomT, DiffPair),
flatten(DomT, Doms),
maplist(rel,
[English = Red % The Englishman lives in the red house
,Spaniard = Dog % The Spaniard owns the dog
,Ukrainian = Tea % The Ukrainian drinks tea
,Coffee = Green % Coffee is drunk in the green house
,succ(Ivory, Green) % The green house is immediately to the right of the ivory house
,Old_Gold = Snails % The Old Gold smoker owns snails
,Kools = Yellow % Kools are smoked in the yellow house
,Milk = H3 % Milk is drunk in the middle house
,Norwegian = H1 % The Norwegian lives in the first house
,next(Chesterfields, Fox) % The man who smokes Chesterfield lives in the house next to the man with the fox
,next(Kools, Horse) % Kools are smoked in the house next to the house where the horse is kept
,Lucky_Strike = Orange_Juice % The Lucky Strike smoker drinks orange juice
,Japanese = Parliaments % The Japanese smokes Parliament
,next(Norwegian, Blue) % The Norwegian lives next to the blue house
], ConstrS),
flatten([DiffPair, ConstrS], Rels),
csp([dom(H1, [1]), dom(H3, [3])|Doms], Rels),
maplist(writeln,
[people:[English, Spaniard, Ukrainian, Norwegian, Japanese],
color:[Red, Green, Ivory, Yellow, Blue],
pet:[Dog, Snails, Fox, Horse, Zebra],
drink:[Coffee, Tea, Milk, Orange_Juice, _Water],
smoke:[Old_Gold, Kools, Chesterfields, Lucky_Strike, Parliaments]
]).
I've separated csp.pl, adapted to SWI-Prolog. Here it is
% Computational Intelligence: a logical approach.
% Prolog Code.
% A CSP solver using arc consistency (Figure 4.8)
% Copyright (c) 1998, Poole, Mackworth, Goebel and Oxford University Press.
% csp(Domains, Relations) means that each variable has
% an instantiation to one of the values in its Domain
% such that all the Relations are satisfied.
% Domains represented as list of
% [dom(V,[c1,...,cn]),...]
% Relations represented as [rel([X,Y],r(X,Y)),...]
% for some r
csp(Doms,Relns) :-
ac(Doms,Relns).
% ac(Dom,Relns) is true if the domain constrants
% specified in Dom and the binary relations
% constraints specified in Relns are satisfied.
ac(Doms,Relns) :-
make_arcs(Relns,A),
consistent(Doms,[],A,A).
% make_arcs(Relns, Arcs) makes arcs Arcs corresponding to
% relations Relns. There are acrs for each ordering of
% variables in a relations.
make_arcs([],[]).
make_arcs([rel([X,Y],R)|O],
[rel([X,Y],R),rel([Y,X],R)|OA]) :-
make_arcs(O,OA).
% consistent(Doms,CA,TDA,A) is true if
% Doms is a set of domains
% CA is a set of consistent arcs,
% TDA is a list of arcs to do
% A is a list of all arcs
consistent(Doms,CA,TDA,A) :-
consider(Doms,RedDoms,CA,TDA),
solutions(RedDoms,A).
% consider(D0,D1,CA,TDA)
% D0 is the set of inital domains
% D1 is the set of reduced domains
% CA = consistent arcs,
% TDA = to do arcs
consider(D,D,_,[]).
consider(D0,D3,CA,[rel([X,Y],R)|TDA]) :-
choose(dom(XV,DX),D0,D1),X==XV,
choose(dom(YV,DY),D1,_),Y==YV, !,
prune(X,DX,Y,DY,R,NDX),
( NDX = DX
->
consider(D0,D3,[rel([X,Y],R)|CA],TDA)
; acc_todo(X,Y,CA,CA1,TDA,TDA1),
consider([dom(X,NDX)|D1],D3,
[rel([X,Y],R)|CA1],TDA1)).
% prune(X,DX,Y,DY,R,NDX)
% variable X had domain DX
% variable Y has domain DY
% R is a relation on X and Y
% NDX = {X in DX | exists Y such that R(X,Y) is true}
prune(_,[],_,_,_,[]).
prune(X,[V|XD],Y,YD,R,XD1):-
\+ (X=V,member(Y,YD),R),!,
prune(X,XD,Y,YD,R,XD1).
prune(X,[V|XD],Y,YD,R,[V|XD1]):-
prune(X,XD,Y,YD,R,XD1).
% acc_todo(X,Y,CA,CA1,TDA,TDA1)
% given variables X and Y,
% updates consistent arcs from CA to CA1 and
% to do arcs from TDA to TDA1
acc_todo(_,_,[],[],TDA,TDA).
acc_todo(X,Y,[rel([U,V],R)|CA0],
[rel([U,V],R)|CA1],TDA0,TDA1) :-
( X \== V
; X == V,
Y == U),
acc_todo(X,Y,CA0,CA1,TDA0,TDA1).
acc_todo(X,Y,[rel([U,V],R)|CA0],
CA1,TDA0,[rel([U,V],R)|TDA1]) :-
X == V,
Y \== U,
acc_todo(X,Y,CA0,CA1,TDA0,TDA1).
% solutions(Doms,Arcs) given a reduced set of
% domains, Dome, and arcs Arcs, solves the CSP.
solutions(Doms,_) :-
solve_singletons(Doms).
solutions(Doms,A) :-
select(dom(X,[XV1,XV2|XVs]),Doms,ODoms),
split([XV1,XV2|XVs],DX1,DX2),
acc_todo(X,_,A,CA,[],TDA),
( consistent([dom(X,DX1)|ODoms],CA,TDA,A)
; consistent([dom(X,DX2)|ODoms],CA,TDA,A)).
% solve_singletons(Doms) is true if Doms is a
% set of singletom domains, with the variables
% assigned to the unique values in the domain
solve_singletons([]).
solve_singletons([dom(X,[X])|Doms]) :-
solve_singletons(Doms).
:- redefine_system_predicate(select(_,_,_)).
% select(E,L,L1) selects the first element of
% L that matches E, with L1 being the remaining
% elements.
select(D,Doms,ODoms) :-
% remove(D,Doms,ODoms), !.
system:select(D,Doms,ODoms), !.
% choose(E,L,L1) chooses an element of
% L that matches E, with L1 being the remaining
% elements.
choose(D,Doms,ODoms) :-
% remove(D,Doms,ODoms).
system:select(D,Doms,ODoms).
% split(L,L1,L2) splits list L into two lists L1 and L2
% with the about same number of elements in each list.
split([],[],[]).
split([A],[A],[]).
split([A,B|R],[A|R1],[B|R2]) :-
split(R,R1,R2).
test seems good after last correction to next/2:
?- zebra.
people:[3,4,2,1,5]
color:[3,5,4,1,2]
pet:[4,3,1,2,5]
drink:[5,2,3,4,1]
smoke:[3,1,2,4,5]
true ;
false.

Solving the Zebra puzzle (aka. Einstein puzzle) using the clpfd Prolog library

I have been given an exercise to solve the zebra puzzle using a constraint solver of my choice, and I tried it using the Prolog clpfd library.
I am aware that there are other more idiomatic ways to solve this problem in Prolog, but this question is specifically about the clpfd package!
So the specific variation of the puzzle (given that there are many of them) I'm trying to solve is this one:
There are five houses
The Englishman lives in the red house
The Swedish own a dog
The Danish likes to drink tea
The green house is left to the white house
The owner of the green house drinks coffee
The person that smokes Pall Mall owns a bird
Milk is drunk in the middle house
The owner of the yellow house smokes Dunhill
The norwegian lives in the first house
The marlboro smoker lives next to the cat owner
The horse owner lives next to the person who smokes dunhill
The winfield smoker likes to drink beer
The norwegian lives next to the blue house
The german smokes rothmanns
The marlboro smoker has a neighbor who drinks water
I tried to solve it with the following approach:
Each attribute a house can have is modeled as a variable, e.g. "British",
"Dog", "Green", etc. The attributes can take values from 1 to 5, depending on the house
in which they occur, e.g. if the variable "Dog" takes the value 3, the dog lives in the
third house.
This approach makes it easy to model neighbor constraints like this:
def neighbor(X, Y) :-
(X #= Y-1) #\/ (X #= Y+1).
But somehow, the clpfd package does not yield a solution, even though (IMO) the problem is modeled correctly (I used the exact same model with the Choco constraint solver and the result was correct).
Here is the complete code:
:- use_module(library(clpfd)).
neighbor(X, Y) :-
(X #= (Y - 1)) #\/ (X #= (Y + 1)).
solve([British, Swedish, Danish, Norwegian, German], Fish) :-
Nationalities = [British, Swedish, Danish, Norwegian, German],
Colors = [Red, Green, Blue, White, Yellow],
Beverages = [Tea, Coffee, Milk, Beer, Water],
Cigarettes = [PallMall, Marlboro, Dunhill, Winfield, Rothmanns],
Pets = [Dog, Bird, Cat, Horse, Fish],
all_different(Nationalities),
all_different(Colors),
all_different(Beverages),
all_different(Cigarettes),
all_different(Pets),
Nationalities ins 1..5,
Colors ins 1..5,
Beverages ins 1..5,
Cigarettes ins 1..5,
Pets ins 1..5,
British #= Red, % Hint 1
Swedish #= Dog, % Hint 2
Danish #= Tea, % Hint 3
Green #= White - 1 , % Hint 4
Green #= Coffee, % Hint 5,
PallMall #= Bird, % Hint 6
Milk #= 3, % Hint 7
Yellow #= Dunhill, % Hint 8,
Norwegian #= 1, % Hint 9
neighbor(Marlboro, Cat), % Hint 10
neighbor(Horse, Dunhill), % Hint 11
Winfield #= Beer, % Hint 12
neighbor(Norwegian, Blue), % Hint 13
German #= Rothmanns, % Hint 14,
neighbor(Marlboro, Water). % Hint 15
Did I misunderstand a concept within clpfd, or am I simply missing something obvious here? In case it helps, here you can find the same approach implemented using Choco and Scala.
Edit: The reason why I believe that the solver isn't able to solve the problem ist that it never comes up with definite values for the variables, but only with ranges, e.g. "Fish 1..3\/5".

There are several misconceptions here: You state "the clpfd package does not yield a solution", but actually it does yield one:
?- solve(Ls, Fish), label(Ls).
Ls = [3, 5, 2, 1, 4],
Fish in 1\/4,
all_different([5, 3, _G3699, 2, Fish]),
_G3699 in 1\/4,
_G3699+1#=_G3727,
_G3741+1#=_G3699,
_G3727 in 2\/4..5,
2#=_G3727#<==>_G3766,
_G3766 in 0..1,
_G3792#\/_G3766#<==>1,
_G3792 in 0..1,
2#=_G3741#<==>_G3792,
_G3741 in 0\/2..3.
So we know that if there is a solution, then Fish is either 1 or 4. Let's try 1:
?- solve(Ls, Fish), label(Ls), Fish = 1.
false.
No. So let's try 4:
?- solve(Ls, Fish), label(Ls), Fish = 4.
Ls = [3, 5, 2, 1, 4],
Fish = 4.
This works and is a ground solution to the problem. You can get it in a different way for example by including Fish in the variables that are to be labeled:
?- solve(Ls, Fish), label([Fish|Ls]).
Ls = [3, 5, 2, 1, 4],
Fish = 4 ;
false.
The purpose of labeling is exactly to try concrete values for constrained variables, independent of whether there actually is a solution. By coincidence, all_distinct/1 is strong enough to yield a ground solution by itself in this case, but in general this is of course not the case and you must eventually use labeling to obtain an unconditional (i.e., no more pending constraints) answer. Of course you must then in general also label all variables that are of interest to you, not just a subset of them as you did initially. To label a single variable, you can use indomain/1, so appending indomain(Fish) to the first query above would also work. I could not reproduce the instantiation error you mentioned in a further comment, in fact as you see above the most general query solve(X, Y) works with the code you posted. Finally, check this out:
neighbor(X, Y) :- abs(X-Y) #= 1.

running your code in SWI-Prolog, I get
?- solve(X),label(X).
X = [3, 5, 2, 1, 4].
Without label:
?- solve(X).
X = [3, _G3351, _G3354, 1, _G3360],
_G3351 in 4..5,
all_different([_G3351, _G3386, _G3389, 2, _G3395]),
all_different([3, _G3351, _G3354, 1, _G3360]),
_G3386 in 3..5,
all_different([_G3386, _G3444, 1, _G3450, _G3360]),
_G3389 in 1\/3..5,
_G3389+1#=_G3478,
_G3492+1#=_G3389,
_G3395 in 1\/3..5,
_G3478 in 2..6,
_G3444#=_G3478#<==>_G3529,
_G3444 in 2..5,
_G3444#=_G3556#<==>_G3553,
_G3444#=_G3568#<==>_G3565,
_G3444#=_G3492#<==>_G3577,
_G3450 in 2\/5,
all_different([_G3354, 4, 3, _G3450, _G3614]),
_G3360 in 2\/4..5,
_G3354 in 2\/5,
_G3614 in 1..2\/5,
_G3614+1#=_G3556,
_G3568+1#=_G3614,
_G3556 in 2..3\/6,
_G3553 in 0..1,
_G3565#\/_G3553#<==>1,
_G3565 in 0..1,
_G3568 in 0..1\/4,
_G3492 in 0..4,
_G3577 in 0..1,
_G3577#\/_G3529#<==>1,
_G3529 in 0..1.
If I change all_different to all_distinct I get the solution without label:
....
all_distinct(Nationalities),
all_distinct(Colors),
all_distinct(Beverages),
all_distinct(Cigarettes),
all_distinct(Pets),
....
?- solve(X).
X = [3, 5, 2, 1, 4].
As you see, the docs state stronger propagation for all_distinct vs all_different. Running the proposed sample help to understand the difference between those:
?- maplist(in, Vs, [1\/3..4, 1..2\/4, 1..2\/4, 1..3, 1..3, 1..6]), all_distinct(Vs).
false.
?- maplist(in, Vs, [1\/3..4, 1..2\/4, 1..2\/4, 1..3, 1..3, 1..6]), all_different(Vs).
Vs = [_G419, _G422, _G425, _G428, _G431, _G434],
_G419 in 1\/3..4,
all_different([_G419, _G422, _G425, _G428, _G431, _G434]),
_G422 in 1..2\/4,
_G425 in 1..2\/4,
_G428 in 1..3,
_G431 in 1..3,
_G434 in 1..6.

Resources