Working on the Bert Bos Puzzle, where I need to print all possible permutations of a sequence (clicks or no clicks) that will turn the whole square red. This will be done by clicking the top row in a sequence of clicks and no clicks. Then, you go to the subsequent row and click squares there to make the first row all red. You progress through the puzzle like this until you turn the whole square red.
So a possible solution to a 4x4 square would be [click, click, no click, no click] on the first row. You dont have to follow the pattern for any of the lines below, just keep flipping until all blocks on the next line are red and continue till all squares are red.
Im trying to write a predicate that tests all possible permutations of ‘click’ and ‘no click’ for the first row of a square of size N. Right now Im trying to go about it by keeping track of the color of the top row after it has been clicked, then using that to say which squares of the second row should be clicked to make the top row all red.
The problem is I cant figure out how to keep track of the colors of the second row that are changed by clicks from the first row, and then how to keep track of clicks from the second row on and how they affect the rest of the rows. Any help would be greatly appreciated.
Here is what I have so far
state(no_click).
state(click).
flip(blue, red).
flip(red, blue).
board_permutations(0,[]):- !.
board_permutations(N, [H|T]) :-
state(H),
N1 is N - 1,
board_permutations(N1, T).
first_row_solutions([], []).
first_row_solutions([H1, H2|T], [FirstRow|SecondRow]):-
H1 = click,
flip(H1,C),
flip(H2,C),
first_row_solutions(H2, FirstRow).
first_row_solutions([H|T], [FRH1, FRH2, FRH3|FRT], [SR1, SR2, SR3|SRT]) :-
H = click,
flip(FRH1, C1),
flip(FRH2, C2),
flip(FRH3, C3),
%flip(SR1, S1), I was thinking I could keep track of the second row colors here
%flip(SR2, S2),
%flip(SR3, S3)
%FlipListRow1 = [C1, C2, C3 | T],
%FlipListRow2 = [S1, S2, S3|T],
first_row_solutions(H, FRH3).
%Possible predicate to handle row 2, 3, 4 etc --> ClickList is what clicks to do on row 3 to make row 2 red, etc
%row_n_solutions(FlipListRow2, ClickList)
generate_board(0, [], _).
generate_board(N, [H|T], ConstantN) :-
generate_row(ConstantN, H),
N =< 12, N >= 1,
N2 is N-1,
generate_board(N2, T, ConstantN).
generate_row(0, []) :- !.
generate_row(N, [H | T]) :-
N =< 12, N >= 1,
N2 is N-1,
H = blue,
generate_row(N2, T).
test(X) :- generate_board(5,X,5).
test1(X) :- solutions([no_click, click, no_click, no_click], X).
#CapelliC has already suggested one possible approach: You can carry along the matrix (using predicate arguments), and use this to always inspect the current state of any surrounding cells.
Complementing this approach, I would also like to point out a different method to approach the whole task: We can consider this puzzle as finding a suitable linear combination of vectors from the finite field GF(2). The number of clicks can be represented as an integer coefficient for each vector.
It only remains to establish a correspondence between board positions and vector indices. We can define such a relation as follows:
n_id_x_y(N, ID, X, Y) :-
ID #= Y*N + X,
N1 #= N - 1,
[X,Y] ins 0..N1.
Example:
?- n_id_x_y(4, 6, X, Y).
X = 2,
Y = 1.
Note that I specified 4 to obtain a mapping that works for 4×4 boards.
This uses CLP(FD) constraints and works in all directions, including for example:
?- n_id_x_y(4, ID, 3, 2).
ID = 11.
Based on this, we can also relate any index to its neighbours, again denoted by their unique indices:
n_id_neighbour(N, ID, NID) :-
n_id_x_y(N, ID, X, Y),
( ( NX #= X - 1, NY #= Y
; NX #= X + 1, NY #= Y
)
; ( NX #= X, NY #= Y - 1
; NX #= X, NY #= Y + 1
)
),
n_id_x_y(N, NID, NX, NY).
Clicking on any board position flips the colour of that position and its defined neighbours. We will use a Boolean vector and let 1 denote that the colour of the position that corresponds to this index is affected:
n_id_vector(N, ID, Vs) :-
V #= N*N,
V1 #= V - 1,
ID in 0..V1,
indomain(ID),
findall(NID, n_id_neighbour(N, ID, NID), Ns),
sort([ID|Ns], IDs),
length(Vs, V),
phrase(ids_vector(IDs, 0), Vs, Zeroes),
maplist(=(0), Zeroes).
ids_vector([], _) --> [].
ids_vector([ID|IDs], Pos0) -->
{ Gap #= ID - Pos0,
Pos #= ID + 1,
length(Zeroes, Gap),
maplist(=(0), Zeroes) },
Zeroes,
[1],
ids_vector(IDs, Pos).
For example, clicking on entry 0-0 affects precisely three other cells, which are indicated by 1:
?- n_id_vector(4, 0, Vs).
Vs = [1, 1, 0, 0, 1, 0, 0, 0, 0|...].
We are now ready to describe what we expect from a solution: A solution consists of a list of coefficients, one for each vector, such that the sum of the scalar products (vector times coefficient for each vector) modulo 2 is equal to (1,1,...,1). This means that the colour of each cell has changed.
n_solution(N, Cs) :-
findall(Vs, n_id_vector(N,_,Vs), Vss),
same_length(Vss, Cs),
Cs ins 0..1,
maplist(flip_cell(Cs), Vss),
label(Cs).
flip_cell(Cs, Ts) :-
scalar_product(Ts, Cs, #=, Sum),
Sum mod 2 #= 1.
Note that in this case, due to the inherent symmetry, there is no need to transpose the matrix.
The fact that we are reasoning over Boolean algebra already entails that the order in which the cells are clicked does not affect the outcome, and also that each of the vectors needs to be used at most once in any solution.
Here are solutions for a 4×4 board:
?- n_solution(4, Cs).
Cs = [0, 0, 0, 0, 1, 1, 1, 1, 1, 0, 0, 1, 1, 1, 1, 1] ;
Cs = [0, 0, 0, 1, 1, 1, 0, 0, 1, 1, 0, 0, 0, 0, 0, 1] ;
Cs = [0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 0] ;
Cs = [0, 0, 1, 1, 1, 0, 1, 1, 0, 1, 0, 0, 1, 0, 1, 0] ;
etc.
Each solution indicates precisely which of the cells we must click. For example, the first solution:
Here is one of the longest solutions for this board size:
And this is one of the shortest:
You can of course also apply this approach to other board sizes, such as 7×7:
Or 12×12:
I have an assignment that seems out of scope of my class (I say this because they barely taught us anything about prolog), I have to write a prolog program to solve the game "Flow Free" on android. In the assignment it is called Numberlink. I could solve this in C++ in a hour but because I'm not too familiar with prolog it is giving me trouble. Here's what I would like to do:
Make a list that holds a boolean to indicate whether it has been visited or used.
Recursively search all possible paths from a given starting point to
the end point using a breadth first search to find the shortest
paths.
Go from there I guess.
My attempt included searching the web on how to make a list. Of course prolog is not documented well at all anywhere so I came up blank and gave up. A friend told me to use maplist which I don't understand how I would use it to make a list including what I need.
Thanks in advance.
EDIT:
Thanks for the link, but I was looking to make a 2D list to represent the board being played on. Function would look like this:
makeList(size, list):-
Where size is an integer representing the size of one dimension in the square list ex. (7x7).
Here's an implementation of #CapelliC's solution. The code is self-explanatory. 2 blocks are connected if they are adjacent and have the same color, or adjacent to another connected block of the same color. (I used X and Y instead of row and column, it made writing the conditions at the end a little confusing.)
Solving in SWI-Prolog
https://flowfreesolutions.com/solution/?game=flow&pack=green&set=5&level=1
connected(P1, P2, M, Visited) :-
adjacent(P1, P2),
maplist(dif(P2), Visited),
color(P1, C, M),
color(P2, C, M).
connected(P1, P2, M, Visited) :-
adjacent(P1, P3),
maplist(dif(P3), Visited),
color(P1, C, M),
color(P3, C, M),
connected(P3, P2, M, [P3|Visited]).
adjacent(p(X,Y1), p(X,Y2)) :- Y2 is Y1+1.
adjacent(p(X,Y1), p(X,Y2)) :- Y2 is Y1-1.
adjacent(p(X1,Y), p(X2,Y)) :- X2 is X1+1.
adjacent(p(X1,Y), p(X2,Y)) :- X2 is X1-1.
color(p(X,Y), C, M) :-
nth1(Y, M, R),
nth1(X, R, C).
sol(M) :-
M = [[1,_,_,_,1],
[2,_,_,_,_],
[3,4,_,4,_],
[_,_,_,_,_],
[3,2,5,_,5]],
connected(p(1,1), p(5,1), M, [p(1,1)]),
connected(p(1,2), p(2,5), M, [p(1,2)]),
connected(p(1,3), p(1,5), M, [p(1,3)]),
connected(p(2,3), p(4,3), M, [p(2,3)]),
connected(p(3,5), p(5,5), M, [p(3,5)]).
Sample query:
?- sol(M).
M = [[1, 1, 1, 1, 1],
[2, 2, 2, 2, 2],
[3, 4, 4, 4, 2],
[3, 2, 2, 2, 2],
[3, 2, 5, 5, 5]].
The declarative Prolog 'modus operandi' is based on non determinism, implemented by depth first search. Let's apply to this puzzle: M is the playground, a list of lists of free cells (variables) or integers (colors)
one_step(M) :-
cell(M, X,Y, C),
integer(C), % the selected cell is a color
delta(X,Y,X1,Y1),
cell(M, X1,Y1, C). % bind adjacent to same color - must be free
cell(M, X,Y, C) :- nth1(Y,M,R), nth1(X,R,C).
% moves
delta(X,Y,X1,Y) :- X1 is X+1. % right
delta(X,Y,X1,Y) :- X1 is X-1. % left
delta(X,Y,X,Y1) :- Y1 is Y-1. % up
delta(X,Y,X,Y1) :- Y1 is Y+1. % down
what this does ? let's try on a 3x3 playground
?- M=[[_,9,_],[_,0,_],[_,_,9]],one_step(M).
M = [[_G1824, 9, 9], [_G1836, 0, _G1842], [_G1848, _G1851, 9]] ;
M = [[9, 9, _G1830], [_G1836, 0, _G1842], [_G1848, _G1851, 9]] ;
M = [[_G1824, 9, _G1830], [_G1836, 0, 0], [_G1848, _G1851, 9]] ;
M = [[_G1824, 9, _G1830], [0, 0, _G1842], [_G1848, _G1851, 9]] ;
M = [[_G1824, 9, _G1830], [_G1836, 0, _G1842], [_G1848, 0, 9]] ;
M = [[_G1824, 9, _G1830], [_G1836, 0, _G1842], [_G1848, 9, 9]] ;
M = [[_G1824, 9, _G1830], [_G1836, 0, 9], [_G1848, _G1851, 9]] ;
false.
No need to declare grid size, check index boundaries, etc... when one_step/1 succeeds it has instantiated a free cell to an adjacent same color...
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.
the problem is ; we have a function take 3 argument,
like; func ( [[0, 0, 0, 1, 0], [0, 1, 1, 1, 0], [0, 0, 1, 0, 0],
[0, 0, 1, 0, 0], [0, 0, 0, 1, 0]], (1, 1), X ) the first one is nested list, which is
show 5x5 matrix and 1s means it is full, 0 means empty and,
the second parameter (1,1) our starting point 1st row 1st column,
the 3rd parameter X is ; variable that we will unify with
the points that are accessible from the starting point which is (1,1)
so if asked;
?- func ( [ [0,0,0,1] [0,0,1,0] [0,0,1,1] [0,0,1,0] ], (1,1), X).
X = (1, 1);
X = (1, 2);
X = (1, 3);
X = (2, 2);
X = (3, 2);
X = (4, 1);
X = (4, 2);
false.
when we start from (1,1) we can move up, down, left and right;
since no left and up movement while on (1,1) look right if empty, write it, look down empty write down, go the (1,2) again, move right or left or up or down, and so on.
here the reason why we didn't write the outputs, (2,4) (4,4)
if for example point (2,3) is full and (2,4) is empty
we look that can we go point (2,4) one by one, I mean,
if left , up and down of them is full, we can't go point (2,4) using this point, since they are full.
My solution: get the textbook, sit at the computer, and figure it out for yourself! Simply labelling something as homework doesn't excuse not doing it yourself.
lastly I done it, here is the code;
%returns the nth element from the list
nth([F|_],1,F).
nth([_|R],N,M) :- N > 1, N1 is N-1, nth(R,N1,M).
%returns true if cell is empty: gets the cell value at (StartRow,StartColumn) and returns whether the value is 0
isempty(Maze,StartRow,StartColumn) :- nth(Maze,StartRow,Line),nth(Line,StartColumn,Y), Y == 0.
%returns the head of the list
head([Elem|_],Elem).
%find accessible returns empty list if not in maze size (1 to N for row and column)
findaccessible(Maze, (StartRow,StartColumn), [], _) :- head(Maze,L),length(L,N), (StartColumn > N ; StartRow > N ; StartColumn < 1 ; StartRow < 1).
%find all empty cells and retain them in X. L retains the current found cells in order to avoid returning to visited positions.
findaccessible(Maze, (StartRow,StartColumn), X, L) :-
%if cell is empty, retain position and add it to the list
isempty(Maze,StartRow,StartColumn) -> (union(L,[(StartRow,StartColumn)],L1),X1 = [(StartRow,StartColumn)],
%check right column and if element not visited, find all accessible cells from that point and unify the lists
SR is StartRow, SC is StartColumn+1,(member((SR,SC),L) -> union(X1,[],X2) ; (findaccessible(Maze, (SR,SC), Tmp1, L1), union(X1,Tmp1,X2))),
%check down row and if element not visited, find all accessible cells from that point and unify the lists
SR2 is StartRow+1,SC2 is StartColumn, (member((SR2,SC2),L) -> union(X2,[],X3) ; (findaccessible(Maze, (SR2,SC2), Tmp2, L1), union(X2,Tmp2,X3))),
%check left column and if element not visited, find all accessible cells from that point and unify the lists
SR3 is StartRow, SC3 is StartColumn-1, (member((SR3,SC3),L) -> union(X3,[],X4) ; (findaccessible(Maze, (SR3,SC3), Tmp3, L1), union(X3,Tmp3,X4))),
%check up row and if element not visited, find all accessible cells from that point and unify the lists
SR4 is StartRow-1, SC4 is StartColumn, (member((SR4,SC4),L) -> union(X4,[],X) ; (findaccessible(Maze, (SR4,SC4), Tmp4, L1), union(X4,Tmp4,X)))) ; X = [].
%lists each result
%if no more results return false
results(_,[]) :- fail.
%return the result or return the rest of the results
results(X,[Head|Rest]) :- X = Head ; results(X,Rest).
%accessible predicate that finds all empty accessible cells and then list each of them
accessible(Maze, (StartRow,StartColumn), X) :- findaccessible(Maze, (StartRow,StartColumn), Lst, []), !, results(X,Lst).
%sample test run
%accessible([[0, 0, 0, 1, 0], [0, 1, 1, 1, 0], [0, 0, 1, 0, 0], [0, 0, 1, 0, 0], [0, 0, 0, 1, 0]], (1, 1), X).