How to model Einstein's Riddle in a Constraint Satisfaction manner (Prolog) - 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.

Related

Turn List into number, increment the number, and then turn the number into a list

I have my head stuck in this exercise in prolog, I ve been trying to do it on my own but it just won't work. Example: ?-succesor([1,9,9],X) -> X = [2,0,0]. Had tried first to reverse the list and increment it with 1 and then do a if %10 = 0 the next element should be incremented too. Thing is that I m too used with programming syntax and I can't get my head wrapped around this.Any help would be appreciated.
I have done this so far, but the output is false.
%[1,9,9] -> 199 +1 -> 200;
numbers_atoms([],[]).
numbers_atoms([X|Y],[C|K]) :-
atom_number(C, X),
numbers_atoms(Y,K).
%([1,2,3],X)
digits_number(Digits, Number) :-
numbers_atoms(Digits, Atoms),
number_codes(Number, Atoms).
number_tolist( 0, [] ).
number_tolist(N,[A|As]) :-
N1 is floor(N/10),
A is N mod 10,
number_tolist(N1, As).
addOne([X],[Y]):-
digits_number(X,Y1), %[1,9,9] -> 199
Y1 is Y1+1, % 199 -> 200
number_tolist(Y1,[Y]), % 200 -> [2,0,0]
!.
You can solve this problem similarly to how you would solve it manually: traverse the list of digits until you reach the rightmost digit; increment that digit and compute the carry-on digit, which must be recursively propagated to the left. At the end, prepend the carry-on digit if it is equal to 1 (otherwise, ignore it).
% successor(+Input, -Output)
successor([X0|Xs], L) :-
successor(Xs, X0, C, Ys),
( C = 1 % carry-on
-> L = [C|Ys]
; L = Ys ).
% helper predicate
successor([], X, C, [Y]) :-
Z is X + 1,
Y is Z mod 10,
C is Z div 10. % carry-on
successor([X1|Xs], X0, C, [Y|Ys]) :-
successor(Xs, X1, C0, Ys),
Z is X0 + C0,
Y is Z mod 10,
C is Z div 10. % carry-on
Examples:
?- successor([1,9,9], A).
A = [2, 0, 0].
?- successor([2,7],A), successor(A,B), successor(B,C), successor(C,D).
A = [2, 8],
B = [2, 9],
C = [3, 0],
D = [3, 1].
?- successor([7,9,9,8], A), successor(A, B).
A = [7, 9, 9, 9],
B = [8, 0, 0, 0].
?- successor([9,9,9,9], A), successor(A, B).
A = [1, 0, 0, 0, 0],
B = [1, 0, 0, 0, 1].
Here's a version which doesn't use is and can work both ways:
successor(ListIn, ListOut) :-
reverse(ListIn, ListInRev),
ripple_inc(ListInRev, ListOutRev),
reverse(ListOutRev, ListOut).
ripple_inc([], [1]).
ripple_inc([0|T], [1|T]).
ripple_inc([1|T], [2|T]).
ripple_inc([2|T], [3|T]).
ripple_inc([3|T], [4|T]).
ripple_inc([4|T], [5|T]).
ripple_inc([5|T], [6|T]).
ripple_inc([6|T], [7|T]).
ripple_inc([7|T], [8|T]).
ripple_inc([8|T], [9|T]).
ripple_inc([9|T], [0|Tnext]) :-
ripple_inc(T, Tnext).
e.g.
?- successor([1,9,9], X).
X = [2, 0, 0]
?- successor([1,9,9], [2,0,0]).
true
?- successor(X, [2,0,0]).
X = [1, 9, 9]
although it's nicely deterministic when run 'forwards', it's annoying that if run 'backwards' it finds an answer, then leaves a choicepoint and then infinite loops if that choicepoint is retried. I think what causes that is starting from the higher number then reverse(ListIn, ListInRev) has nothing to work on and starts generating longer and longer lists both filled with empty variables and never ends.
I can constrain the input and output to be same_length/2 but I can't think of a way to constrain them to be the same length or ListOut is one item longer ([9,9,9] -> [1,0,0,0]).
This answer tries to improve the previous answer by #TessellatingHacker, like so:
successor(ListIn, ListOut) :-
no_longer_than(ListIn, ListOut), % weaker than same_length/2
reverse(ListIn, ListInRev),
ripple_inc(ListInRev, ListOutRev),
reverse(ListOutRev, ListOut).
The definition of no_longer_than/2 follows. Note the similarity to same_length/2:
no_longer_than([],_). % same_length([],[]).
no_longer_than([_|Xs],[_|Ys]) :- % same_length([_|Xs],[_|Ys]) :-
no_longer_than(Xs,Ys). % same_length(Xs,Ys).
The following sample queries still succeed deterministically, as they did before:
?- successor([1,9,9], X).
X = [2,0,0].
?- successor([1,9,9], [2,0,0]).
true.
The "run backwards" use of successor/2 now also terminates universally:
?- successor(X, [2,0,0]).
X = [1,9,9]
; false.

Exclude variants/rotations of lists in solutions SWI-Prolog

I want to exclude multiple rotations/mirrors of a list in my solutions of the predicate. I'll give an example of what I understand are rotations/mirrors of a list:
[1,2,3,4,5]
[2,3,4,5,1]
[3,4,5,1,2]
[5,4,3,2,1]
I have to find a predicate that delivers unique sequence of numbers from 1 to N, according to some constraints. I already figured out how to compute the right sequence but I can't find out how to exclude all the rotations and mirrors of 1 list. Is there an easy way to do this?
Edit:
Full predicate. clock_round(N,Sum,Yf) finds a sequence of the numbers 1 to N in such a way that no triplet of adjacent numbers has a sum higher than Sum.
clock_round(N,Sum,Yf) :-
generate(1,N,Xs),
permutation(Xs,Ys),
nth0(0,Ys,Elem1),
nth0(1,Ys,Elem2),
append(Ys,[Elem1,Elem2],Ym),
safe(Ym,Sum),
remove_duplicates(Ym,Yf).
remove_duplicates([],[]).
remove_duplicates([H | T], List) :-
member(H, T),
remove_duplicates( T, List).
remove_duplicates([H | T], [H|T1]) :-
\+member(H, T),
remove_duplicates( T, T1).
% generate/3 generates list [1..N]
generate(N,N,[N]).
generate(M,N,[M|List]) :-
M < N, M1 is M + 1,
generate(M1,N,List).
% permutation/2
permutation([],[]).
permutation(List,[Elem|Perm]) :-
select(Elem,List,Rest),
permutation(Rest,Perm).
safe([],_).
safe(List,Sum) :-
( length(List,3),
nth0(0,List,Elem1),
nth0(1,List,Elem2),
nth0(2,List,Elem3),
Elem1 + Elem2 + Elem3 =< Sum
; [_|RestList] = List, % first to avoid redundant retries
nth0(0,List,Elem1),
nth0(1,List,Elem2),
nth0(2,List,Elem3),
Elem1 + Elem2 + Elem3 =< Sum,
safe(RestList,Sum)
).
So what you want is to identify certain symmetries. At first glance you would have to compare all possible solutions with such. That is, in addition of paying the cost of generating all possible solutions you will then compare them to each other which will cost you a further square of the solutions.
On the other hand, think of it: You are searching for certain permutations of the numbers 1..n, and thus you could fix one number to a certain position. Let's fix 1 to the first position, that is not a big harm, as you can generate the remaining n-1 solutions by rotation.
And then mirroring. What happens, if one mirrors (or reverses) a sequence? Another sequence which is a solution is produced. The open question now, how can we exclude certain solutions and be sure that they will show up upon mirroring? Like: the number after 1 is larger than the number before 1.
At the end, rethink what we did: First all solutions were generated and only thereafter some were removed. What a waste! Why not avoid to produce useless solutions first?
And even further at the end, all of this can be expressed much more efficiently with library(clpfd).
:- use_module(library(clpfd)).
clock_round_(N,Sum,Xs) :-
N #=< Sum, Sum #=< 3*N -2-1,
length(Xs, N),
Xs = [D,E|_],
D = 1, append(_,[L],Xs), E #> L, % symmetry breaking
Xs ins 1..N,
all_different(Xs),
append(Xs,[D,E],Ys),
allsums(Ys, Sum).
allsums([], _).
allsums([_], _).
allsums([_,_], _).
allsums([A,B,C|Xs], S) :-
A+B+C #=< S,
allsums([B,C|Xs], S).
?- clock_round_(N, Sum, Xs), labeling([], [Sum|Xs]).
N = 3, Sum = 6, Xs = [1,3,2]
; N = 4, Sum = 9, Xs = [1,3,4,2]
; N = 4, Sum = 9, Xs = [1,4,2,3]
; N = 4, Sum = 9, Xs = [1,4,3,2]
; N = 5, Sum = 10, Xs = [1,5,2,3,4]
; ... .
Here is a possibility do do that :
is_rotation(L1, L2) :-
append(H1, H2, L1),
append(H2, H1, L2).
is_mirror(L1, L2) :-
reverse(L1,L2).
my_filter([H|Tail], [H|Out]):-
exclude(is_rotation(H), Tail, Out_1),
exclude(is_mirror(H), Out_1, Out).
For example
?- L = [[1,2,3,4,5],[2,3,4,5,1],[3,4,5,1,2],[5,4,3,2,1], [1,3,2,4,5]],my_filter(L, Out).
L = [[1, 2, 3, 4, 5], [2, 3, 4, 5, 1], [3, 4, 5, 1, 2], [5, 4, 3, 2, 1], [1, 3, 2, 4|...]],
Out = [[1, 2, 3, 4, 5], [1, 3, 2, 4, 5]].

Manipulating Prolog code output

I am trying to run code on this page: https://swish.swi-prolog.org/example/clpfd_queens.pl in swipl on a Linux terminal.
:- use_module(library(clpfd)).
n_queens(N, Qs) :-
length(Qs, N),
Qs ins 1..N,
safe_queens(Qs).
safe_queens([]).
safe_queens([Q|Qs]) :-
safe_queens(Qs, Q, 1),
safe_queens(Qs).
safe_queens([], _, _).
safe_queens([Q|Qs], Q0, D0) :-
Q0 #\= Q,
abs(Q0 - Q) #\= D0,
D1 #= D0 + 1,
safe_queens(Qs, Q0, D1).
Following command works:
?- n_queens(4, Qs), labeling([ff], Qs).
But not just n_queens(4, Qs):
?- n_queens(4, Qs).
Qs = [_G1470, _G1473, _G1476, _G1479],
_G1470 in 1..4,
abs(_G1470-_G1479)#\=3,
_G1470#\=_G1479,
abs(_G1470-_G1476)#\=2,
_G1470#\=_G1476,
abs(_G1470-_G1473)#\=1,
_G1470#\=_G1473,
_G1479 in 1..4,
abs(_G1476-_G1479)#\=1,
_G1476#\=_G1479,
abs(_G1473-_G1479)#\=2,
_G1473#\=_G1479,
_G1476 in 1..4,
abs(_G1473-_G1476)#\=1,
_G1473#\=_G1476,
_G1473 in 1..4.
Why is labeling part needed here? Can one get proper output without labeling part?
For larger numbers, one gets only initial part of the solution:
?- n_queens(20, Qs), labeling([ff], Qs).
Qs = [1, 3, 5, 14, 17, 4, 16, 7, 12|...] ;
Qs = [1, 3, 5, 18, 16, 4, 10, 7, 14|...] ;
...
How can one get full list output for larger numbers? Also, how can one get all numbers together, without having to press spacebar for each solution? Thanks for your help.
n_queens/2 does not solves the N-queens problem for N queens: it constructs the constraint programming problem: it constructs N variables (the columns of the queens), and adds constraints between these queens: for instance that two queens can not be placed on the same row, nor on the same diagonal. We see this if we rewrite the problem output to more convenient output:
A in 1..4,
abs(A-D)#\=3,
A#\=D,
abs(A-C)#\=2,
A#\=C,
abs(A-B)#\=1,
A#\=B,
D in 1..4,
abs(C-D)#\=1,
C#\=D,
abs(B-D)#\=2,
B#\=D,
C in 1..4,
abs(B-C)#\=1,
B#\=C,
B in 1..4.
So we see four queens (A, B, C and D). Each of the queens should be in the domain 1..4, furthermore we see non equal constraints like A #\= D to prevent the first queen A sharing a column with the last queen D. We finally see constraints like abs(A-C) #\= 2 to prevent the first queen A and the third queen C to differ two columns (diagnal attack).
Next labeling/2 will actually solve the problem: it performs relaxation (reducing the domains) as well as branching (picking a value or a subrange of values for variables) and backtracking in case the constraints fail. It will continue until it finds a solution, and we can use Prolog's backtracking mechanism to let labeling/2 come up with more solutions.
labeling thus is given a list of variables and aims to label them: assign them a value out of the range such that all constraints are satisfied.
Therefore the problem construction part is usually very fast compared to the actually solving part: it is easy to generate O(N) variables and O(N2) constraints, but it can take an exponential amount of time O(DN) to come up with a solution satisfying all constraints.
Also, how can one get all numbers together, without having to press spacebar for each solution?
You can use the meta-predicate findall/3 for that:
all_n_queens(N,LL) :-
findall(L,(n_queens(N,L), labeling([ff], L)),LL).
Which generates:
?- all_n_queens(5,LL).
LL = [[1, 3, 5, 2, 4], [1, 4, 2, 5, 3], [2, 4, 1, 3, 5], [2, 5, 3, 1, 4], [3, 1, 4, 2|...], [3, 5, 2|...], [4, 1|...], [4|...], [...|...]|...].
How can one get full list output for larger numbers?
You can set the answer_write_options flag:
?- set_prolog_flag(answer_write_options,[max_depth(0)]).
true.
?- all_n_queens(5,LL).
LL = [[1,3,5,2,4],[1,4,2,5,3],[2,4,1,3,5],[2,5,3,1,4],[3,1,4,2,5],[3,5,2,4,1],[4,1,3,5,2],[4,2,5,3,1],[5,2,4,1,3],[5,3,1,4,2]].

Matrix multiplication with Prolog

I have to write a predicate the predicate product/3 which receives two matrix and returns the matrix multiplication of them if possible or fail otherwise. (This means if the matrices fullfill the requirement [n x p] [p x y], then return the multiplication with dimensions [n x y])
Example:
product(M1, M2, R)
?- product([[1,2],[3,4],[5,6]], [[1,1,1],[1,1,1]], M).
M = [[3, 3, 3], [7, 7, 7], [11, 11, 11]];
No
For this I have two codes that index the nth row on a matrix rowI and that index the nth column columnI (I explain how they work in the code below).
%Predicate: rowI(M, I, RI)
%Input rowI([[1,2],[3,4],[5,6]], 2, RI).
% RI = [3,4];
rowI([H|_],1,H):-!.
rowI([_|T],I,X) :-
I1 is I-1,
rowI(T,I1,X).
% columnJ(M, J, CJ)
%Input columnJ([[1,2],[3,4],[5,6]], 1, CJ).
% CJ = [1,3,5];
columnJ([],_,[]).
columnJ([H|T], I, [R|X]):-
rowI(H, I, R),
columnJ(T,I,X).
product([H|T], M2, [R|X]):-
columnJ(M2, C, Z),
mult(H, Z , X),
product(T, M2 , X).
I was thinking somehow by grabbing the head of the M1 (which will be each row) and then multiplied for each column in M2 and after adding the multiplication this list will be the new row. So (C would have to be a counter starting from 1 to the length of M2and then mult I was just thinking on having it multiplying the lists. (mult is not defined at this point, just a guess).
Here I am trying to explain the way I am thinking it.. but there may be a simplier way. What do you think?
Compact code (with the help of higher order constructs maplist and foldl).
I left on purpose the expressions unevaluated, so the result could be reused in more general context:
:- module(matrix_multiply,
[matrix_multiply/3
,dot_product/3
]).
:- use_module(library(clpfd), [transpose/2]).
%% matrix_multiply(+X,+Y,-M) is det.
%
% X(N*P),Y(P*M),M(N*M)
%
matrix_multiply(X,Y,M) :-
transpose(Y,T),
maplist(row_multiply(T),X,M).
row_multiply(T,X,M) :-
maplist(dot_product(X),T,M).
dot_product([X|Xs],[T|Ts],M) :-
foldl(mul,Xs,Ts,X*T,M).
mul(X,T,M,M+X*T).
edit
usage (save in a file named matrix_multiply.pl):
?- [matrix_multiply].
?- matrix_multiply([[1,2],[3,4],[5,6]], [[1,1,1],[1,1,1]],R),maplist(maplist(is),C,R).
R = [[1*1+2*1, 1*1+2*1, 1*1+2*1], [3*1+4*1, 3*1+4*1, 3*1+4*1], [5*1+6*1, 5*1+6*1, 5*1+6*1]],
C = [[3, 3, 3], [7, 7, 7], [11, 11, 11]].
The numeric evaluation is explicitly requested by ,maplist(maplist(is),C,R).
R holds the symbolic expressions, C the values.
edit
Just to note that dependency from clpfd:transpose is easy to remove: here is an alternative 'one-liner' definition based on nth/3 and library(yall)
mat_transpose([R1|Rs],T) :- findall(V,(
nth1(Col,R1,_),
maplist({Col}/[R,C]>>nth1(Col,R,C),[R1|Rs],V)),T).

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