Benchmarks/zebra.chr

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