%% translated into AR by N.F. Zhou, 2006
/*     
1.   The Englishman lives in the red house.
2.   The Spaniard owns the dog.
3.   Coffee is drunk in the green house.
4.   The Ukrainian drinks tea.
5.   The green house is immediately to the right of the ivory house.
6.   The Porsche driver owns snails.
7.   The Masserati is driven by the man who lives in the yellow house.
8.   Milk is drunk in the middle house.
9.   The Norwegian lives in the first house on the left.
10.  The man who drives a Saab lives in the house next to the man
     with the fox.
11.  The Masserati is driven by the man in the house next to the
     house where the horse is kept.
12.  The Honda driver drinks orange juice.
13.  The Japanese drives a Jaguar.
14.  The Norwegian lives next to the blue house.
*/

:-include('chr_lib.pl').

%%% domain(X,[]) <=> fail.
%%% domain(X,[V]) <=> X = V.
%%% domain(X,L1), domain(X,L2) <=> intersect(L1,L2,L3), domain(X,L3).
%%% diff(X,Y), domain(X,L) <=> nonvar(Y) | delete(L,Y,NL), domain(X,NL).

domain(X,Y):-
    new_constr_num(Cno),
    domain_r12(Flag,X,Y),
    Constr=domain(Cno,Flag,X,Y),
    %
    % CdDomain1 for rule "domain(X,L1), domain(X,L2) <=>..."
    % CdDomain2 for rule "diff(X,Y), domain(X,L)"
    Channels=[ChDomain1,ChDomain2,ChDiff],
    get_channels(domain_2,X,[ChDomain1,ChDomain2]),
    get_channels(diff_2,X,ChDiff),
    %
    post_event(ChDomain1,Constr),
    domain_r3(Cno,ChDomain1,Flag,X,Y),
    %
    (var(Flag)->post_event(ChDiff,Constr);true),
    domain_r4(Cno,ChDomain2,Flag,X,Y),
    %
    repost_domain_when_xy_instantiated(Flag,Channels,Constr,X,Y).

%%    Called when X in domain(X,Y) is instantiated
repost_domain_when_xy_instantiated(Flag,Channels,Constr,X,Y),var(Flag),
    {ins(Flag),ins(X),ins(Y)} 
=>
    Channels=[ChDomain1,ChDomain2,ChDiff],
    get_channels(domain_2,X,[ChDomain1,ChDomain2]),
    get_channels(diff_2,X,ChDiff),
    %
    post_event(ChDomain1,Constr),
    %
    (var(Flag)->post_event(ChDiff,Constr);true).
repost_domain_when_xy_instantiated(Flag,Channels,Constr,X,Y) => true.

%%% domain(X,[]) <=> fail.
%%% domain(X,[V]) <=> X = V.
domain_r12(Flag,X,Y),var(Flag),{generated,ins(Y)} => 
    (Y==[]->fail;
     nonvar(Y),Y=[V]->Flag=1,X=V;
     true).
domain_r12(Flag,X,Y) => true.

%%% domain(X,L1), domain(X,L2) <=> intersect(L1,L2,L3), domain(X,L3).
:-determinate intersect/3,domain/2.
domain_r3(Cno,C,Flag,X1,L1),var(Flag),{event(C,Q),ins(Flag)} =>
    Q=domain(CnoQ,FlagQ,X2,L2),
    (var(FlagQ),CnoQ=\=Cno->
     (X1==X2 ->Flag=1,FlagQ=1,intersect(L1,L2,L3),domain(X1,L3);true)
     ;
     true).
domain_r3(Cno,C,Flag,X1,L1) => true.

%%% domain(X,L), diff(X,Y)  <=> nonvar(Y) | delete(L,Y,NL), domain(X,NL).
:-determinate delete/3,domain/2.
domain_r4(Cno,C,Flag,X1,L),var(Flag),{event(C,Q),ins(Flag)} =>
     Q=diff(CnoQ,FlagQ,X2,V),
     (var(FlagQ)->
      (X1==X2,nonvar(V) -> Flag=1,FlagQ=1,delete(L,V,NL), domain(X1,NL);true)
      ;
      true).
domain_r4(Cno,C,Flag,X1,L) => true.


%%% diff(X,Y), domain(X,L) <=> nonvar(Y) | delete(L,Y,NL), domain(X,NL).
%%% diff(X,Y) <=> nonvar(X), nonvar(Y) | X \== Y.
diff(X,Y):-
    new_constr_num(Cno),
    Constr=diff(Cno,Flag,X,Y),
    %
    Channels=[ChDomain1,ChDomain2,ChDiff],
    get_channels(domain_2,X,[ChDomain1,ChDomain2]),
    get_channels(diff_2,X,ChDiff),
    %
    post_event(ChDomain2,Constr),
    diff_r1(Cno,ChDiff,Flag,X,Y),
    %
    diff_r2(Flag,X,Y),
    %
    repost_diff_when_xy_instantiated(Flag,Channels,Constr,X,Y).

%%    Called when X or Y in diff(X,Y) is instantiated
repost_diff_when_xy_instantiated(Flag,Channels,Constr,X,Y),var(Flag),
    {ins(Flag),ins(X),ins(Y)} 
=>
    Channels=[ChDomain1,ChDomain2,ChDiff],
    get_channels(domain_2,X,[ChDomain1,ChDomain2]),
    post_event(ChDomain2,Constr).
repost_diff_when_xy_instantiated(Flag,Channels,Constr,X,Y) => true.

%%% diff(X,Y), domain(X,L) <=> nonvar(Y) | delete(L,Y,NL), domain(X,NL).
diff_r1(Cno,C,Flag,X1,V),var(Flag),{event(C,Q),ins(Flag)} =>
     Q=domain(CnoQ,FlagQ,X2,L),
    (var(FlagQ)->
     (X1==X2,nonvar(V)->Flag=1,FlagQ=1,delete(L,V,NL), domain(X1,NL);true)
     ;
     true).
diff_r1(Cno,C,Flag,X1,L) => true.

%%% diff(X,Y) <=> nonvar(X), nonvar(Y) | X \== Y.
diff_r2(Flag,X,Y),var(Flag),{generated,ins(X),ins(Y),ins(Flag)} => 
    (nonvar(X),nonvar(Y)->Flag=1,X\==Y;true).
diff_r2(Flag,X,Y) => true.

my_all_different([]). 
my_all_different([H|T]) :-
	my_all_different(T,H),
	my_all_different(T).

my_all_different([],_).
my_all_different([H|T],E) :-
	diff(H,E),
	diff(E,H),
	my_all_different(T,E).
	
main :-
	main(10).

main(N):-
	cputime(X),
	test(N),
	cputime( Now),
	Time is Now-X,
	write(bench(zebra, N,Time,0,bp_ar)), write('.'),nl.

test:-test(1).

test(N) :-
    ( N > 0 ->
	  not(not(solve)),!,
	  M is N - 1,
	  test(M)
      ;
         true
      ).

solve :-
	[ [ ACo, AN, ACa, AD, AP ],
	  [ BCo, BN, BCa, BD, BP ],
	  [ CCo, CN, CCa, CD, CP ],
	  [ DCo, DN, DCa, DD, DP ],
	  [ ECo, EN, ECa, ED, EP ] ] = S,
	domain(ACo,[red,green,ivory,yellow,blue]),
	domain(BCo,[red,green,ivory,yellow,blue]),
	domain(CCo,[red,green,ivory,yellow,blue]),
	domain(DCo,[red,green,ivory,yellow,blue]),
	domain(ECo,[red,green,ivory,yellow,blue]),
	domain(AN ,[english,spanish,ukranian,norwegian,japanese]),
	domain(BN ,[english,spanish,ukranian,norwegian,japanese]),
	domain(CN ,[english,spanish,ukranian,norwegian,japanese]),
	domain(DN ,[english,spanish,ukranian,norwegian,japanese]),
	domain(EN ,[english,spanish,ukranian,norwegian,japanese]),
	domain(ACa,[porsche,masserati,saab,honda,jaguar]),
	domain(BCa,[porsche,masserati,saab,honda,jaguar]),
	domain(CCa,[porsche,masserati,saab,honda,jaguar]),
	domain(DCa,[porsche,masserati,saab,honda,jaguar]),
	domain(ECa,[porsche,masserati,saab,honda,jaguar]),
	domain(AD ,[coffee,tea,milk,orange,water]),
	domain(BD ,[coffee,tea,milk,orange,water]),
	domain(CD ,[coffee,tea,milk,orange,water]),
	domain(DD ,[coffee,tea,milk,orange,water]),
	domain(ED ,[coffee,tea,milk,orange,water]),
	domain(AP ,[dog,snails,fox,horse,zebra]),
	domain(BP ,[dog,snails,fox,horse,zebra]),
	domain(CP ,[dog,snails,fox,horse,zebra]),
	domain(DP ,[dog,snails,fox,horse,zebra]),
	domain(EP ,[dog,snails,fox,horse,zebra]),
	my_all_different([ACo,BCo,CCo,DCo,ECo]),
	my_all_different([AN ,BN ,CN ,DN ,EN ]),
	my_all_different([ACa,BCa,CCa,DCa,ECa]),
	my_all_different([AD ,BD ,CD ,DD ,ED ]),
	my_all_different([AP ,BP ,CP ,DP ,EP ]),
	[_,_,[_,_,_,milk,_],_,_]           = S,  % clue 8
        [[_,norwegian,_,_,_],_,_,_,_]      = S , % clue 9
        member( [green,_,_,coffee,_],                S), % clue 3
        member( [red,english,_,_,_],              S), % clue 1
        member( [_,ukranian,_,tea,_],                S), % clue 4
        member( [yellow,_,masserati,_,_],            S), % clue 7
        member( [_,_,honda,orange,_],          S), % clue 12
        member( [_,japanese,jaguar,_,_],             S), % clue 13
        member( [_,spanish,_,_,dog],                S), % clue 2
        member( [_,_,porsche,_,snails],              S), % clue 6
        left_right( [ivory,_,_,_,_],    [green,_,_,_,_], S), % clue 5
        next_to( [_,norwegian,_,_,_],[blue,_,_,_,_],  S), % clue 14
        next_to( [_,_,masserati,_,_],[_,_,_,_,horse], S), % clue 11
        next_to( [_,_,saab,_,_],     [_,_,_,_,fox],   S), % clue 10
        writeln(S),
	true.



% left_right(L, R, X) is true when L is to the immediate left of R in list X

left_right(L, R, [L, R | _]).

left_right(L, R, [_ | X]) :- left_right(L, R, X).


% next_to(X, Y, L) is true when X and Y are next to each other in list L

next_to(X, Y, L) :- left_right(X, Y, L).

next_to(X, Y, L) :- left_right(Y, X, L).

delete([], _, []) :- !.
delete([Elem|Tail], Elem, Result) :- !, 
	delete(Tail, Elem, Result).
delete([Head|Tail], Elem, [Head|Rest]) :-
	delete(Tail, Elem, Rest).

intersect(X,Y,Z) :- writeln(intersect(X,Y,Z)),fail.
intersect([], _, []) :- !.
intersect([X|T], L, Intersect) :-
	member(X, L), !, 
	Intersect = [X|R], 
	intersect(T, L, R).
intersect([_|T], L, R) :-
	intersect(T, L, R).