zebra_owner(Owner) :-
houses(Hs),
member(h(Owner,zebra,_,_,_), Hs).
water_drinker(Drinker) :-
houses(Hs),
member(h(Drinker,_,_,water,_), Hs).
houses(Hs) :-
length(Hs, 5), % 1
member(h(english,_,_,_,red), Hs), % 2
member(h(spanish,dog,_,_,_), Hs), % 3
member(h(_,_,_,coffee,green), Hs), % 4
member(h(ukrainian,_,_,tea,_), Hs), % 5
adjacent(h(_,_,_,_,green), h(_,_,_,_,white), Hs), % 6
member(h(_,snake,winston,_,_), Hs), % 7
member(h(_,_,kool,_,yellow), Hs), % 8
Hs = [_,_,h(_,_,_,milk,_),_,_], % 9
Hs = [h(norwegian,_,_,_,_)|_], % 10
adjacent(h(_,fox,_,_,_), h(_,_,chesterfield,_,_), Hs), % 11
adjacent(h(_,_,kool,_,_), h(_,horse,_,_,_), Hs), % 12
member(h(_,_,lucky,juice,_), Hs), % 13
member(h(japanese,_,kent,_,_), Hs), % 14
adjacent(h(norwegian,_,_,_,_), h(_,_,_,_,blue), Hs), % 15
member(h(_,_,_,water,_), Hs), % one of them drinks water
member(h(_,zebra,_,_,_), Hs). % one of them owns a zebra
adjacent(A, B, Ls) :- append(_, [A,B|_], Ls).
adjacent(A, B, Ls) :- append(_, [B,A|_], Ls).
How come the houses(Hs) predicate not fail the various member(elem, list) checks, if the list is actually empty all the time? I know it might sound like a dumb question, but wrapping my head around Prolog is actually hard, especially after years of Object-oriented programming. Any help is appreciated!
Edit: I didn't mention the query I was asking prolog, which is this zebra_owner(Owner)
Edit 2: Also posting the text of the problem (which is kinda famous) for reference:
Five colored houses in a row, each with an owner, a pet, cigarettes, and a drink.
The English lives in the red house.
The Spanish has a dog.
They drink coffee in the green house.
The Ukrainian drinks tea.
The green house is next to the white house.
The Winston smoker has a serpent.
In the yellow house they smoke Kool.
In the middle house they drink milk.
The Norwegian lives in the first house from the left.
The Chesterfield smoker lives near the man with the fox.
In the house near the house with the horse they smoke Kool.
The Lucky Strike smoker drinks juice.
The Japanese smokes Kent.
The Norwegian lives near the blue house.
Who owns the zebra and who drinks water?
How come the Houses(Hs) predicate not fail the various member(elem, list) checks, if the list is actually empty all the time?
That's because the list isn't actually empty! The empty list in Prolog is []. It contains no elements.
But the list inside a call to houses(Hs) is controlled by the first goal in that predicate, namely length(Hs, 5). What does this goal mean?
An important thing to learn about Prolog is that a goal or query doesn't just mean "is this statement true?". A Prolog goal or query means "under what circumstances is this statement true?". Prolog will try to do work to describe circumstances to you under which your query becomes true.
So even if we know absolutely nothing about Hs before, when executing this length query, GNU Prolog says:
| ?- length(Hs, 5).
Hs = [_,_,_,_,_]
So length(Hs, 5) becomes true if Hs is of the form [_, _, _, _, _]. This is not an empty list. It is not even a possibly empty list. It is a list that definitely contains exactly five elements. We don't know anything about those elements yet! But the length of the list is definitely fixed.
Maybe you got mislead by the fact that Prolog allows you to talk about a list that definitely has elements but whose elements are not yet known. This is a concept that is not possible in typical object oriented languages. But the fact that we don't know the elements doesn't mean that there is nothing there, i.e., that the list is empty.
As for how the member calls succeed: Again, they aren't just checks for "is X a member of Hs". They are questions meaning "under what circumstances is X a member of Hs?". Again, Prolog will do some work for you to describe those circumstances:
| ?- length(Hs, 5), member(x, Hs).
Hs = [x,_,_,_,_] ? ;
Hs = [_,x,_,_,_] ? ;
Hs = [_,_,x,_,_] ? ;
Hs = [_,_,_,x,_] ? ;
Hs = [_,_,_,_,x]
So x is a member of Hs if x is the first element of Hs, or the second, or the third, or so on. In each of these cases, "describing the circumstances" means that Prolog actually binds the appropriate element of the list (which before was a variable) to the element x. For each of these possibilities, further computations following the member goal could further instantiate the list. This is what builds up the solutions to the Zebra puzzle: Instead of just answering "yes" to the question "does the puzzle have a solution", Prolog builds up a data structure actually describing a solution.
The houses list Hs is not empty at all, ever. It is created right at the very beginning with
length(Hs, 5)
So it is a list with five initially uninitialized logical variables, which get instantiated by all the subsequent goals when they are called in turn, in particular by those same member/2 goals you mention.
To see an example of this, try:
32 ?- L=[A,B,C], member(1, L).
L = [1, B, C] ;
L = [A, 1, C] ; % three solutions are found by Prolog
L = [A, B, 1]. % in turn, one after another
Those calls which can't be fulfilled (where no instantiation of the remaining free logical variables is possible) cause that specific search branch to fail.
An example:
33 ?- L=[1,2,C], member(3,L). % a check succeeds, while
L = [1, 2, 3], C = 3. % instantiating the `C` logvar
34 ?- L=[1,2,3], member(3,L). % a check succeeds
L = [1, 2, 3].
35 ?- L=[1,2,3], member(4,L). % a check fails
false.
Only successful instantiations remain, in the end, thus forming the solution, when all the logical variables in Hs become fully instantiated, ground.
I recently found a small game on the Google Play app store called Cryptogram. There are dozens of apps similar to this one. The idea is to match the number to the colors such that all of the equations sound true.
I was able to get through problems 1-8 and problem 10 fairly quickly by hand, but problem 9 has proven to be more difficult for me.
Problem 9
After some time tinkering and guessing, I gave up and decided to program a solution. I have used Prolog/Datalog for some small tasks as an undergrad as well as some Project Euler problems. Previously I had seen the 15 line Sudoku solver that uses Prolog's Constraint Logic Programming over Finite Domains (clpfd) library, and I decided to give it a go myself. I'm using SWI-Prolog.
:- use_module(library(clpfd)).
problem(Colors) :-
Colors = [Pink, Cyan, Yellow, Green, Purple, Red, Brown, White, Lime],
Colors ins 0..9,
all_distinct(Colors),
% The leading digit of a number can't be 0
Pink #\= 0,
Red #\= 0,
White #\= 0,
Green #\= 0,
Lime #\= 0,
Cyan #\= 0,
% I originally tried to write a predicate generalizing numbers and a list of digits
% but got in way over my head with CLPFD.
Number1_1 #= (Pink * 1000) + (Cyan * 100) + (Pink * 10) + Yellow,
Number1_2 #= (Green * 10) + Purple,
Number1_3 #= (Cyan * 100) + (Red * 10) + Purple,
Number2_1 #= (Red * 1000) + (Brown * 100) + (White * 10) + Red,
Number2_2 #= (Lime * 10) + Yellow,
Number2_3 #= (Red * 1000) + (Lime * 100) + (Purple * 10) + Pink,
Number3_1 #= (White * 1000) + (Purple * 100) + (Cyan * 10) + White,
Number3_2 #= (Green * 1000) + (Cyan * 100) + (Yellow * 10) + Purple,
Number3_3 #= (Cyan * 1000) + (Red * 100) + (Yellow * 10) + Red,
% I'm not 100% sure whether to use floored or truncated division here.
% I thought the difference would be a float vs integer output,
% but that doesn't make sense with finite domains.
Number1_1 // Number1_2 #= Number1_3,
Number1_1 rem Number1_2 #= 0,
Number2_3 #= Number2_1 + Number2_2,
Number3_3 #= Number3_1 - Number3_2,
Number3_1 #= Number1_1 - Number2_1,
Number3_2 #= Number1_2 * Number2_2,
Number3_3 #= Number1_3 + Number2_3.
The output when I run this query in SWI-Prolog makes me feel like I'm misunderstanding a big concept in CLPFD:
?- problem([Pink, Cyan, Yellow, Green, Purple, Red, Brown, White, Lime]).
Pink in 3..9,
_7756#=Pink+10*Purple+1000*Red+100*Lime,
_7810#=1010*Pink+100*Cyan+Yellow,
all_distinct([Pink, Cyan, Yellow, Green, Purple, Red, Brown, White|...]),
Cyan in 1..7,
_7946#=1000*Cyan+10*Yellow+101*Red,
_7994#=100*Cyan+10*Yellow+1000*Green+Purple,
_8048#=10*Cyan+100*Purple+1001*White,
_8096#=100*Cyan+Purple+10*Red,
Yellow in 0..9,
_8162#=Yellow+10*Lime,
Green in 1..7,
_8216#=10*Green+Purple,
Purple in 0..9,
Red in 1..7,
_8294#=1001*Red+100*Brown+10*White,
Brown in 0..9,
White in 2..8,
Lime in 1..9,
_7756 in 1103..7568,
_8096+_7756#=_7946,
_8294+_8162#=_7756,
_8096 in 110..779,
_7810//_8216#=_8096,
_7810 in 3334..9799,
_8048+_8294#=_7810,
_7810 rem _8216#=0,
_8048 in 2313..8778,
_7946+_7994#=_8048,
_7946 in 1213..7678,
_7994 in 1100..7565,
_8216*_8162#=_7994,
_8216 in 12..79,
_8162 in 14..99,
_8294 in 1021..7486.
I would expect each color in the color list to bind to a single distinct integer in the range 0..9, but that's not what's happening. Can you help me find the solution to this problem?
EDIT
So I picked an arbitrary color and started assigning it numbers in the range that the constraint says should be valid. I ran this query with Cyan bound to 1.
?- problem([Pink, 1, Yellow, Green, Purple, Red, Brown, White, Lime]).
false.
Which doesn't make sense. The previous "output" says "Cyan in 1..7", which I thought meant that any value in that range is valid. However, if I pick another arbitrary value for Cyan:
?- problem([Pink, 2, Yellow, Green, Purple, Red, Brown, White, Lime]).
Pink = 7,
Yellow = 6,
Green = 3,
Purple = 4,
Red = 1,
Brown = 8,
White = 5,
Lime = 9.
I get the answer I was looking for. Though the Cryptogram is solved, I still don't understand why Prolog's CLPFD library didn't find it completely independently.
EDIT 2
I used your suggestions to clean up the code. I also reintroduced the predicate which relates digits to numbers. This code chunk works perfectly.
:- use_module(library(clpfd)).
digit_number(0, [], 1).
digit_number(Number, [Digit|Tail], DigitPlace) :-
digit_number(NextNumber, Tail, NextDigitPlace),
DigitPlace #= NextDigitPlace * 10,
PlaceNumber #= Digit * (NextDigitPlace),
Number #= PlaceNumber + NextNumber.
digit_number(Number, ColorList) :-
digit_number(Number, ColorList, _).
problem(Colors) :-
Colors = [Pink, Cyan, Yellow, Green, Purple, Red, Brown, White, Lime],
Colors ins 0..9,
all_distinct(Colors),
digit_number(Number1_1, [Pink, Cyan, Pink, Yellow]),
digit_number(Number1_2, [Green, Purple]),
digit_number(Number1_3, [Cyan, Red, Purple]),
digit_number(Number2_1, [Red, Brown, White, Red]),
digit_number(Number2_2, [Lime, Yellow]),
digit_number(Number2_3, [Red, Lime, Purple, Pink]),
digit_number(Number3_1, [White, Purple, Cyan, White]),
digit_number(Number3_2, [Green, Cyan, Yellow, Purple]),
digit_number(Number3_3, [Cyan, Red, Yellow, Red]),
Number1_1 // Number1_2 #= Number1_3,
Number1_1 rem Number1_2 #= 0,
Number2_1 + Number2_2 #= Number2_3,
Number3_1 - Number3_2 #= Number3_3,
Number1_1 - Number2_1 #= Number3_1,
Number1_2 * Number2_2 #= Number3_2,
Number1_3 + Number2_3 #= Number3_3,
label(Colors).
Your code works, just add label(C) :
?- problem(C), label(C).
C = [7, 2, 6, 3, 4, 1, 8, 5, 9] .
The other answer shows you one way of getting the result you want, but I would like to answer some of your questions.
I still don't understand why Prolog's CLPFD library didn't find it completely independently.
Prolog is a more-or-less declarative programming language, but (although we like to pretend, for propaganda reasons) you cannot just write down anything that is logically equivalent to your problem and expect it to be executed correctly and efficiently. In particular, the order of execution of different goals matters a lot, even though it should make no logical difference. This is especially true for arithmetic. Consider:
?- between(1, 99999999, N), N > 99999998.
N = 99999999. % correct but slooooow
?- N > 99999998, between(1, 99999999, N).
ERROR: >/2: Arguments are not sufficiently instantiated
Doing the same with CLP(FD) works much more nicely:
?- N in 1..99999999, N #> 99999998.
N = 99999999. % correct and fast!
?- N #> 99999998, N in 1..99999999.
N = 99999999. % also correct, also fast!
CLP(FD) allows you to write programs that are more correct, more declarative, and that can often be more efficient than other solutions, unless you hand-optimize them.
To achieve this, unlike normal Prolog, CLP(FD) separates the collection of constraints from the actual search for solutions. As your program goes along and creates constraints, CLP(FD) will make some simplifications, like in your example where it determines Cyan in 1..7 on its own, or in my example above where it can find the unique solution immediately. But in general, these simplifications do not solve the problem completely.
One reason for this is, simply, performance: Search can be slow. It can be faster if more constraints are known, because new constraints on already constrainted variables can only make the search space smaller, but never bigger! It makes sense to delay it until concrete answers are actually needed.
For this reason, to actually get concrete resuls, you need to call a labeling predicate that systematically enumerates solutions. In SWI-Prolog, simple ones are indomain/1 and label/1; a general one is labeling/2. This latter one even allows you to influence the search space exploration strategy, which can be useful if you have some understanding of the problem domain.
The previous "output" says "Cyan in 1..7", which I thought meant that any value in that range is valid.
Not quite: It means that if there is a valid solution for Cyan, then it is in the range 1 to 7. It doesn't give a guarantee that all values in that range are solutions. For example:
?- X in 1..5, Y in 1..5, X #< Y.
X in 1..4,
X#=<Y+ -1,
Y in 2..5.
3 is in the range 1..4, and 3 is in the range 2..5, so purely based on this we might expect a solution with X = 3 and Y = 3. But that is impossible due to the additional constraint. Only labeling will actually give you answers that are guaranteed solutions, and only if you label all the variables in the query.
See also the very nice answer here: https://stackoverflow.com/a/27218564/4391743
Edit:
% I'm not 100% sure whether to use floored or truncated division here.
% I thought the difference would be a float vs integer output,
% but that doesn't make sense with finite domains.
Number1_1 // Number1_2 #= Number1_3,
Indeed fractional division doesn't make sense here, but Prolog would have told you:
?- X in 1..5, Y in 1..5, Z #= X // Y.
X in 1..5,
X//Y#=Z,
Y in 1..5,
Z in 0..5.
?- X in 1..5, Y in 1..5, Z #= X / Y.
ERROR: Domain error: `clpfd_expression' expected, found `_G6388/_G6412'
Bear with me, I know this is obviously super simple. I just can't seem to wrap my head around prolog. I have this logic problem:
At the recent festival, the 100 metres heats were closely monitored.
Each contestant had to run in two races so that the average place could be determined..
Only one runner finished in the same place in both races.
Alan was never last. Charles always beat Darren. Brian had at least one
first place. Alan finished third in at least one of the races. Both Darren
and Charles had a second place. What were the two results?
Answer: Race 1: Brian, Charles, Alan, Darren. Race 2: Charles, Darren, Alan,
Brian.
This is what I have come up with so far, but I can't figure out the "at least" and other more complex conditions.
place(one).
place(two).
place(three).
place(four).
/* Place (constants): one, two, three, four.
Names (variables): Alan_1, Brian_1, Charles_1, Darren_1
Names (variables): Alan_2, Brian_2, Charles_2, Darren_2
*/
higher(one,two).
higher(one,three).
higher(one,four).
higher(two,three).
higher(two,four).
higher(three,four).
is_higher(X,Y):- higher(X,Y).
is_higher(X,Y):- higher(X,Z), is_higher(Z,Y).
is_different(S,T,U,V,W,X,Y,Z):- W\=X,W\=Y,W\=Z,X\=Y,X\=Z,Y\=Z,W\=S,W\=T,
W\=U,W\=V,S\=T,T\=U,U\=V,S\=U,S\=V,T\=V,
T\=W,T\=X,T\=Y,T\=Z,U\=W,U\=X,U\=Y,U\=Z,
V\=X,V\=Y,V\=Z.
solution(Alan_1, Brian_1, Charles_1, Darren_1, Alan_2, Brian_2, Charles_2,
Darren_2):-
place(Alan_1), place(Brian_1), place(Charles_1), place(Darren_1),
place(Alan_2), place(Brian_2), place(Charles_2), place(Darren_2),
Alan_1\=four, Alan_2\=four, higher(Charles_1, Darren_1), higher(Charles_2,
Darren_2),
is_different(Alan_1, Brian_1, Charles_1, Darren_1, Alan_2, Brian_2,
Charles_2, Darren_2).
/* Query */
% solution(Alan_1, Brian_1, Charles_1, Darren_1, Alan_2, Brian_2, Charles_2,
Darren_2).
Any help or words of wisdom would be super appreciated.
I solved with SWI + CLPFD.
For representing "at least",
I used #\/ .
:-use_module(library(clpfd)).
solve(RaceResult):-
RaceResult = [Alan1,Alan2,Chales1,Chales2,Brian1,Brian2,Darren1,Darren2],
RaceResult ins 1..4,
all_different([Alan1,Chales1,Brian1,Darren1]),
all_different([Alan2,Chales2,Brian2,Darren2]),
% Only one runner finished in the same place in both races.
(Alan1 #= Alan2) #<==> AlanSame,
(Chales1 #= Chales2) #<==> ChalesSame,
(Brian1 #= Brian2) #<==> BrianSame,
(Darren1 #= Darren2) #<==> DarrenSame,
sum([AlanSame,ChalesSame,BrianSame,DarrenSame], #=, 1),
% Alan was never last.
Alan1 #\= 4,
Alan2 #\= 4,
% Alan finished third in at least one of the races.
(Alan1 #= 3 ) #\/ (Alan2 #= 3),
% Charles always beat Darren.
Chales1 #< Darren1,
Chales2 #< Darren2,
% Brian had at least one first place.
(Brian1 #= 1 ) #\/ (Brian2 #= 1),
% Both Darren and Charles had a second place.
(Darren1 #= 2) #\/ (Darren2 #= 2),
(Chales1 #= 2) #\/ (Chales2 #= 2),
labeling([ffc],RaceResult).
?- solve([Alan1,Alan2,Chales1,Chales2,Brian1,Brian2,Darren1,Darren2]).
Alan1 = Alan2, Alan2 = 3,
Chales1 = Brian2, Brian2 = 1,
Chales2 = Darren1, Darren1 = 2,
Brian1 = Darren2, Darren2 = 4 ;
Alan1 = Alan2, Alan2 = 3,
Chales1 = Darren2, Darren2 = 2,
Chales2 = Brian1, Brian1 = 1,
Brian2 = Darren1, Darren1 = 4.
Maybe there is another solution?
Race1:
Chales
Darren
Alan
Brian
Race2:
Brian
Chales
Alan
Darren
... Sorry just replacing race1 and race2.
I did it this way:
puzzle :-
Races = [[_,_,_,_],[_,_,_,_]],
Races = [R1,R2],
(first(brian,R1);first(brian,R2);(first(brian,R1),first(brian,R2))),
(third(alan,R1);third(alan,R2);(third(alan,R1),third(alan,R2))),
((second(darren,R1),second(charles,R2));(second(darren,R2),second(charles,R1))),
member(brian,R1),
member(charles,R1),
member(brian,R2),
member(charles,R2),
member(alan,R1),
member(darren,R1),
member(alan,R2),
member(darren,R2),
before(charles,darren,R1),
before(charles,darren,R2),
never_last(alan,Races),
only_one_same(Races),
write(Races),nl.
zip_equal([],[],[]).
zip_equal([R|R1s],[R|R2s],[R|Rs]) :- !, zip_equal(R1s,R2s,Rs).
zip_equal([_|R1s],[_|R2s],Rs) :- !, zip_equal(R1s,R2s,Rs).
never_last(X,[[A1,B1,C1,_],[A2,B2,C2,_]]) :- member(X,[A1,B1,C1]), member(X,[A2,B2,C2]).
before(X,Y,[X|Rs]) :- !, member(Y,Rs).
before(X,Y,[_|Rs]) :- before(X,Y,Rs).
first(X,[X,_,_,_]).
second(X,[_,X,_,_]).
third(X,[_,_,X,_]).
only_one_same([R1s,R2s]) :- zip_equal(R1s,R2s,[_]).
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.