
% File: zebras.pl
% Author: Peter Clark
% Date: 1992
% Purpose: Formulation of the famous `zebras' CSP in Prolog

/*
To run this demo with LPE, do
		% prolog
		| ?- compile(cspdemo).
 		| ?- compile(zebras).
 		| ?- demo.

For more information, see the csp_demos/README file.
*/
:- ensure_loaded('../utils').
:- no_style_check(multiple).

:- dynamic 				% declare non-op goals for LPE
	generator/2,
	optiontypes/1,
	options/2,
	fails/3,
	multiple_abodes/3,
	dremove/5,
	dmember/4,
	not_lives_at/5,
	lives_apart/5,
	get_bit/3,
	get_bit/4,
	dnmember/3,
	dnmember/4,
	dadd1/2,
	valeq/3,
	no_neighbours/2,
	all_options/1,
	sdadd1/2,
	sdsub1/2,
	not_same_house/5,
	not_right_of/5,
	vs/1.

no_of_generators(25).
ordered_generators([1,2,3,4,5,6,7,8,9,10,11,12,13,
		    14,15,16,17,18,19,20,21,22,23,24,25]).
vs([1,2,3,4,5,6,7,8,9,10,11,12,13,
		    14,15,16,17,18,19,20,21,22,23,24,25]).

generator(N, Hypo) :-
	optiontypes(OptionTypes),
	nmember(OptionType, OptionTypes, N),
	options(OptionType, Options),
	nmember(Element, Hypo, N),
	member(Element, Options).

optiontypes([
	col,col,col,col,col,
	nat,nat,nat,nat,nat,
	pet,pet,pet,pet,pet,
	drk,drk,drk,drk,drk,
	smk,smk,smk,smk,smk]).

% Alphabetical order
options(col,[blue,green,ivory,red,yellow]).
options(nat,[english,japan,norway,spanish,ukran]).
options(pet,[dog,fox,horse,snails,zebra]).
options(drk,[coffee,milk,orange,tea,water]).
options(smk,[chest,gold,kools,lucky,parl]).

% ----------------------------------------------------------------------

text(1, 'A person/colour/pet/smoke/drink can''t be in more than one house').
text(2, 'The Norwegian should live in the first house').
text(3, 'The Norwegian should live next to the blue house').
text(4, 'Milk should be drunk in the middle house').
text(5, 'The Engishman should live in the red house').
text(6, 'Coffee should be drunk in the green house').
text(7, 'The Japanese should smoke Parliaments').
text(8, 'The lucky strike smoker should drink orange juice').
text(9,'Kools should be smoked in the house next to the house with the horse').
text(10, 'The green house should be immediately right of the ivory house').
text(11, 'The man who lives in the yellow house should smoke Kools').
text(12, 'The Old Gold smoker should keep snails').
text(13, 'The Ukrainian should drink tea').
text(14, 
     'Chesterfields should be smoked by the person who lives next to the fox').
text(15, 'The dog owner should be Spanish').

fails(H, VsInv,1):-vs(Vs), multiple_abodes(H, Vs, VsInv).
fails(H, VsInv,2):-vs(Vs), not_lives_at(norway, 6, H, Vs, VsInv).
fails(H, VsInv,3):-vs(Vs), lives_apart(nat=norway, col=blue, H, Vs, VsInv).
fails(H, VsInv,4):-vs(Vs), not_lives_at(milk, 18, H, Vs, VsInv).
fails(H, VsInv,5):-vs(Vs), not_same_house(nat=english, col=red, H, Vs, VsInv).
fails(H, VsInv,6):-vs(Vs), not_same_house(col=green, drk=coffee, H, Vs, VsInv).
fails(H, VsInv,7):-vs(Vs), not_same_house(nat=japan, smk=parl, H, Vs, VsInv).
fails(H, VsInv,8):-vs(Vs), not_same_house(smk=lucky, drk=orange, H, Vs, VsInv).
fails(H, VsInv,9):-vs(Vs), lives_apart(smk=kools, pet=horse, H, Vs, VsInv).
fails(H, VsInv,10):-vs(Vs), not_right_of(col=green, col=ivory, H, Vs, VsInv).
fails(H, VsInv,11):-vs(Vs), not_same_house(smk=kools, col=yellow, H, Vs,VsInv).
fails(H, VsInv,12):-vs(Vs), not_same_house(smk=gold, pet=snails, H, Vs, VsInv).
fails(H, VsInv,13):-vs(Vs), not_same_house(nat=ukran, drk=tea, H, Vs, VsInv).
fails(H, VsInv,14):-vs(Vs), lives_apart(smk=chest, pet=fox, H, Vs, VsInv).
fails(H, VsInv,15):-vs(Vs), not_same_house(nat=spanish, pet=dog, H, Vs, VsInv).

% -------------------- Constraint 1 --------------------

multiple_abodes(Hypo, Vs, [V1,V2]) :-
	get_bit(_, Vs, BitVs),
	dremove(X, Hypo, BitVs, V1, RestVs),
	dmember(X, Hypo, RestVs, V2).

dmember(X, Hypo, [V| _], V) :- valeq(V, Hypo, X).
dmember(X, Hypo, [_|Vs], V) :- dmember(X, Hypo, Vs, V).

dremove(X, Hypo, [V|Vs], V, Vs) :- valeq(V, Hypo, X).
dremove(X, Hypo, [V|Vs], V2, [V|RestVs]) :- dremove(X, Hypo, Vs, V2, RestVs).

% -------------------- Constraint 2, 4 --------------------

not_lives_at(Thing, Place, Hypo, Vs, [V]) :-
	dnmember(V, Vs, Place),
	valeq(V, Hypo, OtherThing),
	OtherThing \= Thing.

dnmember(Elem, List, N) :-
	dnmember(Elem, List, 1, N).

dnmember(Elem, [Elem|_], N, N).
dnmember(Elem, [_|List], NSoFar, N) :-
	dadd1(NSoFar, NewN),
	dnmember(Elem, List, NewN, N).

dadd1(1,2).	dadd1(2,3).	dadd1(3,4).	dadd1(4,5).
dadd1(5,6).	dadd1(6,7).	dadd1(7,8).	dadd1(8,9).
dadd1(9,10).	dadd1(10,11).	dadd1(11,12).	dadd1(12,13).
dadd1(13,14).	dadd1(14,15).	dadd1(15,16).	dadd1(16,17).
dadd1(17,18).	dadd1(18,19).	dadd1(19,20).	dadd1(20,21).
dadd1(21,22).	dadd1(22,23).	dadd1(23,24).	dadd1(24,25).

% -------------------- Constraint 3, 9, 14 ---------------

lives_apart(A1=Val1, A2=Val2, Hypo, Vs, [V1,V2]) :-
	get_bit(A1, Vs, V1s),
	get_bit(A2, Vs, V2s),
	dnmember(V1, V1s, P1), valeq(V1, Hypo, Val1),
	dnmember(V2, V2s, P2), valeq(V2, Hypo, Val2),
	not_neighbours(P1, P2).

get_bit(I, Vs, Bit) :-
	all_options(Is),
	get_bit(Is, I, Vs, Bit).

get_bit([I|_], I, [A,B,C,D,E|_], [A,B,C,D,E]).
get_bit([_|Is], I, [_,_,_,_,_|Rest], Bit) :-
	get_bit(Is, I, Rest, Bit).

all_options([col,nat,pet,drk,smk]).

not_neighbours(5, P) :- P \= 4.
not_neighbours(1, P) :- P \= 2.
not_neighbours(P, Q) :- 
	sdadd1(P, PPlus),
	sdsub1(P, PMinus),
	Q \= PPlus,
	Q \= PMinus.

sdadd1(1,2).
sdadd1(2,3).
sdadd1(3,4).
sdadd1(4,5).

sdsub1(A, B) :- sdadd1(B, A).

% ---------- Constraint 5, 6, 7, 8, 11, 12, 13, 15 ----------

not_same_house(A1=Val1, A2=Val2, Hypo, Vs, [V1,V2]) :-
	get_bit(A1, Vs, V1s),
	get_bit(A2, Vs, V2s),
	dnmember(V1, V1s, P1), valeq(V1, Hypo, Val1),
	dnmember(V2, V2s, P2), valeq(V2, Hypo, Val2),
	P1 \= P2.

% -------------------- Constraint 10 --------------------

% Val1 isn't to right of Val2
not_right_of(_, A2=Val2, Hypo, Vs, [V2]) :-  % is last house
	get_bit(A2, Vs, V2s),
	dnmember(V2, V2s, 5), 
	valeq(V2, Hypo, Val2).
not_right_of(A1=Val1, A2=Val2, Hypo, Vs, [V1,V2]) :-
	get_bit(A1, Vs, V1s),
	get_bit(A2, Vs, V2s),
	dnmember(V2, V2s, P2), valeq(V2, Hypo, Val2),
	dadd1(P2, P1),
	dnmember(V1, V1s, P1), valeq(V1, Hypo, ROfVal2),
	Val1 \= ROfVal2.

% ======================================================================

all_vals(1,[blue,green,ivory,red,yellow]).
all_vals(2,[blue,green,ivory,red,yellow]).
all_vals(3,[blue,green,ivory,red,yellow]).
all_vals(4,[blue,green,ivory,red,yellow]).
all_vals(5,[blue,green,ivory,red,yellow]).

all_vals(6,[english,japan,norway,spanish,ukran]).
all_vals(7,[english,japan,norway,spanish,ukran]).
all_vals(8,[english,japan,norway,spanish,ukran]).
all_vals(9,[english,japan,norway,spanish,ukran]).
all_vals(10,[english,japan,norway,spanish,ukran]).

all_vals(11,[dog,fox,horse,snails,zebra]).
all_vals(12,[dog,fox,horse,snails,zebra]).
all_vals(13,[dog,fox,horse,snails,zebra]).
all_vals(14,[dog,fox,horse,snails,zebra]).
all_vals(15,[dog,fox,horse,snails,zebra]).

all_vals(16,[coffee,milk,orange,tea,water]).
all_vals(17,[coffee,milk,orange,tea,water]).
all_vals(18,[coffee,milk,orange,tea,water]).
all_vals(19,[coffee,milk,orange,tea,water]).
all_vals(20,[coffee,milk,orange,tea,water]).

all_vals(21,[chest,gold,kools,lucky,parl]).
all_vals(22,[chest,gold,kools,lucky,parl]).
all_vals(23,[chest,gold,kools,lucky,parl]).
all_vals(24,[chest,gold,kools,lucky,parl]).
all_vals(25,[chest,gold,kools,lucky,parl]).

% ======================================================================

valeq(VNo, Vars, Val) :- dnmember(Val, Vars, VNo).

/*
soln([  yellow,blue,red,ivory,green,
	norway,ukran,english,spanish,japan,
	fox,horse,snails,dog,zebra,
	water,tea,milk,orange,coffee,
	kools,chest,gold,lucky,parl]).
*/

:- style_check(multiple).