Tests/zebra.chr

   1 :- module(zebra,[zebra/0]).
   2 :- use_module(library(chr)).
   3
   4 :- use_module(library(lists)).
   5
   6 /*
   7 1.   The Englishman lives in the red house.
   8 2.   The Spaniard owns the dog.
   9 3.   Coffee is drunk in the green house.
  10 4.   The Ukrainian drinks tea.
  11 5.   The green house is immediately to the right of the ivory house.
  12 6.   The Porsche driver owns snails.
  13 7.   The Masserati is driven by the man who lives in the yellow house.
  14 8.   Milk is drunk in the middle house.
  15 9.   The Norwegian lives in the first house on the left.
  16 10.  The man who drives a Saab lives in the house next to the man
  17      with the fox.
  18 11.  The Masserati is driven by the man in the house next to the
  19      house where the horse is kept.
  20 12.  The Honda driver drinks orange juice.
  21 13.  The Japanese drives a Jaguar.
  22 14.  The Norwegian lives next to the blue house.
  23 */
  24
  25 :- chr_constraint domain/2, diff/2, cleanup/0.
  26
  27 zebra :-
  28         solve(Solution),
  29         cleanup,
  30         Solution == [[yellow,norwegian,masserati,water,fox],[blue,ukranian,saab,tea,horse],[red,english,porsche,milk,snails],[ivory,spanish,honda,orange,dog],[green,japanese,jaguar,coffee,zebra]].
  31
  32 domain(_X,[]) <=> fail.
  33 domain(X,[V]) <=> X = V.
  34 domain(X,L1), domain(X,L2) <=> intersection(L1,L2,L3), domain(X,L3).
  35
  36 diff(X,Y), domain(X,L) <=> nonvar(Y) | select(Y,L,NL), domain(X,NL).
  37 diff(X,Y) <=> nonvar(X), nonvar(Y) | X \== Y.
  38
  39 cleanup, domain(_,_) <=> writeln(a), fail.
  40 cleanup, diff(_,_) <=> writeln(b), fail.
  41 cleanup <=> true.
  42
  43 all_different([]).
  44 all_different([H|T]) :-
  45         all_different(T,H),
  46         all_different(T).
  47
  48 all_different([],_).
  49 all_different([H|T],E) :-
  50         diff(H,E),
  51         diff(E,H),
  52         all_different(T,E).
  53
  54 solve(S) :-
  55         [ [ ACo, AN, ACa, AD, AP ],
  56           [ BCo, BN, BCa, BD, BP ],
  57           [ CCo, CN, CCa, CD, CP ],
  58           [ DCo, DN, DCa, DD, DP ],
  59           [ ECo, EN, ECa, ED, EP ] ] = S,
  60         domain(ACo,[red,green,ivory,yellow,blue]),
  61         domain(BCo,[red,green,ivory,yellow,blue]),
  62         domain(CCo,[red,green,ivory,yellow,blue]),
  63         domain(DCo,[red,green,ivory,yellow,blue]),
  64         domain(ECo,[red,green,ivory,yellow,blue]),
  65         domain(AN ,[english,spanish,ukranian,norwegian,japanese]),
  66         domain(BN ,[english,spanish,ukranian,norwegian,japanese]),
  67         domain(CN ,[english,spanish,ukranian,norwegian,japanese]),
  68         domain(DN ,[english,spanish,ukranian,norwegian,japanese]),
  69         domain(EN ,[english,spanish,ukranian,norwegian,japanese]),
  70         domain(ACa,[porsche,masserati,saab,honda,jaguar]),
  71         domain(BCa,[porsche,masserati,saab,honda,jaguar]),
  72         domain(CCa,[porsche,masserati,saab,honda,jaguar]),
  73         domain(DCa,[porsche,masserati,saab,honda,jaguar]),
  74         domain(ECa,[porsche,masserati,saab,honda,jaguar]),
  75         domain(AD ,[coffee,tea,milk,orange,water]),
  76         domain(BD ,[coffee,tea,milk,orange,water]),
  77         domain(CD ,[coffee,tea,milk,orange,water]),
  78         domain(DD ,[coffee,tea,milk,orange,water]),
  79         domain(ED ,[coffee,tea,milk,orange,water]),
  80         domain(AP ,[dog,snails,fox,horse,zebra]),
  81         domain(BP ,[dog,snails,fox,horse,zebra]),
  82         domain(CP ,[dog,snails,fox,horse,zebra]),
  83         domain(DP ,[dog,snails,fox,horse,zebra]),
  84         domain(EP ,[dog,snails,fox,horse,zebra]),
  85         all_different([ACo,BCo,CCo,DCo,ECo]),
  86         all_different([AN ,BN ,CN ,DN ,EN ]),
  87         all_different([ACa,BCa,CCa,DCa,ECa]),
  88         all_different([AD ,BD ,CD ,DD ,ED ]),
  89         all_different([AP ,BP ,CP ,DP ,EP ]),
  90         [_,_,[_,_,_,milk,_],_,_]           = S,  % clue 8
  91         [[_,norwegian,_,_,_],_,_,_,_]      = S , % clue 9
  92         member( [green,_,_,coffee,_],                S), % clue 3
  93         member( [red,english,_,_,_],              S), % clue 1
  94         member( [_,ukranian,_,tea,_],                S), % clue 4
  95         member( [yellow,_,masserati,_,_],            S), % clue 7
  96         member( [_,_,honda,orange,_],          S), % clue 12
  97         member( [_,japanese,jaguar,_,_],             S), % clue 13
  98         member( [_,spanish,_,_,dog],                S), % clue 2
  99         member( [_,_,porsche,_,snails],              S), % clue 6
 100         left_right( [ivory,_,_,_,_],    [green,_,_,_,_], S), % clue 5
 101         next_to( [_,norwegian,_,_,_],[blue,_,_,_,_],  S), % clue 14
 102         next_to( [_,_,masserati,_,_],[_,_,_,_,horse], S), % clue 11
 103         next_to( [_,_,saab,_,_],     [_,_,_,_,fox],   S), % clue 10
 104         true.
 105
 106 % left_right(L, R, X) is true when L is to the immediate left of R in list X
 107
 108 left_right(L, R, [L, R | _]).
 109
 110 left_right(L, R, [_ | X]) :- left_right(L, R, X).
 111
 112
 113 % next_to(X, Y, L) is true when X and Y are next to each other in list L
 114
 115 next_to(X, Y, L) :- left_right(X, Y, L).
 116
 117 next_to(X, Y, L) :- left_right(Y, X, L).