Zebra puzzle

From Rosetta Code
Jump to: navigation, search
Task
Zebra puzzle
You are encouraged to solve this task according to the task description, using any language you may know.

The Zebra puzzle, a.k.a. Einstein's Riddle, is a logic puzzle which is to be solved programmatically. It has several variants, one of them this:

  1. There are five houses.
  2. The English man lives in the red house.
  3. The Swede has a dog.
  4. The Dane drinks tea.
  5. The green house is immediately to the left of the white house.
  6. They drink coffee in the green house.
  7. The man who smokes Pall Mall has birds.
  8. In the yellow house they smoke Dunhill.
  9. In the middle house they drink milk.
  10. The Norwegian lives in the first house.
  11. The man who smokes Blend lives in the house next to the house with cats.
  12. In a house next to the house where they have a horse, they smoke Dunhill.
  13. The man who smokes Blue Master drinks beer.
  14. The German smokes Prince.
  15. The Norwegian lives next to the blue house.
  16. They drink water in a house next to the house where they smoke Blend.

The question is, who owns the zebra?

Additionally, list the solution for all the houses. Optionally, show the solution is unique.

cf. Dinesman's multiple-dwelling problem

Contents

[edit] Ada

Not the prettiest Ada, but its simple and very fast. Similar to my Dinesman's code, uses enums to keep things readable.

with Ada.Text_IO; use Ada.Text_IO;
procedure Zebra is
type Content is (Beer, Coffee, Milk, Tea, Water,
Danish, English, German, Norwegian, Swedish,
Blue, Green, Red, White, Yellow,
Blend, BlueMaster, Dunhill, PallMall, Prince,
Bird, Cat, Dog, Horse, Zebra);
type Test is (Drink, Person, Color, Smoke, Pet);
type House is (One, Two, Three, Four, Five);
type Street is array (Test'Range, House'Range) of Content;
type Alley is access all Street;
 
procedure Print (mat : Alley) is begin
for H in House'Range loop
Put(H'Img&": ");
for T in Test'Range loop
Put(T'Img&"="&mat(T,H)'Img&" ");
end loop; New_Line; end loop;
end Print;
 
function FinalChecks (mat : Alley) return Boolean is
function Diff (A, B : Content; CA , CB : Test) return Integer is begin
for H1 in House'Range loop for H2 in House'Range loop
if mat(CA,H1) = A and mat(CB,H2) = B then
return House'Pos(H1) - House'Pos(H2);
end if;
end loop; end loop;
end Diff;
begin
if abs(Diff(Norwegian, Blue, Person, Color)) = 1
and Diff(Green, White, Color, Color) = -1
and abs(Diff(Horse, Dunhill, Pet, Smoke)) = 1
and abs(Diff(Water, Blend, Drink, Smoke)) = 1
and abs(Diff(Blend, Cat, Smoke, Pet)) = 1
then return True;
end if;
return False;
end FinalChecks;
 
function Constrained (mat : Alley; atest : Natural) return Boolean is begin
-- Tests seperated into levels for speed, not strictly necessary
-- As such, the program finishes in around ~0.02s
case Test'Val (atest) is
when Drink => -- Drink
if mat (Drink, Three) /= Milk then return False; end if;
return True;
when Person => -- Drink+Person
for H in House'Range loop
if (mat(Person,H) = Norwegian and H /= One)
or (mat(Person,H) = Danish and mat(Drink,H) /= Tea)
then return False; end if;
end loop;
return True;
when Color => -- Drink+People+Color
for H in House'Range loop
if (mat(Person,H) = English and mat(Color,H) /= Red)
or (mat(Drink,H) = Coffee and mat(Color,H) /= Green)
then return False; end if;
end loop;
return True;
when Smoke => -- Drink+People+Color+Smoke
for H in House'Range loop
if (mat(Color,H) = Yellow and mat(Smoke,H) /= Dunhill)
or (mat(Smoke,H) = BlueMaster and mat(Drink,H) /= Beer)
or (mat(Person,H) = German and mat(Smoke,H) /= Prince)
then return False; end if;
end loop;
return True;
when Pet => -- Drink+People+Color+Smoke+Pet
for H in House'Range loop
if (mat(Person,H) = Swedish and mat(Pet,H) /= Dog)
or (mat(Smoke,H) = PallMall and mat(Pet,H) /= Bird)
then return False; end if;
end loop;
return FinalChecks(mat); -- Do the next-to checks
end case;
end Constrained;
 
procedure Solve (mat : Alley; t, n : Natural) is
procedure Swap (I, J : Natural) is
temp : constant Content := mat (Test'Val (t), House'Val (J));
begin
mat (Test'Val (t), House'Val (J)) := mat (Test'Val (t), House'Val (I));
mat (Test'Val (t), House'Val (I)) := temp;
end Swap;
begin
if n = 1 and Constrained (mat, t) then -- test t passed
if t < 4 then Solve (mat, t + 1, 5); -- Onto next test
else Print (mat); return; -- Passed and t=4 means a solution
end if;
end if;
for i in 0 .. n - 1 loop -- The permutations part
Solve (mat, t, n - 1);
if n mod 2 = 1 then Swap (0, n - 1);
else Swap (i, n - 1); end if;
end loop;
end Solve;
 
myStreet : aliased Street;
myAlley : constant Alley := myStreet'Access;
begin
for i in Test'Range loop for j in House'Range loop -- Init Matrix
myStreet (i,j) := Content'Val(Test'Pos(i)*5 + House'Pos(j));
end loop; end loop;
Solve (myAlley, 0, 5); -- start at test 0 with 5 options
end Zebra;
Output:
ONE: DRINK=WATER PERSON=NORWEGIAN COLOR=YELLOW SMOKE=DUNHILL PET=CAT 
TWO: DRINK=TEA PERSON=DANISH COLOR=BLUE SMOKE=BLEND PET=HORSE 
THREE: DRINK=MILK PERSON=ENGLISH COLOR=RED SMOKE=PALLMALL PET=BIRD 
FOUR: DRINK=COFFEE PERSON=GERMAN COLOR=GREEN SMOKE=PRINCE PET=ZEBRA 
FIVE: DRINK=BEER PERSON=SWEDISH COLOR=WHITE SMOKE=BLUEMASTER PET=DOG

[edit] AutoHotkey

See Dinesman's multiple-dwelling problem/AutoHotkey.

[edit] BBC BASIC

      REM The names (only used for printing the results):
DIM Drink$(4), Nation$(4), Colr$(4), Smoke$(4), Animal$(4)
Drink$() = "Beer", "Coffee", "Milk", "Tea", "Water"
Nation$() = "Denmark", "England", "Germany", "Norway", "Sweden"
Colr$() = "Blue", "Green", "Red", "White", "Yellow"
Smoke$() = "Blend", "BlueMaster", "Dunhill", "PallMall", "Prince"
Animal$() = "Birds", "Cats", "Dog", "Horse", "Zebra"
 
REM Some single-character tags:
a$ = "A" : b$ = "B" : c$ = "C" : d$ = "D" : e$ = "E"
 
REM BBC BASIC Doesn't have enumerations!
Beer$=a$  : Coffee$=b$  : Milk$=c$  : Tea$=d$  : Water$=e$
Denmark$=a$ : England$=b$  : Germany$=c$ : Norway$=d$  : Sweden$=e$
Blue$=a$  : Green$=b$  : Red$=c$  : White$=d$  : Yellow$=e$
Blend$=a$  : BlueMaster$=b$ : Dunhill$=c$ : PallMall$=d$ : Prince$=e$
Birds$=a$  : Cats$=b$  : Dog$=c$  : Horse$=d$  : Zebra$=e$
 
REM Create the 120 permutations of 5 objects:
DIM perm$(120), x$(4) : x$() = a$, b$, c$, d$, e$
REPEAT
p% += 1
perm$(p%) = x$(0)+x$(1)+x$(2)+x$(3)+x$(4)
UNTIL NOT FNperm(x$())
 
REM Express the statements as conditional expressions:
ex2$ = "INSTR(Nation$,England$) = INSTR(Colr$,Red$)"
ex3$ = "INSTR(Nation$,Sweden$) = INSTR(Animal$,Dog$)"
ex4$ = "INSTR(Nation$,Denmark$) = INSTR(Drink$,Tea$)"
ex5$ = "INSTR(Colr$,Green$+White$) <> 0"
ex6$ = "INSTR(Drink$,Coffee$) = INSTR(Colr$,Green$)"
ex7$ = "INSTR(Smoke$,PallMall$) = INSTR(Animal$,Birds$)"
ex8$ = "INSTR(Smoke$,Dunhill$) = INSTR(Colr$,Yellow$)"
ex9$ = "MID$(Drink$,3,1) = Milk$"
ex10$ = "LEFT$(Nation$,1) = Norway$"
ex11$ = "ABS(INSTR(Smoke$,Blend$)-INSTR(Animal$,Cats$)) = 1"
ex12$ = "ABS(INSTR(Smoke$,Dunhill$)-INSTR(Animal$,Horse$)) = 1"
ex13$ = "INSTR(Smoke$,BlueMaster$) = INSTR(Drink$,Beer$)"
ex14$ = "INSTR(Nation$,Germany$) = INSTR(Smoke$,Prince$)"
ex15$ = "ABS(INSTR(Nation$,Norway$)-INSTR(Colr$,Blue$)) = 1"
ex16$ = "ABS(INSTR(Smoke$,Blend$)-INSTR(Drink$,Water$)) = 1"
 
REM Solve:
solutions% = 0
TIME = 0
FOR nation% = 1 TO 120
Nation$ = perm$(nation%)
IF EVAL(ex10$) THEN
FOR colr% = 1 TO 120
Colr$ = perm$(colr%)
IF EVAL(ex5$) IF EVAL(ex2$) IF EVAL(ex15$) THEN
FOR drink% = 1 TO 120
Drink$ = perm$(drink%)
IF EVAL(ex9$) IF EVAL(ex4$) IF EVAL(ex6$) THEN
FOR smoke% = 1 TO 120
Smoke$ = perm$(smoke%)
IF EVAL(ex14$) IF EVAL(ex13$) IF EVAL(ex16$) IF EVAL(ex8$) THEN
FOR animal% = 1 TO 120
Animal$ = perm$(animal%)
IF EVAL(ex3$) IF EVAL(ex7$) IF EVAL(ex11$) IF EVAL(ex12$) THEN
PRINT "House Drink Nation Colour Smoke Animal"
FOR house% = 1 TO 5
PRINT ; house% ,;
PRINT Drink$(ASCMID$(Drink$,house%)-65),;
PRINT Nation$(ASCMID$(Nation$,house%)-65),;
PRINT Colr$(ASCMID$(Colr$,house%)-65),;
PRINT Smoke$(ASCMID$(Smoke$,house%)-65),;
PRINT Animal$(ASCMID$(Animal$,house%)-65)
NEXT
solutions% += 1
ENDIF
NEXT animal%
ENDIF
NEXT smoke%
ENDIF
NEXT drink%
ENDIF
NEXT colr%
ENDIF
NEXT nation%
PRINT '"Number of solutions = "; solutions%
PRINT "Solved in " ; TIME/100 " seconds"
END
 
DEF FNperm(x$())
LOCAL i%, j%
FOR i% = DIM(x$(),1)-1 TO 0 STEP -1
IF x$(i%) < x$(i%+1) EXIT FOR
NEXT
IF i% < 0 THEN = FALSE
j% = DIM(x$(),1)
WHILE x$(j%) <= x$(i%) j% -= 1 : ENDWHILE
SWAP x$(i%), x$(j%)
i% += 1
j% = DIM(x$(),1)
WHILE i% < j%
SWAP x$(i%), x$(j%)
i% += 1
j% -= 1
ENDWHILE
= TRUE

Output:

House     Drink     Nation    Colour    Smoke     Animal
1         Water     Norway    Yellow    Dunhill   Cats
2         Tea       Denmark   Blue      Blend     Horse
3         Milk      England   Red       PallMall  Birds
4         Coffee    Germany   Green     Prince    Zebra
5         Beer      Sweden    White     BlueMasterDog

Number of solutions = 1
Solved in 0.12 seconds

[edit] C

#include <stdio.h>
#include <string.h>
 
enum HouseStatus { Invalid, Underfull, Valid };
 
enum Attrib { C, M, D, A, S };
 
// Unfilled attributes are represented by -1
enum Colors { Red, Green, White, Yellow, Blue };
enum Mans { English, Swede, Dane, German, Norwegian };
enum Drinks { Tea, Coffee, Milk, Beer, Water };
enum Animals { Dog, Birds, Cats, Horse, Zebra };
enum Smokes { PallMall, Dunhill, Blend, BlueMaster, Prince };
 
 
void printHouses(int ha[5][5]) {
const char *color[] = { "Red", "Green", "White", "Yellow", "Blue" };
const char *man[] = { "English", "Swede", "Dane", "German", "Norwegian" };
const char *drink[] = { "Tea", "Coffee", "Milk", "Beer", "Water" };
const char *animal[] = { "Dog", "Birds", "Cats", "Horse", "Zebra" };
const char *smoke[] = { "PallMall", "Dunhill", "Blend", "BlueMaster", "Prince" };
 
printf("%-10.10s%-10.10s%-10.10s%-10.10s%-10.10s%-10.10s\n",
"House", "Color", "Man", "Drink", "Animal", "Smoke");
 
for (int i = 0; i < 5; i++) {
printf("%-10d", i);
if (ha[i][C] >= 0)
printf("%-10.10s", color[ha[i][C]]);
else
printf("%-10.10s", "-");
if (ha[i][M] >= 0)
printf("%-10.10s", man[ha[i][M]]);
else
printf("%-10.10s", "-");
if (ha[i][D] >= 0)
printf("%-10.10s", drink[ha[i][D]]);
else
printf("%-10.10s", "-");
if (ha[i][A] >= 0)
printf("%-10.10s", animal[ha[i][A]]);
else
printf("%-10.10s", "-");
if (ha[i][S] >= 0)
printf("%-10.10s\n", smoke[ha[i][S]]);
else
printf("-\n");
}
}
 
 
int checkHouses(int ha[5][5]) {
int c_add = 0, c_or = 0;
int m_add = 0, m_or = 0;
int d_add = 0, d_or = 0;
int a_add = 0, a_or = 0;
int s_add = 0, s_or = 0;
 
// Cond 9: In the middle house they drink milk.
if (ha[2][D] >= 0 && ha[2][D] != Milk)
return Invalid;
 
// Cond 10: The Norwegian lives in the first house.
if (ha[0][M] >= 0 && ha[0][M] != Norwegian)
return Invalid;
 
for (int i = 0; i < 5; i++) {
// Uniqueness tests.
if (ha[i][C] >= 0) {
c_add += (1 << ha[i][C]);
c_or |= (1 << ha[i][C]);
}
if (ha[i][M] >= 0) {
m_add += (1 << ha[i][M]);
m_or |= (1 << ha[i][M]);
}
if (ha[i][D] >= 0) {
d_add += (1 << ha[i][D]);
d_or |= (1 << ha[i][D]);
}
if (ha[i][A] >= 0) {
a_add += (1 << ha[i][A]);
a_or |= (1 << ha[i][A]);
}
if (ha[i][S] >= 0) {
s_add += (1 << ha[i][S]);
s_or |= (1 << ha[i][S]);
}
 
// Cond 2: The English man lives in the red house.
if ((ha[i][M] >= 0 && ha[i][C] >= 0) &&
((ha[i][M] == English && ha[i][C] != Red) || // Checking both
(ha[i][M] != English && ha[i][C] == Red))) // to make things quicker.
return Invalid;
 
// Cond 3: The Swede has a dog.
if ((ha[i][M] >= 0 && ha[i][A] >= 0) &&
((ha[i][M] == Swede && ha[i][A] != Dog) ||
(ha[i][M] != Swede && ha[i][A] == Dog)))
return Invalid;
 
// Cond 4: The Dane drinks tea.
if ((ha[i][M] >= 0 && ha[i][D] >= 0) &&
((ha[i][M] == Dane && ha[i][D] != Tea) ||
(ha[i][M] != Dane && ha[i][D] == Tea)))
return Invalid;
 
// Cond 5: The green house is immediately to the left of the white house.
if ((i > 0 && ha[i][C] >= 0 /*&& ha[i-1][C] >= 0 */ ) &&
((ha[i - 1][C] == Green && ha[i][C] != White) ||
(ha[i - 1][C] != Green && ha[i][C] == White)))
return Invalid;
 
// Cond 6: drink coffee in the green house.
if ((ha[i][C] >= 0 && ha[i][D] >= 0) &&
((ha[i][C] == Green && ha[i][D] != Coffee) ||
(ha[i][C] != Green && ha[i][D] == Coffee)))
return Invalid;
 
// Cond 7: The man who smokes Pall Mall has birds.
if ((ha[i][S] >= 0 && ha[i][A] >= 0) &&
((ha[i][S] == PallMall && ha[i][A] != Birds) ||
(ha[i][S] != PallMall && ha[i][A] == Birds)))
return Invalid;
 
// Cond 8: In the yellow house they smoke Dunhill.
if ((ha[i][S] >= 0 && ha[i][C] >= 0) &&
((ha[i][S] == Dunhill && ha[i][C] != Yellow) ||
(ha[i][S] != Dunhill && ha[i][C] == Yellow)))
return Invalid;
 
// Cond 11: The man who smokes Blend lives in the house next to the house with cats.
if (ha[i][S] == Blend) {
if (i == 0 && ha[i + 1][A] >= 0 && ha[i + 1][A] != Cats)
return Invalid;
else if (i == 4 && ha[i - 1][A] != Cats)
return Invalid;
else if (ha[i + 1][A] >= 0 && ha[i + 1][A] != Cats && ha[i - 1][A] != Cats)
return Invalid;
}
 
// Cond 12: In a house next to the house where they have a horse, they smoke Dunhill.
if (ha[i][S] == Dunhill) {
if (i == 0 && ha[i + 1][A] >= 0 && ha[i + 1][A] != Horse)
return Invalid;
else if (i == 4 && ha[i - 1][A] != Horse)
return Invalid;
else if (ha[i + 1][A] >= 0 && ha[i + 1][A] != Horse && ha[i - 1][A] != Horse)
return Invalid;
}
 
// Cond 13: The man who smokes Blue Master drinks beer.
if ((ha[i][S] >= 0 && ha[i][D] >= 0) &&
((ha[i][S] == BlueMaster && ha[i][D] != Beer) ||
(ha[i][S] != BlueMaster && ha[i][D] == Beer)))
return Invalid;
 
// Cond 14: The German smokes Prince
if ((ha[i][M] >= 0 && ha[i][S] >= 0) &&
((ha[i][M] == German && ha[i][S] != Prince) ||
(ha[i][M] != German && ha[i][S] == Prince)))
return Invalid;
 
// Cond 15: The Norwegian lives next to the blue house.
if (ha[i][M] == Norwegian &&
((i < 4 && ha[i + 1][C] >= 0 && ha[i + 1][C] != Blue) ||
(i > 0 && ha[i - 1][C] != Blue)))
return Invalid;
 
// Cond 16: They drink water in a house next to the house where they smoke Blend.
if (ha[i][S] == Blend) {
if (i == 0 && ha[i + 1][D] >= 0 && ha[i + 1][D] != Water)
return Invalid;
else if (i == 4 && ha[i - 1][D] != Water)
return Invalid;
else if (ha[i + 1][D] >= 0 && ha[i + 1][D] != Water && ha[i - 1][D] != Water)
return Invalid;
}
 
}
 
if ((c_add != c_or) || (m_add != m_or) || (d_add != d_or)
|| (a_add != a_or) || (s_add != s_or)) {
return Invalid;
}
 
if ((c_add != 0b11111) || (m_add != 0b11111) || (d_add != 0b11111)
|| (a_add != 0b11111) || (s_add != 0b11111)) {
return Underfull;
}
 
return Valid;
}
 
 
int bruteFill(int ha[5][5], int hno, int attr) {
int stat = checkHouses(ha);
if ((stat == Valid) || (stat == Invalid))
return stat;
 
int hb[5][5];
memcpy(hb, ha, sizeof(int) * 5 * 5);
for (int i = 0; i < 5; i++) {
hb[hno][attr] = i;
stat = checkHouses(hb);
if (stat != Invalid) {
int nexthno, nextattr;
if (attr < 4) {
nextattr = attr + 1;
nexthno = hno;
} else {
nextattr = 0;
nexthno = hno + 1;
}
 
stat = bruteFill(hb, nexthno, nextattr);
if (stat != Invalid) {
memcpy(ha, hb, sizeof(int) * 5 * 5);
return stat;
}
}
}
 
// We only come here if none of the attr values assigned were valid.
return Invalid;
}
 
 
int main() {
int ha[5][5] = {{-1, -1, -1, -1, -1}, {-1, -1, -1, -1, -1},
{-1, -1, -1, -1, -1}, {-1, -1, -1, -1, -1},
{-1, -1, -1, -1, -1}};
 
bruteFill(ha, 0, 0);
printHouses(ha);
 
return 0;
}
Output:
% gcc -Wall -O3 -std=c99 zebra.c -o zebra && time ./zebra
House     Color     Man       Drink     Animal    Smoke     
0         Yellow    Norwegian Water     Cats      Dunhill   
1         Blue      Dane      Tea       Horse     Blend     
2         Red       English   Milk      Birds     PallMall  
3         Green     German    Coffee    Zebra     Prince    
4         White     Swede     Beer      Dog       BlueMaster
./zebra  0.00s user 0.00s system 0% cpu 0.002 total

The execution time is too small to be reliably measured on my machine.

[edit] C Generated from Perl

I'll be the first to admit the following doesn't quite look like a C program. It's in fact in Perl, which outputs a C source, which in turn solves the puzzle. If you think this is long, wait till you see the C it writes.

#!/usr/bin/perl
 
use utf8;
no strict;
 
my (%props, %name, @pre, @conds, @works, $find_all_solutions);
 
sub do_consts {
local $";
for my $p (keys %props) {
my @s = @{ $props{$p} };
 
$" = ", ";
print "enum { ${p}_none = 0, @s };\n";
 
$" = '", "';
print "const char *string_$p [] = { \"###\", \"@s\" };\n\n";
}
print "#define FIND_BY(p) \\
int find_by_##p(int v) { \\
int i; \\
for (i = 0; i < N_ITEMS; i++) \\
if (house[i].p == v) return i; \\
return -1; }\n"
;
 
print "FIND_BY($_)" for (keys %props);
 
local $" = ", ";
my @k = keys %props;
 
my $sl = 0;
for (keys %name) {
if (length > $sl) { $sl = length }
}
 
my $fmt = ("%".($sl + 1)."s ") x @k;
my @arg = map { "string_$_"."[house[i].$_]" } @k;
print << "SNIPPET";
int work0(void) {
int i;
for (i = 0; i < N_ITEMS; i++)
printf("%d $fmt\\n", i, @arg);
puts(\"\");
return 1;
}
SNIPPET

 
}
 
sub setprops {
%props = @_;
my $l = 0;
my @k = keys %props;
for my $p (@k) {
my @s = @{ $props{$p} };
 
if ($l && $l != @s) {
die "bad length @s";
}
$l = @s;
$name{$_} = $p for @s;
}
local $" = ", ";
print "#include <stdio.h>
#define N_ITEMS $l
struct item_t { int @k; } house[N_ITEMS] = {{0}};\n"
;
}
 
sub pair {NB. h =.~.&> compose&.>~/y,<h
 
my ($c1, $c2, $diff) = @_;
$diff //= [0];
$diff = [$diff] unless ref $diff;
 
push @conds, [$c1, $c2, $diff];
}
 
sub make_conditions {
my $idx = 0;
my $return1 = $find_all_solutions ? "" : "return 1";
print "
#define TRY(a, b, c, d, p, n) \\
if ((b = a d) >= 0 && b < N_ITEMS) { \\
if (!house[b].p) { \\
house[b].p = c; \\
if (n()) $return1; \\
house[b].p = 0; \\
}}
"
;
 
while (@conds) {
my ($c1, $c2, $diff) = @{ pop @conds };
my $p2 = $name{$c2} or die "bad prop $c2";
 
if ($c1 =~ /^\d+$/) {
push @pre, "house[$c1].$p2 = $c2;";
next;
}
 
my $p1 = $name{$c1} or die "bad prop $c1";
my $next = "work$idx";
my $this = "work".++$idx;
 
print "
/* condition pair($c1, $c2, [@$diff]) */
int $this(void) {
int a = find_by_$p1($c1);
int b = find_by_$p2($c2);
if (a != -1 && b != -1) {
switch(b - a) {
"
;
print "case $_: " for @$diff;
print "return $next(); default: return 0; }\n } if (a != -1) {";
print "TRY(a, b, $c2, +($_), $p2, $next);" for @$diff;
print " return 0; } if (b != -1) {";
print "TRY(b, a, $c1, -($_), $p1, $next);" for @$diff;
print "
return 0; }
/* neither condition is set; try all possibles */
for (a = 0; a < N_ITEMS; a++) {
if (house[a].$p1) continue;
house[a].$p1 = $c1;
"
;
 
print "TRY(a, b, $c2, +($_), $p2, $next);" for @$diff;
print " house[a].$p1 = 0; } return 0; }";
}
 
print "int main() { @pre return !work$idx(); }";
}
 
sub make_c {
do_consts;
make_conditions;
}
 
# ---- above should be generic for all similar puzzles ---- #
 
# ---- below: per puzzle setup ---- #
# property names and values
setprops (
'nationality' # Svensk n. a Swede, not a swede (kålrot).
# AEnglisk (from middle Viking "Æŋløsåksen") n. a Brit.
=> [ qw(Deutsch Svensk Norske Danske AEnglisk) ],
'pet' => [ qw(birds dog horse zebra cats) ],
'drink' => [ qw(water tea milk beer coffee) ],
'smoke' => [ qw(dunhill blue_master prince blend pall_mall) ],
'color' => [ qw(red green yellow white blue) ]
);
 
# constraints
pair(AEnglisk, red);
pair(Svensk, dog);
pair(Danske, tea);
pair(green, white, 1); # "to the left of" can mean either 1 or -1: ambiguous
pair(coffee, green);
pair(pall_mall, birds);
pair(yellow, dunhill);
pair(2, milk);
pair(0, Norske);
pair(blend, cats, [-1, 1]);
pair(horse, dunhill, [-1, 1]);
pair(blue_master, beer); # Nicht das Deutsche Bier trinken? Huh.
pair(Deutsch, prince);
pair(Norske, blue, [-1, 1]);
pair(water, blend, [-1, 1]);
 
# "zebra lives *somewhere* relative to the Brit". It has no effect on
# the logic. It's here just to make sure the code will insert a zebra
# somewhere in the table (after all other conditions are met) so the
# final print-out shows it. (the C code can be better structured, but
# meh, I ain't reading it, so who cares).
pair(zebra, AEnglisk, [ -4 .. 4 ]);
 
# write C code. If it's ugly to you: I didn't write; Perl did.
make_c;
output (ran as perl test.pl | gcc -Wall -x c -; ./a.out):
0      dunhill         cats       yellow        water       Norske 
1        blend        horse         blue          tea       Danske 
2    pall_mall        birds          red         milk     AEnglisk 
3       prince        zebra        green       coffee      Deutsch 
4  blue_master          dog        white         beer       Svensk

[edit] C++

This is a modification of the C submission that uses rule classes and reduces the number of permutations evaluated.

 
#include <stdio.h>
#include <string.h>
 
#define defenum(name, val0, val1, val2, val3, val4) \
enum name { val0, val1, val2, val3, val4 }; \
const char *name ## _str[] = { # val0, # val1, # val2, # val3, # val4 }

 
defenum( Attrib, Color, Man, Drink, Animal, Smoke );
defenum( Colors, Red, Green, White, Yellow, Blue );
defenum( Mans, English, Swede, Dane, German, Norwegian );
defenum( Drinks, Tea, Coffee, Milk, Beer, Water );
defenum( Animals, Dog, Birds, Cats, Horse, Zebra );
defenum( Smokes, PallMall, Dunhill, Blend, BlueMaster, Prince );
 
void printHouses(int ha[5][5]) {
const char **attr_names[5] = {Colors_str, Mans_str, Drinks_str, Animals_str, Smokes_str};
 
printf("%-10s", "House");
for (const char *name : Attrib_str) printf("%-10s", name);
printf("\n");
 
for (int i = 0; i < 5; i++) {
printf("%-10d", i);
for (int j = 0; j < 5; j++) printf("%-10s", attr_names[j][ha[i][j]]);
printf("\n");
}
}
 
struct HouseNoRule {
int houseno;
Attrib a; int v;
} housenos[] = {
{2, Drink, Milk}, // Cond 9: In the middle house they drink milk.
{0, Man, Norwegian} // Cond 10: The Norwegian lives in the first house.
};
 
struct AttrPairRule {
Attrib a1; int v1;
Attrib a2; int v2;
 
bool invalid(int ha[5][5], int i) {
return (ha[i][a1] >= 0 && ha[i][a2] >= 0) &&
((ha[i][a1] == v1 && ha[i][a2] != v2) ||
(ha[i][a1] != v1 && ha[i][a2] == v2));
}
} pairs[] = {
{Man, English, Color, Red}, // Cond 2: The English man lives in the red house.
{Man, Swede, Animal, Dog}, // Cond 3: The Swede has a dog.
{Man, Dane, Drink, Tea}, // Cond 4: The Dane drinks tea.
{Color, Green, Drink, Coffee}, // Cond 6: drink coffee in the green house.
{Smoke, PallMall, Animal, Birds}, // Cond 7: The man who smokes Pall Mall has birds.
{Smoke, Dunhill, Color, Yellow}, // Cond 8: In the yellow house they smoke Dunhill.
{Smoke, BlueMaster, Drink, Beer}, // Cond 13: The man who smokes Blue Master drinks beer.
{Man, German, Smoke, Prince} // Cond 14: The German smokes Prince
};
 
struct NextToRule {
Attrib a1; int v1;
Attrib a2; int v2;
 
bool invalid(int ha[5][5], int i) {
return (ha[i][a1] == v1) &&
((i == 0 && ha[i + 1][a2] >= 0 && ha[i + 1][a2] != v2) ||
(i == 4 && ha[i - 1][a2] != v2) ||
(ha[i + 1][a2] >= 0 && ha[i + 1][a2] != v2 && ha[i - 1][a2] != v2));
}
} nexttos[] = {
{Smoke, Blend, Animal, Cats}, // Cond 11: The man who smokes Blend lives in the house next to the house with cats.
{Smoke, Dunhill, Animal, Horse}, // Cond 12: In a house next to the house where they have a horse, they smoke Dunhill.
{Man, Norwegian, Color, Blue}, // Cond 15: The Norwegian lives next to the blue house.
{Smoke, Blend, Drink, Water} // Cond 16: They drink water in a house next to the house where they smoke Blend.
};
 
struct LeftOfRule {
Attrib a1; int v1;
Attrib a2; int v2;
 
bool invalid(int ha[5][5]) {
return (ha[0][a2] == v2) || (ha[4][a1] == v1);
}
 
bool invalid(int ha[5][5], int i) {
return ((i > 0 && ha[i][a1] >= 0) &&
((ha[i - 1][a1] == v1 && ha[i][a2] != v2) ||
(ha[i - 1][a1] != v1 && ha[i][a2] == v2)));
}
} leftofs[] = {
{Color, Green, Color, White} // Cond 5: The green house is immediately to the left of the white house.
};
 
bool invalid(int ha[5][5]) {
for (auto &rule : leftofs) if (rule.invalid(ha)) return true;
 
for (int i = 0; i < 5; i++) {
#define eval_rules(rules) for (auto &rule : rules) if (rule.invalid(ha, i)) return true;
eval_rules(pairs);
eval_rules(nexttos);
eval_rules(leftofs);
}
return false;
}
 
void search(bool used[5][5], int ha[5][5], const int hno, const int attr) {
int nexthno, nextattr;
if (attr < 4) {
nextattr = attr + 1;
nexthno = hno;
} else {
nextattr = 0;
nexthno = hno + 1;
}
 
if (ha[hno][attr] != -1) {
search(used, ha, nexthno, nextattr);
} else {
for (int i = 0; i < 5; i++) {
if (used[attr][i]) continue;
used[attr][i] = true;
ha[hno][attr] = i;
 
if (!invalid(ha)) {
if ((hno == 4) && (attr == 4)) {
printHouses(ha);
} else {
search(used, ha, nexthno, nextattr);
}
}
 
used[attr][i] = false;
}
ha[hno][attr] = -1;
}
}
 
int main() {
bool used[5][5] = {};
int ha[5][5]; memset(ha, -1, sizeof(ha));
 
for (auto &rule : housenos) {
ha[rule.houseno][rule.a] = rule.v;
used[rule.a][rule.v] = true;
}
 
search(used, ha, 0, 0);
 
return 0;
}
 
Output:
$ g++ -O3 -std=c++11 zebra.cpp -o zebracpp && time ./zebracpp
House     Color     Man       Drink     Animal    Smoke     
0         Yellow    Norwegian Water     Cats      Dunhill   
1         Blue      Dane      Tea       Horse     Blend     
2         Red       English   Milk      Birds     PallMall  
3         Green     German    Coffee    Zebra     Prince    
4         White     Swede     Beer      Dog       BlueMaster

real	0m0.003s
user	0m0.000s
sys	0m0.000s

My measured time is slower than that posted for the original C code, but on my machine this C++ code is faster than the original C code.

[edit] C#

 
using System;
using System.Collections.Generic;
using System.Linq;
using Microsoft.SolverFoundation.Solvers;
 
namespace Zebra
{
enum HouseColour { Blue, Green, White, Red, Yellow };
enum Drink { Beer, Coffee, Milk, Tea, Water };
enum Nationality { English, Danish, German, Norwegian, Swedish };
enum Smoke { Blend, BlueMaster, Dunhill, PallMall, Prince };
enum Pet { Bird, Cat, Dog, Horse, Zebra };
 
internal class Program
{
static void Main()
{
var solver = ConstraintSystem.CreateSolver();
var constraints = new ZebraPuzzleConstraints(solver);
solver = AddConstraintsToSolver(solver, constraints);
 
var solution = solver.Solve(new ConstraintSolverParams());
var solutionTable = ConvertToSolutionTable(solution, constraints);
 
WriteZebraSolutionToConsole(solutionTable);
WriteSolutionForAllTheHousesToConsole(solutionTable);
}
 
private static ConstraintSystem AddConstraintsToSolver(ConstraintSystem solver, ZebraPuzzleConstraints constraints)
{
solver.AddConstraints(constraints.TheEnglishManLivesInTheRedHouse());
solver.AddConstraints(constraints.TheSwedeHasADog());
solver.AddConstraints(constraints.TheDaneDrinksTea());
solver.AddConstraints(constraints.TheGreenHouseIsImmediatelyToTheLeftOfTheWhiteHouse());
solver.AddConstraints(constraints.TheyDrinkCoffeeInTheGreenHouse());
solver.AddConstraints(constraints.TheManWhoSmokesPallMallHasBirds());
solver.AddConstraints(constraints.InTheYellowHouseTheySmokeDunhill());
solver.AddConstraints(constraints.InTheMiddleHouseTheyDrinkMilk());
solver.AddConstraints(constraints.TheNorwegianLivesInTheFirstHouse());
solver.AddConstraints(constraints.TheManWhoSmokesBlendLivesInTheHouseNextToTheHouseWithCats());
solver.AddConstraints(constraints.InAHouseNextToTheHouseWhereTheyHaveAHorseTheySmokeDunhill());
solver.AddConstraints(constraints.TheManWhoSmokesBlueMasterDrinksBeer());
solver.AddConstraints(constraints.TheGermanSmokesPrince());
solver.AddConstraints(constraints.TheNorwegianLivesNextToTheBlueHouse());
solver.AddConstraints(constraints.TheyDrinkWaterInAHouseNextToTheHouseWhereTheySmokeBlend());
 
return solver;
}
 
private static SolutionTable ConvertToSolutionTable(ConstraintSolverSolution solution, ZebraPuzzleConstraints constraints)
{
return new SolutionTable(constraints.HouseNumbers.Select(houseNumber => new SolutionRow
(
houseNumber + 1,
(HouseColour)DetermineTermFromSolution(solution, constraints.ColourMatrix, houseNumber, constraints.HouseNumbers),
(Drink)DetermineTermFromSolution(solution, constraints.DrinkMatrix, houseNumber, constraints.HouseNumbers),
(Nationality)DetermineTermFromSolution(solution, constraints.NationalityMatrix, houseNumber, constraints.HouseNumbers),
(Smoke)DetermineTermFromSolution(solution, constraints.SmokeMatrix, houseNumber, constraints.HouseNumbers),
(Pet)DetermineTermFromSolution(solution, constraints.PetMatrix, houseNumber, constraints.HouseNumbers)
)).ToList());
}
 
private static void WriteZebraSolutionToConsole(SolutionTable solution)
{
var ownerNationality = solution.Rows
.Where(row => row.Pet.Equals(Pet.Zebra))
.Select(owner => owner.Nationality).Single();
 
Console.WriteLine("The {0} owns the Zebra.{1}", ownerNationality, Environment.NewLine);
}
 
private static void WriteSolutionForAllTheHousesToConsole(SolutionTable solution)
{
Console.WriteLine("House Colour Drink Nationality Smokes Pet");
Console.WriteLine("───── ────── ────── ─────────── ────────── ─────");
solution.Rows.ForEach(row => Console.WriteLine("{0,5} {1,-6} {2,-6} {3,-11} {4,-10} {5,-10}",
row.HouseNumber, row.HouseColour, row.Drink, row.Nationality, row.Smoke, row.Pet));
}
 
static int DetermineTermFromSolution(ConstraintSolverSolution solution, CspTerm[][] terms, int currentHouseNumber, IEnumerable<int> houseNubmers)
{
if (solution == null) throw new ArgumentNullException("solution");
if (terms == null) throw new ArgumentNullException("terms");
 
foreach (var houseNumber in houseNubmers)
{
object term;
solution.TryGetValue(terms[currentHouseNumber][houseNumber], out term);
 
if ((int)term == 1)
return houseNumber;
}
return 0;
}
}
 
internal class SolutionTable
{
public SolutionTable(List<SolutionRow> rows)
{
Rows = rows;
}
 
public List<SolutionRow> Rows { get; private set; }
}
 
class SolutionRow
{
public SolutionRow(int houseNumber, HouseColour houseColor, Drink drink, Nationality nationality, Smoke smoke, Pet pet)
{
HouseNumber = houseNumber;
HouseColour = houseColor;
Drink = drink;
Nationality = nationality;
Smoke = smoke;
Pet = pet;
}
 
public int HouseNumber { get; private set; }
public HouseColour HouseColour { get; private set; }
public Drink Drink { get; private set; }
public Nationality Nationality { get; private set; }
public Smoke Smoke { get; private set; }
public Pet Pet { get; private set; }
}
 
class ZebraPuzzleConstraints
{
private CspTerm[][] CreateConstrainSystemMatrix(ConstraintSystem system)
{
var size = HouseNumbers.Count;
var matrix = system.CreateBooleanArray(new object(), size, size);
 
Enumerable.Range(0, size).ToList().ForEach(i =>
{
var row = system.CreateBooleanVector(new object(), size);
var column = system.CreateBooleanVector(new object(), size);
 
Enumerable.Range(0, size).ToList().ForEach(j =>
{
row[j] = matrix[i][j];
column[j] = matrix[j][i];
});
 
system.AddConstraints(system.Equal(1, system.Sum(row)));
system.AddConstraints(system.Equal(1, system.Sum(column)));
});
 
return matrix;
}
 
public List<int> HouseNumbers { get; private set; }
public ConstraintSystem Solver { get; private set; }
public CspTerm[][] ColourMatrix { get; private set; }
public CspTerm[][] DrinkMatrix { get; private set; }
public CspTerm[][] NationalityMatrix { get; private set; }
public CspTerm[][] SmokeMatrix { get; private set; }
public CspTerm[][] PetMatrix { get; private set; }
 
public ZebraPuzzleConstraints(ConstraintSystem solver)
{
Solver = solver;
HouseNumbers = ThereAreFiveHouses();
 
ColourMatrix = CreateConstrainSystemMatrix(Solver);
DrinkMatrix = CreateConstrainSystemMatrix(Solver);
NationalityMatrix = CreateConstrainSystemMatrix(Solver);
SmokeMatrix = CreateConstrainSystemMatrix(Solver);
PetMatrix = CreateConstrainSystemMatrix(Solver);
}
 
public static List<int> ThereAreFiveHouses()
{
return new List<int> { 0, 1, 2, 3, 4 };
}
 
public CspTerm[] TheDaneDrinksTea()
{
return HouseNumbers.Select(houseNumber => Solver.Equal(
Solver.Equal(DrinkMatrix[houseNumber][(int)Drink.Tea],
NationalityMatrix[houseNumber][(int)Nationality.Danish])))
.ToArray();
}
 
public CspTerm[] TheSwedeHasADog()
{
return HouseNumbers.Select(houseNumber => Solver.Equal(
PetMatrix[houseNumber][(int)Pet.Dog],
NationalityMatrix[houseNumber][(int)Nationality.Swedish]))
.ToArray();
}
 
public CspTerm[] TheEnglishManLivesInTheRedHouse()
{
return HouseNumbers.Select(houseNumber => Solver.Equal(
ColourMatrix[houseNumber][(int) HouseColour.Red],
NationalityMatrix[houseNumber][(int)Nationality.English]))
.ToArray();
}
 
public CspTerm[] TheGreenHouseIsImmediatelyToTheLeftOfTheWhiteHouse()
{
var constraints = new List<CspTerm>
{
Solver.Equal(0, ColourMatrix[0][(int) HouseColour.White]),
Solver.Equal(ColourMatrix[1][(int)HouseColour.White], ColourMatrix[0][(int)HouseColour.Green])
};
 
Enumerable.Range(1, 3).ToList()
.ForEach(houseNumber => constraints.Add(Solver.Equal(
ColourMatrix[houseNumber + 1][(int)HouseColour.White],
ColourMatrix[houseNumber][(int)HouseColour.Green])));
 
return constraints.ToArray();
}
 
public CspTerm[] TheyDrinkCoffeeInTheGreenHouse()
{
return HouseNumbers.Select(houseNumber => Solver.Equal(
DrinkMatrix[houseNumber][(int)Drink.Coffee],
ColourMatrix[houseNumber][(int)HouseColour.Green]))
.ToArray();
}
 
public CspTerm[] TheManWhoSmokesPallMallHasBirds()
{
return HouseNumbers.Select(houseNumber => Solver.Equal(
SmokeMatrix[houseNumber][(int)Smoke.PallMall],
PetMatrix[houseNumber][(int)Pet.Bird]))
.ToArray();
}
 
public CspTerm[] InTheYellowHouseTheySmokeDunhill()
{
return HouseNumbers.Select(houseNumber => Solver.Equal(
SmokeMatrix[houseNumber][(int)Smoke.Dunhill],
ColourMatrix[houseNumber][(int)HouseColour.Yellow]))
.ToArray();
}
 
public CspTerm[] InTheMiddleHouseTheyDrinkMilk()
{
const int middleHouseNumber = 2;
return new []
{
Solver.Equal(1, DrinkMatrix[middleHouseNumber][(int) Drink.Milk])
};
}
 
public CspTerm[] TheManWhoSmokesBlendLivesInTheHouseNextToTheHouseWithCats()
{
var constraints = new List<CspTerm>
{
Solver.Greater(1, Solver.Sum(
SmokeMatrix[0][(int) Smoke.Blend],
PetMatrix[0][(int) Pet.Cat]) - Solver.Sum(
SmokeMatrix[1][(int) Smoke.Blend],
PetMatrix[1][(int) Pet.Cat])),
 
Solver.Greater(1, Solver.Sum(
SmokeMatrix[4][(int)Smoke.Blend],
PetMatrix[4][(int)Pet.Cat]) - Solver.Sum(
SmokeMatrix[3][(int)Smoke.Blend],
PetMatrix[3][(int)Pet.Cat]))
};
 
Enumerable.Range(1, 3).ToList()
.ForEach(houseNumber => constraints.Add(Solver.Greater(1, Solver.Sum(
SmokeMatrix[houseNumber][(int) Smoke.Blend],
PetMatrix[houseNumber][(int) Pet.Cat]) - Solver.Sum(
SmokeMatrix[houseNumber - 1][(int) Smoke.Blend],
SmokeMatrix[houseNumber + 1][(int) Smoke.Blend],
PetMatrix[houseNumber - 1][(int) Pet.Cat],
PetMatrix[houseNumber + 1][(int) Pet.Cat]))));
 
return constraints.ToArray();
}
 
public CspTerm[] TheManWhoSmokesBlueMasterDrinksBeer()
{
return HouseNumbers.Select(houseNumber => Solver.Equal(
SmokeMatrix[houseNumber][(int)Smoke.BlueMaster],
DrinkMatrix[houseNumber][(int)Drink.Beer]))
.ToArray();
}
 
public CspTerm[] TheGermanSmokesPrince()
{
return HouseNumbers.Select(houseNumber => Solver.Equal(
SmokeMatrix[houseNumber][(int)Smoke.Prince],
NationalityMatrix[houseNumber][(int)Nationality.German]))
.ToArray();
}
 
public CspTerm TheNorwegianLivesInTheFirstHouse()
{
const int firstHouseNumber = 0;
return Solver.Equal(1, NationalityMatrix[firstHouseNumber][(int)Nationality.Norwegian]);
}
 
public CspTerm[] TheNorwegianLivesNextToTheBlueHouse()
{
var constraints = new List<CspTerm>
{
Solver.Greater(1, Solver.Sum(
NationalityMatrix[0][(int) Nationality.Norwegian],
ColourMatrix[0][(int) HouseColour.Blue]) - Solver.Sum(
NationalityMatrix[1][(int) Nationality.Norwegian],
ColourMatrix[1][(int) HouseColour.Blue])),
 
Solver.Greater(1, Solver.Sum(
NationalityMatrix[4][(int) Nationality.Norwegian],
ColourMatrix[4][(int) HouseColour.Blue]) - Solver.Sum(
NationalityMatrix[3][(int) Nationality.Norwegian],
ColourMatrix[3][(int) HouseColour.Blue]))
};
 
Enumerable.Range(1, 3).ToList()
.ForEach(houseNumber => constraints.Add(Solver.Greater(1, Solver.Sum(
NationalityMatrix[houseNumber][(int) Nationality.Norwegian],
ColourMatrix[houseNumber][(int) HouseColour.Blue]) - Solver.Sum(
NationalityMatrix[houseNumber - 1][(int) Nationality.Norwegian],
NationalityMatrix[houseNumber + 1][(int) Nationality.Norwegian],
ColourMatrix[houseNumber - 1][(int) HouseColour.Blue],
ColourMatrix[houseNumber + 1][(int) HouseColour.Blue]))));
 
return constraints.ToArray();
}
 
public CspTerm[] TheyDrinkWaterInAHouseNextToTheHouseWhereTheySmokeBlend()
{
var constraints = new List<CspTerm>
{
Solver.Greater(1, Solver.Sum(
SmokeMatrix[4][(int)Smoke.Blend],
DrinkMatrix[4][(int)Drink.Water]) - Solver.Sum(
SmokeMatrix[3][(int)Smoke.Blend],
DrinkMatrix[3][(int)Drink.Water])),
 
Solver.Greater(1, Solver.Sum(
SmokeMatrix[0][(int)Smoke.Blend],
DrinkMatrix[0][(int)Drink.Water]) - Solver.Sum(
SmokeMatrix[1][(int)Smoke.Blend],
DrinkMatrix[1][(int)Drink.Water]))
};
 
Enumerable.Range(1, 3).ToList()
.ForEach(houseNumber => constraints.Add(Solver.Greater(1, Solver.Sum(
SmokeMatrix[houseNumber][(int) Smoke.Blend],
DrinkMatrix[houseNumber][(int) Drink.Water]) - Solver.Sum(
SmokeMatrix[houseNumber - 1][(int) Smoke.Blend],
SmokeMatrix[houseNumber + 1][(int) Smoke.Blend],
DrinkMatrix[houseNumber - 1][(int) Drink.Water],
DrinkMatrix[houseNumber + 1][(int) Drink.Water]))));
 
return constraints.ToArray();
}
 
public CspTerm[] InAHouseNextToTheHouseWhereTheyHaveAHorseTheySmokeDunhill()
{
var constraints = new List<CspTerm>
{
Solver.Greater(1, Solver.Sum(
SmokeMatrix[0][(int) Smoke.Dunhill],
PetMatrix[0][(int) Pet.Horse]) - Solver.Sum(
SmokeMatrix[1][(int) Smoke.Dunhill],
PetMatrix[1][(int) Pet.Horse])),
 
Solver.Greater(1, Solver.Sum(
SmokeMatrix[4][(int) Smoke.Dunhill],
PetMatrix[4][(int) Pet.Horse]) - Solver.Sum(
SmokeMatrix[3][(int) Smoke.Dunhill],
PetMatrix[3][(int) Pet.Horse]))
};
 
Enumerable.Range(1, 3).ToList()
.ForEach(houseNumber => constraints.Add(Solver.Greater(1, Solver.Sum(
SmokeMatrix[houseNumber][(int) Smoke.Dunhill],
PetMatrix[houseNumber][(int) Pet.Horse]) - Solver.Sum(
SmokeMatrix[houseNumber - 1][(int) Smoke.Dunhill],
SmokeMatrix[houseNumber + 1][(int) Smoke.Dunhill],
PetMatrix[houseNumber - 1][(int) Pet.Horse],
PetMatrix[houseNumber + 1][(int) Pet.Horse]))));
 
return constraints.ToArray();
}
}
}

Produces:

The German owns the Zebra.

House Colour Drink  Nationality Smokes     Pet
───── ────── ────── ─────────── ────────── ─────
    1 Yellow Water  Norwegian   Dunhill    Cat
    2 Blue   Tea    Danish      Blend      Horse
    3 Red    Milk   English     PallMall   Bird
    4 Green  Coffee German      Prince     Zebra
    5 White  Beer   Swedish     BlueMaster Dog

[edit] Clojure

This solution uses the contributed package clojure.core.logic (with clojure.tools.macro), a mini-Kanren based logic solver. The solution is basically the one in Swannodette's logic tutorial, adapted to the problem statement here.

(ns zebra.core
(:refer-clojure :exclude [==])
(:use [clojure.core.logic]
[clojure.tools.macro :as macro]))
 
(defne lefto [x y l]
([_ _ [x y . ?r]])
([_ _ [_ . ?r]] (lefto x y ?r)))
 
(defn nexto [x y l]
(conde
((lefto x y l))
((lefto y x l))))
 
(defn zebrao [hs]
(macro/symbol-macrolet [_ (lvar)]
(all
(== [_ _ _ _ _] hs)
(membero ['englishman _ _ _ 'red] hs)
(membero ['swede _ _ 'dog _] hs)
(membero ['dane _ 'tea _ _] hs)
(lefto [_ _ _ _ 'green] [_ _ _ _ 'white] hs)
(membero [_ _ 'coffee _ 'green] hs)
(membero [_ 'pallmall _ 'birds _] hs)
(membero [_ 'dunhill _ _ 'yellow] hs)
(== [_ _ [_ _ 'milk _ _] _ _ ] hs)
(firsto hs ['norwegian _ _ _ _])
(nexto [_ 'blend _ _ _] [_ _ _ 'cats _ ] hs)
(nexto [_ _ _ 'horse _] [_ 'dunhill _ _ _] hs)
(membero [_ 'bluemaster 'beer _ _] hs)
(membero ['german 'prince _ _ _] hs)
(nexto ['norwegian _ _ _ _] [_ _ _ _ 'blue] hs)
(nexto [_ _ 'water _ _] [_ 'blend _ _ _] hs)
(membero [_ _ _ 'zebra _] hs))))
 
(let [solns (run* [q] (zebrao q))
soln (first solns)
zebra-owner (->> soln (filter #(= 'zebra (% 3))) first (#(% 0)))]
(println "solution count:" (count solns))
(println "zebra owner is the" zebra-owner)
(println "full solution (in house order):")
(doseq [h soln] (println " " h)))
 
Output:
solution count: 1
zebra owner is the german
full solution (in house order):
  [norwegian dunhill water cats yellow]
  [dane blend tea horse blue]
  [englishman pallmall milk birds red]
  [german prince coffee zebra green]
  [swede bluemaster beer dog white]

[edit] Curry

Works with: PAKCS
import Constraint (allC, anyC)
import Findall (findall)
 
 
data House = H Color Man Pet Drink Smoke
 
data Color = Red | Green | Blue | Yellow | White
data Man = Eng | Swe | Dan | Nor | Ger
data Pet = Dog | Birds | Cats | Horse | Zebra
data Drink = Coffee | Tea | Milk | Beer | Water
data Smoke = PM | DH | Blend | BM | Prince
 
 
houses :: [House] -> Success
houses hs@[H1,_,H3,_,_] = -- 1
H _ _ _ Milk _ =:= H3 -- 9
& H _ Nor _ _ _ =:= H1 -- 10
& allC (`member` hs)
[ H Red Eng _ _ _ -- 2
, H _ Swe Dog _ _ -- 3
, H _ Dan _ Tea _ -- 4
, H Green _ _ Coffee _ -- 6
, H _ _ Birds _ PM -- 7
, H Yellow _ _ _ DH -- 8
, H _ _ _ Beer BM -- 13
, H _ Ger _ _ Prince -- 14
]
& H Green _ _ _ _ `leftTo` H White _ _ _ _ -- 5
& H _ _ _ _ Blend `nextTo` H _ _ Cats _ _ -- 11
& H _ _ Horse _ _ `nextTo` H _ _ _ _ DH -- 12
& H _ Nor _ _ _ `nextTo` H Blue _ _ _ _ -- 15
& H _ _ _ Water _ `nextTo` H _ _ _ _ Blend -- 16
where
x `leftTo` y = _ ++ [x,y] ++ _ =:= hs
x `nextTo` y = x `leftTo` y
 ? y `leftTo` x
 
 
member :: a -> [a] -> Success
member = anyC . (=:=)
 
 
main = findall $ \(hs,who) -> houses hs & H _ who Zebra _ _ `member` hs
Output:
Using web interface.
Execution time: 180 msec. / elapsed: 180 msec.
[([H Yellow Nor Cats Water DH,H Blue Dan Horse Tea Blend,H Red Eng Birds Milk PM,H Green Ger Zebra Coffee Prince,H White Swe Dog Beer BM],Ger)]

[edit] D

Translation of: Ada

Most foreach loops in this program are static.

import std.stdio, std.traits, std.algorithm, std.math;
 
enum Content { Beer, Coffee, Milk, Tea, Water,
Danish, English, German, Norwegian, Swedish,
Blue, Green, Red, White, Yellow,
Blend, BlueMaster, Dunhill, PallMall, Prince,
Bird, Cat, Dog, Horse, Zebra }
enum Test { Drink, Person, Color, Smoke, Pet }
enum House { One, Two, Three, Four, Five }
 
alias TM = Content[EnumMembers!Test.length][EnumMembers!House.length];
 
bool finalChecks(in ref TM M) pure nothrow @safe @nogc {
int diff(in Content a, in Content b, in Test ca, in Test cb)
nothrow @safe @nogc {
foreach (immutable h1; EnumMembers!House)
foreach (immutable h2; EnumMembers!House)
if (M[ca][h1] == a && M[cb][h2] == b)
return h1 - h2;
assert(0); // Useless but required.
}
 
with (Content) with (Test)
return abs(diff(Norwegian, Blue, Person, Color)) == 1 &&
diff(Green, White, Color, Color) == -1 &&
abs(diff(Horse, Dunhill, Pet, Smoke)) == 1 &&
abs(diff(Water, Blend, Drink, Smoke)) == 1 &&
abs(diff(Blend, Cat, Smoke, Pet)) == 1;
}
 
bool constrained(in ref TM M, in Test atest) pure nothrow @safe @nogc {
with (Content) with (Test) with (House)
final switch (atest) {
case Drink:
return M[Drink][Three] == Milk;
case Person:
foreach (immutable h; EnumMembers!House)
if ((M[Person][h] == Norwegian && h != One) ||
(M[Person][h] == Danish && M[Drink][h] != Tea))
return false;
return true;
case Color:
foreach (immutable h; EnumMembers!House)
if ((M[Person][h] == English && M[Color][h] != Red) ||
(M[Drink][h] == Coffee && M[Color][h] != Green))
return false;
return true;
case Smoke:
foreach (immutable h; EnumMembers!House)
if ((M[Color][h] == Yellow && M[Smoke][h] != Dunhill) ||
(M[Smoke][h] == BlueMaster && M[Drink][h] != Beer) ||
(M[Person][h] == German && M[Smoke][h] != Prince))
return false;
return true;
case Pet:
foreach (immutable h; EnumMembers!House)
if ((M[Person][h] == Swedish && M[Pet][h] != Dog) ||
(M[Smoke][h] == PallMall && M[Pet][h] != Bird))
return false;
return finalChecks(M);
}
}
 
void show(in ref TM M) {
foreach (h; EnumMembers!House) {
writef("%5s: ", h);
foreach (immutable t; EnumMembers!Test)
writef("%10s ", M[t][h]);
writeln;
}
}
 
void solve(ref TM M, in Test t, in size_t n) {
if (n == 1 && constrained(M, t)) {
if (t < 4) {
solve(M, [EnumMembers!Test][t + 1], 5);
} else {
show(M);
return;
}
}
foreach (immutable i; 0 .. n) {
solve(M, t, n - 1);
swap(M[t][n % 2 ? 0 : i], M[t][n - 1]);
}
}
 
void main() {
TM M;
foreach (immutable t; EnumMembers!Test)
foreach (immutable h; EnumMembers!House)
M[t][h] = EnumMembers!Content[t * 5 + h];
 
solve(M, Test.Drink, 5);
}
Output:
  One:      Water  Norwegian     Yellow    Dunhill        Cat 
  Two:        Tea     Danish       Blue      Blend      Horse 
Three:       Milk    English        Red   PallMall       Bird 
 Four:     Coffee     German      Green     Prince      Zebra 
 Five:       Beer    Swedish      White BlueMaster        Dog 

Run-time about 0.04 seconds.

[edit] Alternative Version

Translation of: Python

This requires the module of the first D entry from the Permutations Task.

import std.stdio, std.math, std.traits, std.typetuple, std.typecons,
permutations1;
 
enum Number : uint { One, Two, Three, Four, Five }
enum Color : uint { Red, Green, Blue, White, Yellow }
enum Drink : uint { Milk, Coffee, Water, Beer, Tea }
enum Smoke : uint { PallMall, Dunhill, Blend, BlueMaster, Prince }
enum Pet : uint { Dog, Cat, Zebra, Horse, Bird }
enum Nation : uint { British, Swedish, Danish, Norvegian, German }
 
auto nullableRef(T)(ref T item) pure nothrow @nogc {
return NullableRef!T(&item);
}
 
bool isPossible(NullableRef!(immutable Number[5]) number,
NullableRef!(immutable Color[5]) color=null,
NullableRef!(immutable Drink[5]) drink=null,
NullableRef!(immutable Smoke[5]) smoke=null,
NullableRef!(immutable Pet[5]) pet=null)
pure nothrow @safe @nogc {
if ((!number.isNull && number[Nation.Norvegian] != Number.One) ||
(!color.isNull && color[Nation.British] != Color.Red) ||
(!drink.isNull && drink[Nation.Danish] != Drink.Tea) ||
(!smoke.isNull && smoke[Nation.German] != Smoke.Prince) ||
(!pet.isNull && pet[Nation.Swedish] != Pet.Dog))
return false;
 
if (number.isNull || color.isNull || drink.isNull || smoke.isNull ||
pet.isNull)
return true;
 
foreach (immutable i; 0 .. 5) {
if ((color[i] == Color.Green && drink[i] != Drink.Coffee) ||
(smoke[i] == Smoke.PallMall && pet[i] != Pet.Bird) ||
(color[i] == Color.Yellow && smoke[i] != Smoke.Dunhill) ||
(number[i] == Number.Three && drink[i] != Drink.Milk) ||
(smoke[i] == Smoke.BlueMaster && drink[i] != Drink.Beer)||
(color[i] == Color.Blue && number[i] != Number.Two))
return false;
 
foreach (immutable j; 0 .. 5) {
if (color[i] == Color.Green && color[j] == Color.White &&
number[j] - number[i] != 1)
return false;
 
immutable int diff = abs(number[i] - number[j]);
if ((smoke[i] == Smoke.Blend &&
pet[j] == Pet.Cat && diff != 1) ||
(pet[i] == Pet.Horse &&
smoke[j] == Smoke.Dunhill && diff != 1) ||
(smoke[i] == Smoke.Blend &&
drink[j] == Drink.Water && diff != 1))
return false;
}
}
 
return true;
}
 
alias N = nullableRef;
 
void main() {
static immutable int[5][] perms = [0, 1, 2, 3, 4].permutations;
immutable nation = [EnumMembers!Nation];
 
// Not nice casts:
static immutable permsNumber = cast(immutable Number[5][])perms,
permsColor = cast(immutable Color[5][])perms,
permsDrink = cast(immutable Drink[5][])perms,
permsSmoke = cast(immutable Smoke[5][])perms,
permsPet = cast(immutable Pet[5][])perms;
 
foreach (immutable ref number; permsNumber)
if (isPossible(number.N))
foreach (immutable ref color; permsColor)
if (isPossible(number.N, color.N))
foreach (immutable ref drink; permsDrink)
if (isPossible(number.N, color.N, drink.N))
foreach (immutable ref smoke; permsSmoke)
if (isPossible(number.N, color.N, drink.N, smoke.N))
foreach (immutable ref pet; permsPet)
if (isPossible(number.N, color.N, drink.N, smoke.N,
pet.N)) {
writeln("Found a solution:");
foreach (x; TypeTuple!(nation, number, color,
drink, smoke, pet))
writefln("%6s: %12s%12s%12s%12s%12s",
(Unqual!(typeof(x[0]))).stringof,
x[0], x[1], x[2], x[3], x[4]);
writeln;
}
}
Output:
Found a solution:
Nation:      British     Swedish      Danish   Norvegian      German
Number:        Three        Five         Two         One        Four
 Color:          Red       White        Blue      Yellow       Green
 Drink:         Milk        Beer         Tea       Water      Coffee
 Smoke:     PallMall  BlueMaster       Blend     Dunhill      Prince
   Pet:         Bird         Dog       Horse         Cat       Zebra

Run-time about 0.76 seconds with the dmd compiler.

[edit] Short Version

Translation of: PicoLisp

This requires the module of the second D entry from the Permutations Task.

void main() {
import std.stdio, std.algorithm, permutations2;
 
enum E { Red, Green, Blue, White, Yellow,
Milk, Coffee, Water, Beer, Tea,
PallMall, Dunhill, Blend, BlueMaster, Prince,
Dog, Cat, Zebra, Horse, Birds,
British, Swedish, Danish, Norvegian, German }
 
enum has = (E[] a, E x, E[] b, E y) => a.countUntil(x) == b.countUntil(y);
enum leftOf = (E[] a, E x, E[] b, E y) => a.countUntil(x) == b.countUntil(y) + 1;
enum nextTo = (E[] a, E x, E[] b, E y) => leftOf(a, x, b, y) || leftOf(b, y, a, x);
 
with (E) foreach (houses; [Red, Blue, Green, Yellow, White].permutations)
if (leftOf(houses, White, houses, Green))
foreach (persons; [Norvegian, British, Swedish, German, Danish].permutations)
if (has(persons, British, houses, Red) && persons[0] == Norvegian &&
nextTo(persons, Norvegian, houses, Blue))
foreach (drinks; [Tea, Coffee, Milk, Beer, Water].permutations)
if (has(drinks, Tea, persons, Danish) &&
has(drinks, Coffee, houses, Green) && drinks[$ / 2] == Milk)
foreach (pets; [Dog, Birds, Cat, Horse, Zebra].permutations)
if (has(pets, Dog, persons, Swedish))
foreach (smokes; [PallMall, Dunhill, Blend, BlueMaster, Prince].permutations)
if (has(smokes, PallMall, pets, Birds) &&
has(smokes, Dunhill, houses, Yellow) &&
nextTo(smokes, Blend, pets, Cat) &&
nextTo(smokes, Dunhill, pets, Horse) &&
has(smokes, BlueMaster, drinks, Beer) &&
has(smokes, Prince, persons, German) &&
nextTo(drinks, Water, smokes, Blend))
writefln("%(%10s\n%)\n", [houses, persons, drinks, pets, smokes]);
}
Output:
[    Yellow,       Blue,        Red,      Green,      White]
[ Norvegian,     Danish,    British,     German,    Swedish]
[     Water,        Tea,       Milk,     Coffee,       Beer]
[       Cat,      Horse,      Birds,      Zebra,        Dog]
[   Dunhill,      Blend,   PallMall,     Prince, BlueMaster]

The run-time is 0.03 seconds or less.

[edit] Erlang

This solution generates all houses that fits the rules for single houses, then it checks multi-house rules. It would be faster to check multi-house rules while generating the houses. I have not added this complexity since the current program takes just a few seconds.

 
-module( zebra_puzzle ).
 
-export( [task/0] ).
 
-record( house, {colour, drink, nationality, number, pet, smoke} ).
-record( sorted_houses, {house_1s=[], house_2s=[], house_3s=[], house_4s=[], house_5s=[]} ).
 
task() ->
Houses = [#house{colour=C, drink=D, nationality=N, number=Nr, pet=P, smoke=S} || C <- all_colours(), D <- all_drinks(), N <- all_nationalities(), Nr <- all_numbers(), P <- all_pets(), S <- all_smokes(), is_all_single_house_rules_ok(C, D, N, Nr, P, S)],
Sorted_houses = lists:foldl( fun house_number_sort/2, #sorted_houses{}, Houses ),
Streets = [[H1, H2, H3, H4, H5] || H1 <- Sorted_houses#sorted_houses.house_1s, H2 <- Sorted_houses#sorted_houses.house_2s, H3 <- Sorted_houses#sorted_houses.house_3s, H4 <- Sorted_houses#sorted_houses.house_4s, H5 <- Sorted_houses#sorted_houses.house_5s, is_all_multi_house_rules_ok(H1, H2, H3, H4, H5)],
[Nationality] = [N || #house{nationality=N, pet=zebra} <- lists:flatten(Streets)],
io:fwrite( "~p owns the zebra~n", [Nationality] ),
io:fwrite( "All solutions ~p~n", [Streets] ),
io:fwrite( "Number of solutions ~p~n", [erlang:length(Streets)] ).
 
 
 
all_colours() -> [blue, green, red, white, yellow].
 
all_drinks() -> [beer, coffe, milk, tea, water].
 
all_nationalities() -> [danish, english, german, norveigan, swedish].
 
all_numbers() -> [1, 2, 3, 4, 5].
 
all_pets() -> [birds, cats, dog, horse, zebra].
 
all_smokes() -> [blend, 'blue master', dunhill, 'pall mall', prince].
 
house_number_sort( #house{number=1}=House, #sorted_houses{house_1s=Houses_1s}=Sorted_houses ) -> Sorted_houses#sorted_houses{house_1s=[House | Houses_1s]};
house_number_sort( #house{number=2}=House, #sorted_houses{house_2s=Houses_2s}=Sorted_houses ) -> Sorted_houses#sorted_houses{house_2s=[House | Houses_2s]};
house_number_sort( #house{number=3}=House, #sorted_houses{house_3s=Houses_3s}=Sorted_houses ) -> Sorted_houses#sorted_houses{house_3s=[House | Houses_3s]};
house_number_sort( #house{number=4}=House, #sorted_houses{house_4s=Houses_4s}=Sorted_houses ) -> Sorted_houses#sorted_houses{house_4s=[House | Houses_4s]};
house_number_sort( #house{number=5}=House, #sorted_houses{house_5s=Houses_5s}=Sorted_houses ) -> Sorted_houses#sorted_houses{house_5s=[House | Houses_5s]}.
 
is_all_different( [_H] ) -> true;
is_all_different( [H | T] ) -> not lists:member( H, T ) andalso is_all_different( T ).
 
is_all_multi_house_rules_ok( House1, House2, House3, House4, House5 ) ->
is_rule_1_ok( House1, House2, House3, House4, House5 )
andalso is_rule_5_ok( House1, House2, House3, House4, House5 )
andalso is_rule_11_ok( House1, House2, House3, House4, House5 )
andalso is_rule_12_ok( House1, House2, House3, House4, House5 )
andalso is_rule_15_ok( House1, House2, House3, House4, House5 )
andalso is_rule_16_ok( House1, House2, House3, House4, House5 ).
 
is_all_single_house_rules_ok( Colour, Drink, Nationality, Number, Pet, Smoke ) ->
is_rule_ok( {rule_number, 2}, {Nationality, english}, {Colour, red})
andalso is_rule_ok( {rule_number, 3}, {Nationality, swedish}, {Pet, dog})
andalso is_rule_ok( {rule_number, 4}, {Nationality, danish}, {Drink, tea})
andalso is_rule_ok( {rule_number, 6}, {Drink, coffe}, {Colour, green})
andalso is_rule_ok( {rule_number, 7}, {Smoke, 'pall mall'}, {Pet, birds})
andalso is_rule_ok( {rule_number, 8}, {Colour, yellow}, {Smoke, dunhill})
andalso is_rule_ok( {rule_number, 9}, {Number, 3}, {Drink, milk})
andalso is_rule_ok( {rule_number, 10}, {Nationality, norveigan}, {Number, 1})
andalso is_rule_ok( {rule_number, 13}, {Smoke, 'blue master'}, {Drink, beer})
andalso is_rule_ok( {rule_number, 14}, {Nationality, german}, {Smoke, prince}).
 
is_rule_ok( _Rule_number, {A, A}, {B, B} ) -> true;
is_rule_ok( _Rule_number, _A, {B, B} ) -> false;
is_rule_ok( _Rule_number, {A, A}, _B ) -> false;
is_rule_ok( _Rule_number, _A, _B ) -> true.
 
is_rule_1_ok( #house{number=1}=H1, #house{number=2}=H2, #house{number=3}=H3, #house{number=4}=H4, #house{number=5}=H5 ) ->
is_all_different( [H1#house.colour, H2#house.colour, H3#house.colour, H4#house.colour, H5#house.colour] )
andalso is_all_different( [H1#house.drink, H2#house.drink, H3#house.drink, H4#house.drink, H5#house.drink] )
andalso is_all_different( [H1#house.nationality, H2#house.nationality, H3#house.nationality, H4#house.nationality, H5#house.nationality] )
andalso is_all_different( [H1#house.pet, H2#house.pet, H3#house.pet, H4#house.pet, H5#house.pet] )
andalso is_all_different( [H1#house.smoke, H2#house.smoke, H3#house.smoke, H4#house.smoke, H5#house.smoke] );
is_rule_1_ok( _House1, _House2, _House3, _House4, _House5 ) -> false.
 
is_rule_5_ok( #house{colour=green}, #house{colour=white}, _House3, _House4, _House5 ) -> true;
is_rule_5_ok( _House1, #house{colour=green}, #house{colour=white}, _House4, _House5 ) -> true;
is_rule_5_ok( _House1, _House2, #house{colour=green}, #house{colour=white}, _House5 ) -> true;
is_rule_5_ok( _House1, _House2, _House3, #house{colour=green}, #house{colour=white} ) -> true;
is_rule_5_ok( _House1, _House2, _House3, _House4, _House5 ) -> false.
 
is_rule_11_ok( #house{smoke=blend}, #house{pet=cats}, _House3, _House4, _House5 ) -> true;
is_rule_11_ok( _House1, #house{smoke=blend}, #house{pet=cats}, _House4, _House5 ) -> true;
is_rule_11_ok( _House1, _House2, #house{smoke=blend}, #house{pet=cats}, _House5 ) -> true;
is_rule_11_ok( _House1, _House2, _House3, #house{smoke=blend}, #house{pet=cats} ) -> true;
is_rule_11_ok( #house{pet=cats}, #house{smoke=blend}, _House3, _House4, _House5 ) -> true;
is_rule_11_ok( _House1, #house{pet=cats}, #house{smoke=blend}, _House4, _House5 ) -> true;
is_rule_11_ok( _House1, _House2, #house{pet=cats}, #house{smoke=blend}, _House5 ) -> true;
is_rule_11_ok( _House1, _House2, _House3, #house{pet=cats}, #house{smoke=blend} ) -> true;
is_rule_11_ok( _House1, _House2, _House3, _House4, _House5 ) -> false.
 
is_rule_12_ok( #house{smoke=dunhill}, #house{pet=horse}, _House3, _House4, _House5 ) -> true;
is_rule_12_ok( _House1, #house{smoke=dunhill}, #house{pet=horse}, _House4, _House5 ) -> true;
is_rule_12_ok( _House1, _House2, #house{smoke=dunhill}, #house{pet=horse}, _House5 ) -> true;
is_rule_12_ok( _House1, _House2, _House3, #house{smoke=dunhill}, #house{pet=horse} ) -> true;
is_rule_12_ok( #house{pet=horse}, #house{smoke=dunhill}, _House3, _House4, _House5 ) -> true;
is_rule_12_ok( _House1, #house{pet=horse}, #house{smoke=dunhill}, _House4, _House5 ) -> true;
is_rule_12_ok( _House1, _House2, #house{pet=horse}, #house{smoke=dunhill}, _House5 ) -> true;
is_rule_12_ok( _House1, _House2, _House3, #house{pet=horse}, #house{smoke=dunhill} ) -> true;
is_rule_12_ok( _House1, _House2, _House3, _House4, _House5 ) -> false.
 
is_rule_15_ok( #house{nationality=norveigan}, #house{colour=blue}, _House3, _House4, _House5 ) -> true;
is_rule_15_ok( _House1, #house{nationality=norveigan}, #house{colour=blue}, _House4, _House5 ) -> true;
is_rule_15_ok( _House1, _House2, #house{nationality=norveigan}, #house{colour=blue}, _House5 ) -> true;
is_rule_15_ok( _House1, _House2, _House3, #house{nationality=norveigan}, #house{colour=blue} ) -> true;
is_rule_15_ok( #house{colour=blue}, #house{nationality=norveigan}, _House3, _House4, _House5 ) -> true;
is_rule_15_ok( _House1, #house{colour=blue}, #house{nationality=norveigan}, _House4, _House5 ) -> true;
is_rule_15_ok( _House1, _House2, #house{drink=water}, #house{nationality=norveigan}, _House5 ) -> true;
is_rule_15_ok( _House1, _House2, _House3, #house{drink=water}, #house{nationality=norveigan} ) -> true;
is_rule_15_ok( _House1, _House2, _House3, _House4, _House5 ) -> false.
 
is_rule_16_ok( #house{smoke=blend}, #house{drink=water}, _House3, _House4, _House5 ) -> true;
is_rule_16_ok( _House1, #house{smoke=blend}, #house{drink=water}, _House4, _House5 ) -> true;
is_rule_16_ok( _House1, _House2, #house{smoke=blend}, #house{drink=water}, _House5 ) -> true;
is_rule_16_ok( _House1, _House2, _House3, #house{smoke=blend}, #house{drink=water} ) -> true;
is_rule_16_ok( #house{drink=water}, #house{smoke=blend}, _House3, _House4, _House5 ) -> true;
is_rule_16_ok( _House1, #house{drink=water}, #house{smoke=blend}, _House4, _House5 ) -> true;
is_rule_16_ok( _House1, _House2, #house{drink=water}, #house{smoke=blend}, _House5 ) -> true;
is_rule_16_ok( _House1, _House2, _House3, #house{drink=water}, #house{smoke=blend} ) -> true;
is_rule_16_ok( _House1, _House2, _House3, _House4, _House5 ) -> false.
 
Output:
10> zebra_puzzle:task().
german owns the zebra
All solutions [[{house,yellow,water,norveigan,1,cats,dunhill},
                {house,blue,tea,danish,2,horse,blend},
                {house,red,milk,english,3,birds,'pall mall'},
                {house,green,coffe,german,4,zebra,prince},
                {house,white,beer,swedish,5,dog,'blue master'}]]
Number of solutions: 1

[edit] Haskell

import Control.Applicative ((<$>), (<*>))
import Control.Monad (foldM, forM_)
import Data.List ((\\), isInfixOf)
 
-- types
data House = House
{ color :: Color
, man :: Man
, pet :: Pet
, drink :: Drink
, smoke :: Smoke
}
deriving (Eq, Show)
 
data Color = Red | Green | Blue | Yellow | White
deriving (Eq, Show, Enum, Bounded)
 
data Man = Eng | Swe | Dan | Nor | Ger
deriving (Eq, Show, Enum, Bounded)
 
data Pet = Dog | Birds | Cats | Horse | Zebra
deriving (Eq, Show, Enum, Bounded)
 
data Drink = Coffee | Tea | Milk | Beer | Water
deriving (Eq, Show, Enum, Bounded)
 
data Smoke = PallMall | Dunhill | Blend | BlueMaster | Prince
deriving (Eq, Show, Enum, Bounded)
 
 
main :: IO ()
main = do
forM_ solutions $ \x -> mapM_ print (reverse x)
>> putStrLn "----"
putStrLn "No More Solutions"
 
 
solutions :: [[House]]
solutions = filter (and . postChecks) $ foldM next [] [1..5]
where
next xs pos = [x:xs | x <- iterHouse xs, and $ checks pos x]
 
 
iterHouse :: [House] -> [House]
iterHouse xs =
House <$> new color <*> new man <*> new pet <*> new drink <*> new smoke
where
new getter = [minBound ..] \\ map getter xs
 
 
-- immediate checks
checks :: Int -> House -> [Bool]
checks pos house =
[ man `is` Eng <=> color `is` Red -- 2
, man `is` Swe <=> pet `is` Dog -- 3
, man `is` Dan <=> drink `is` Tea -- 4
, color `is` Green <=> drink `is` Coffee -- 6
, pet `is` Birds <=> smoke `is` PallMall -- 7
, color `is` Yellow <=> smoke `is` Dunhill -- 8
, const (pos == 3) <=> drink `is` Milk -- 9
, const (pos == 1) <=> man `is` Nor -- 10
, drink `is` Beer <=> smoke `is` BlueMaster -- 13
, man `is` Ger <=> smoke `is` Prince -- 14
]
where
infix 4 <=>
p <=> q = p house == q house -- both True or both False
 
 
-- final checks
postChecks :: [House] -> [Bool]
postChecks houses =
-- NOTE: list of houses is generated in reversed order
[ [White, Green] `isInfixOf` map color houses -- 5
, (smoke `is` Blend ) `nextTo` (pet `is` Cats ) -- 11
, (smoke `is` Dunhill) `nextTo` (pet `is` Horse) -- 12
, (color `is` Blue ) `nextTo` (man `is` Nor ) -- 15
, (smoke `is` Blend ) `nextTo` (drink `is` Water) -- 16
]
where
nextTo :: (House -> Bool) -> (House -> Bool) -> Bool
nextTo p q
| (_:x:_) <- dropWhile (not . match) houses = match x
| otherwise = False
where
match x = p x || q x
 
 
is :: Eq a => (House -> a) -> a -> House -> Bool
getter `is` value = (== value) . getter
Output:
House {color = Yellow, man = Nor, pet = Cats, drink = Water, smoke = Dunhill}
House {color = Blue, man = Dan, pet = Horse, drink = Tea, smoke = Blend}
House {color = Red, man = Eng, pet = Birds, drink = Milk, smoke = PallMall}
House {color = Green, man = Ger, pet = Zebra, drink = Coffee, smoke = Prince}
House {color = White, man = Swe, pet = Dog, drink = Beer, smoke = BlueMaster}
----
No More Solutions

Runs in: time: 0.04 memory: 6284.

[edit] J

Propositions 1 .. 16 without 9,10 and15

ehs=: 5$a:
 
cr=: (('English';'red') 0 3} ehs);<('Dane';'tea') 0 2}ehs
cr=: cr, (('German';'Prince') 0 4}ehs);<('Swede';'dog') 0 1 }ehs
 
cs=: <('PallMall';'birds') 4 1}ehs
cs=: cs, (('yellow';'Dunhill') 3 4}ehs);<('BlueMaster';'beer') 4 2}ehs
 
lof=: (('coffee';'green')2 3}ehs);<(<'white')3}ehs
 
next=: <((<'Blend') 4 }ehs);<(<'water')2}ehs
next=: next,<((<'Blend') 4 }ehs);<(<'cats')1}ehs
next=: next,<((<'Dunhill') 4}ehs);<(<'horse')1}ehs

Example

   lof
┌─────────────────┬───────────┐
│┌┬┬──────┬─────┬┐│┌┬┬┬─────┬┐│
││││coffee│green│││││││white│││
│└┴┴──────┴─────┴┘│└┴┴┴─────┴┘│
└─────────────────┴───────────┘

Collections of all variants of the propositions:

hcr=: (<ehs),. (A.~i.@!@#)cr
hcs=:~. (A.~i.@!@#)cs,2$<ehs
hlof=:(-i.4) |."0 1 lof,3$<ehs
hnext=: ,/((i.4) |."0 1 (3$<ehs)&,)"1 ;(,,:|.)&.> next

We start the row of houses with fixed properties 9, 10 and 15.

houses=: ((<'Norwegian') 0}ehs);((<'blue') 3 }ehs);((<'milk') 2}ehs);ehs;<ehs
Output:
   houses
┌───────────────┬──────────┬──────────┬──────┬──────┐
│┌─────────┬┬┬┬┐│┌┬┬┬────┬┐│┌┬┬────┬┬┐│┌┬┬┬┬┐│┌┬┬┬┬┐│
││Norwegian││││││││││blue││││││milk││││││││││││││││││
│└─────────┴┴┴┴┘│└┴┴┴────┴┘│└┴┴────┴┴┘│└┴┴┴┴┘│└┴┴┴┴┘│
└───────────────┴──────────┴──────────┴──────┴──────┘

Set of proposition variants:

constraints=: hcr;hcs;hlof;<hnext

The worker and its helper verbs

select=: ~.@(,: #~ ,&(0~:#))
filter=: #~*./@:(2>#S:0)"1
compose=: [: filter f. [: ,/ select f. L:0"1"1 _
 
solve=: 4 :0
h=. ,:x
whilst. 0=# z do.
for_e. y do. h=. h compose > e end.
z=.(#~1=[:+/"1 (0=#)S:0"1) h=.~. h
end.
)
Output:
   >"0 houses solve constraints
┌─────────┬─────┬──────┬──────┬──────────┐
│Norwegian│cats │water │yellow│Dunhill │
├─────────┼─────┼──────┼──────┼──────────┤
│Dane │horse│tea │blue │Blend │
├─────────┼─────┼──────┼──────┼──────────┤
│English │birds│milk │red │PallMall │
├─────────┼─────┼──────┼──────┼──────────┤
│German │ │coffee│green │Prince │
├─────────┼─────┼──────┼──────┼──────────┤
│Swede │dog │beer │white │BlueMaster│
└─────────┴─────┴──────┴──────┴──────────┘

So, the German owns the zebra.

Alternative
A longer running solver by adding the zebra variants.

zebra=: (-i.5)|."0 1 (<(<'zebra') 1}ehs),4$<ehs
 
solve3=: 4 :0
p=. *./@:((0~:#)S:0)
f=. [:~.&.> [: compose&.>~/y&, f.
z=. f^:(3>[:#(#~p"1)&>)^:_ <,:x
>"0 (#~([:*./[:;[:<@({.~:}.)\.;)"1)(#~p"1); z
)
Output:
   houses solve3 constraints,<zebra
┌─────────┬─────┬──────┬──────┬──────────┐
│Norwegian│cats │water │yellow│Dunhill │
├─────────┼─────┼──────┼──────┼──────────┤
│Dane │horse│tea │blue │Blend │
├─────────┼─────┼──────┼──────┼──────────┤
│English │birds│milk │red │PallMall │
├─────────┼─────┼──────┼──────┼──────────┤
│German │zebra│coffee│green │Prince │
├─────────┼─────┼──────┼──────┼──────────┤
│Swede │dog │beer │white │BlueMaster│
└─────────┴─────┴──────┴──────┴──────────┘

[edit] Logtalk

The Logtalk distribution includes a solution for a variant of this puzzle (here reproduced with permission):

 
/* Houses logical puzzle: who owns the zebra and who drinks water?
 
1) Five colored houses in a row, each with an owner, a pet, cigarettes, and a drink.
2) The English lives in the red house.
3) The Spanish has a dog.
4) They drink coffee in the green house.
5) The Ukrainian drinks tea.
6) The green house is next to the white house.
7) The Winston smoker has a serpent.
8) In the yellow house they smoke Kool.
9) In the middle house they drink milk.
10) The Norwegian lives in the first house from the left.
11) The Chesterfield smoker lives near the man with the fox.
12) In the house near the house with the horse they smoke Kool.
13) The Lucky Strike smoker drinks juice.
14) The Japanese smokes Kent.
15) The Norwegian lives near the blue house.
 
Who owns the zebra and who drinks water?
*/

 
:- object(houses).
 
:- public(houses/1).
:- mode(houses(-list), one).
:- info(houses/1, [
comment is 'Solution to the puzzle.',
argnames is ['Solution']
]).
 
:- public(print/1).
:- mode(print(+list), one).
:- info(print/1, [
comment is 'Pretty print solution to the puzzle.',
argnames is ['Solution']
]).
 
houses(Solution) :-
template(Solution), % 1
member(h(english, _, _, _, red), Solution), % 2
member(h(spanish, dog, _, _, _), Solution), % 3
member(h(_, _, _, coffee, green), Solution), % 4
member(h(ukrainian, _, _, tea, _), Solution), % 5
next(h(_, _, _, _, green), h(_, _, _, _, white), Solution), % 6
member(h(_, snake, winston, _, _), Solution), % 7
member(h(_, _, kool, _, yellow), Solution), % 8
Solution = [_, _, h(_, _, _, milk, _), _, _], % 9
Solution = [h(norwegian, _, _, _, _)| _], % 10
next(h(_, fox, _, _, _), h(_, _, chesterfield, _, _), Solution), % 11
next(h(_, _, kool, _, _), h(_, horse, _, _, _), Solution), % 12
member(h(_, _, lucky, juice, _), Solution), % 13
member(h(japonese, _, kent, _, _), Solution), % 14
next(h(norwegian, _, _, _, _), h(_, _, _, _, blue), Solution), % 15
member(h(_, _, _, water, _), Solution), % one of them drinks water
member(h(_, zebra, _, _, _), Solution). % one of them owns a zebra
 
print([]).
print([House| Houses]) :-
write(House), nl,
print(Houses).
 
% h(Nationality, Pet, Cigarette, Drink, Color)
template([h(_, _, _, _, _), h(_, _, _, _, _), h(_, _, _, _, _), h(_, _, _, _, _), h(_, _, _, _, _)]).
 
member(A, [A, _, _, _, _]).
member(B, [_, B, _, _, _]).
member(C, [_, _, C, _, _]).
member(D, [_, _, _, D, _]).
member(E, [_, _, _, _, E]).
 
next(A, B, [A, B, _, _, _]).
next(B, C, [_, B, C, _, _]).
next(C, D, [_, _, C, D, _]).
next(D, E, [_, _, _, D, E]).
 
:- end_object.
 

Sample query:

 
| ?- houses::(houses(S), print(S)).
h(norwegian,fox,kool,water,yellow)
h(ukrainian,horse,chesterfield,tea,blue)
h(english,snake,winston,milk,red)
h(japonese,zebra,kent,coffee,green)
h(spanish,dog,lucky,juice,white)
 
S = [h(norwegian,fox,kool,water,yellow),h(ukrainian,horse,chesterfield,tea,blue),h(english,snake,winston,milk,red),h(japonese,zebra,kent,coffee,green),h(spanish,dog,lucky,juice,white)]
 

[edit] Mathematica

This creates a table that has 5 columns, and 25 rows. We fill the table; each column is the same and equal to all the options joined together in blocks of 5:

 		1		2		3		4		5
colors		Blue		Blue		Blue		Blue		Blue
colors		Green		Green		Green		Green		Green
colors		Red		Red		Red		Red		Red
colors		White		White		White		White		White
colors		Yellow		Yellow		Yellow		Yellow		Yellow
nationality	Dane		Dane		Dane		Dane		Dane
nationality	English		English		English		English		English
nationality	German		German		German		German		German
nationality	Norwegian	Norwegian	Norwegian	Norwegian	Norwegian
nationality	Swede		Swede		Swede		Swede		Swede
beverage	Beer		Beer		Beer		Beer		Beer
beverage	Coffee		Coffee		Coffee		Coffee		Coffee
beverage	Milk		Milk		Milk		Milk		Milk
beverage	Tea		Tea		Tea		Tea		Tea
beverage	Water		Water		Water		Water		Water
animal		Birds		Birds		Birds		Birds		Birds
animal		Cats		Cats		Cats		Cats		Cats
animal		Dog		Dog		Dog		Dog		Dog
animal		Horse		Horse		Horse		Horse		Horse
animal		Zebra		Zebra		Zebra		Zebra		Zebra
smoke		Blend		Blend		Blend		Blend		Blend
smoke		Blue Master	Blue Master	Blue Master	Blue Master	Blue Master
smoke		Dunhill		Dunhill		Dunhill		Dunhill		Dunhill
smoke		Pall Mall	Pall Mall	Pall Mall	Pall Mall	Pall Mall
smoke		Prince		Prince		Prince		Prince		Prince

This should be read as follows: Each column shows (in blocks of 5) the possible candidates of each kind (beverage, animal, smoke...) We solve it now in a 'sudoku' way: We remove candidates iteratively until we are left with 1 candidate of each kind for each house.

ClearAll[EliminatePoss, FilterPuzzle]
EliminatePoss[ct_, key1_, key2_] := Module[{t = ct, poss1, poss2, poss, notposs},
poss1 = Position[t, key1];
poss2 = Position[t, key2];
poss = Intersection[Last /@ poss1, Last /@ poss2];
notposs = Complement[Range[5], poss];
poss1 = Select[poss1, MemberQ[notposs, Last[#]] &];
poss2 = Select[poss2, MemberQ[notposs, Last[#]] &];
t = ReplacePart[t, poss1 -> Null];
t = ReplacePart[t, poss2 -> Null];
t
]
FilterPuzzle[tbl_] := Module[{t = tbl, poss1, poss2, poss, notposs, rows, columns, vals, sets, delpos},
t = EliminatePoss[t, "English", "Red"]; (*2. The English man lives in the red house. *)
t = EliminatePoss[t, "Swede", "Dog"]; (* 3. The Swede has a dog. *)
t = EliminatePoss[t, "Dane", "Tea"]; (* 4. The Dane drinks tea. *)
t = EliminatePoss[t, "Green", "Coffee"]; (* 6. They drink coffee in the green house. *)
t = EliminatePoss[t, "Pall Mall", "Birds"]; (* 7. The man who smokes Pall Mall has birds.*)
t = EliminatePoss[t, "Yellow", "Dunhill"]; (* 8. In the yellow house they smoke Dunhill. *)
t = EliminatePoss[t, "Blue Master", "Beer"]; (*13. The man who smokes Blue Master drinks beer. *)
t = EliminatePoss[t, "German", "Prince"]; (* 14. The German smokes Prince. *)
 
(* 9. In the middle house they drink milk. *)
poss = Position[t, "Milk"];
delpos = Select[poss, #[[2]] != 3 &];
t = ReplacePart[t, delpos -> Null];
 
(* 10. The Norwegian lives in the first house. *)
poss = Position[t, "Norwegian"];
delpos = Select[poss, #[[2]] != 1 &];
t = ReplacePart[t, delpos -> Null];
 
(* 15. The Norwegian lives next to the blue house.*)
poss1 = Position[t, "Norwegian"];
poss2 = Position[t, "Blue"];
poss = Tuples[{poss1, poss2}];
poss = Select[poss, #[[1, 2]] + 1 == #[[2, 2]] \[Or] #[[1, 2]] - 1 == #[[2, 2]] &]\[Transpose];
delpos = Complement[poss1, poss[[1]]];
t = ReplacePart[t, delpos -> Null];
delpos = Complement[poss2, poss[[2]]];
t = ReplacePart[t, delpos -> Null];
 
(* 5. The green house is immediately to the left of the white house. *)
poss1 = Position[t, "Green"];
poss2 = Position[t, "White"];
poss = Tuples[{poss1, poss2}];
poss = Select[poss, #[[1, 2]] + 1 == #[[2, 2]] &]\[Transpose];
delpos = Complement[poss1, poss[[1]]];
t = ReplacePart[t, delpos -> Null];
delpos = Complement[poss2, poss[[2]]];
t = ReplacePart[t, delpos -> Null];
 
(*11. The man who smokes Blend lives in the house next to the house with cats.*)
poss1 = Position[t, "Blend"];
poss2 = Position[t, "Cats"];
poss = Tuples[{poss1, poss2}];
poss = Select[poss, #[[1, 2]] + 1 == #[[2, 2]] \[Or] #[[1, 2]] - 1 == #[[2, 2]] &]\[Transpose];
delpos = Complement[poss1, poss[[1]]];
t = ReplacePart[t, delpos -> Null];
delpos = Complement[poss2, poss[[2]]];
t = ReplacePart[t, delpos -> Null];
 
(* 12. In a house next to the house where they have a horse, they smoke Dunhill. *)
poss1 = Position[t, "Horse"];
poss2 = Position[t, "Dunhill"];
poss = Tuples[{poss1, poss2}];
poss = Select[poss, #[[1, 2]] + 1 == #[[2, 2]] \[Or] #[[1, 2]] - 1 == #[[2, 2]] &]\[Transpose];
delpos = Complement[poss1, poss[[1]]];
t = ReplacePart[t, delpos -> Null];
delpos = Complement[poss2, poss[[2]]];
t = ReplacePart[t, delpos -> Null];
 
(* 16. They drink water in a house next to the house where they smoke Blend. *)
poss1 = Position[t, "Water"];
poss2 = Position[t, "Blend"];
poss = Tuples[{poss1, poss2}];
poss = Select[poss, #[[1, 2]] + 1 == #[[2, 2]] \[Or] #[[1, 2]] - 1 == #[[2, 2]] &]\[Transpose];
delpos = Complement[poss1, poss[[1]]];
t = ReplacePart[t, delpos -> Null];
delpos = Complement[poss2, poss[[2]]];
t = ReplacePart[t, delpos -> Null];
 
(*General rule 1 in a line => cross out vertical and horizontal lines*)
(* 1 in a row*)
vals = Select[t, Count[#, Null] == 4 &];
vals = DeleteCases[Flatten[vals], Null];
poss = Flatten[Position[t, #] & /@ vals, 1];
delpos = With[{r = First[#], c = Last[#]}, {#, c} & /@ (Range[-4, 0] + Ceiling[r, 5])] & /@ poss; (*delete in columns*)
delpos = Flatten[MapThread[DeleteCases, {delpos, poss}], 1];
t = ReplacePart[t, delpos -> Null];
 
(* 1 in a column*)
sets = Flatten[Table[{i + k*5, j}, {k, 0, 4}, {j, 1, 5}, {i, 1, 5}],1];
sets = {#, Extract[t, #]} & /@ sets;
sets = Select[sets, Count[#[[2]], Null] == 4 &];
sets = Flatten[Transpose /@ sets, 1];
sets = DeleteCases[sets, {{_, _}, Null}];
delpos = sets[[All, 1]];(*delete in rows*)
delpos = With[{r = First[#], c = Last[#]}, {r, #} & /@ (DeleteCases[Range[5], c])] & /@ delpos;
delpos = Flatten[delpos, 1];
t = ReplacePart[t, delpos -> Null];
 
t
]
colors = {"Blue", "Green", "Red", "White", "Yellow"};
nationality = {"Dane", "English", "German", "Norwegian", "Swede"};
beverage = {"Beer", "Coffee", "Milk", "Tea", "Water"};
animal = {"Birds", "Cats", "Dog", "Horse", "Zebra"};
smoke = {"Blend", "Blue Master", "Dunhill", "Pall Mall", "Prince"};
vals = {colors, nationality, beverage, animal, smoke};
bigtable = Join @@ (ConstantArray[#, 5]\[Transpose] & /@ vals);
 
bigtable = FixedPoint[FilterPuzzle, bigtable];
TableForm[DeleteCases[bigtable\[Transpose], Null, \[Infinity]], TableHeadings -> {Range[5], None}]

Using the command FixedPoint, we iteratively filter out these candidates, until we are (hopefully) left with 1 candidate per kind per house.

Output:
1		Yellow		Norwegian		Water		Cats		Dunhill
2		Blue		Dane		Tea		Horse		Blend
3		Red		English		Milk		Birds		Pall Mall
4		Green		German		Coffee		Zebra		Prince
5		White		Swede		Beer		Dog		Blue Master

[edit] Perl

Basically the same idea as C, though of course it's much easier to have Perl generate Perl code.

#!/usr/bin/perl
 
use utf8;
use strict;
binmode STDOUT, ":utf8";
 
my (@tgt, %names);
sub setprops {
my %h = @_;
my @p = keys %h;
for my $p (@p) {
my @v = @{ $h{$p} };
@tgt = map(+{idx=>$_-1, map{ ($_, undef) } @p}, 1 .. @v)
unless @tgt;
$names{$_} = $p for @v;
}
}
 
my $solve = sub {
for my $i (@tgt) {
printf("%12s", ucfirst($i->{$_} // "¿Qué?"))
for reverse sort keys %$i;
print "\n";
}
"there is only one" # <--- change this to a false value to find all solutions (if any)
};
 
sub pair {
my ($a, $b, @v) = @_;
if ($a =~ /^(\d+)$/) {
$tgt[$1]{ $names{$b} } = $b;
return;
}
 
@v = (0) unless @v;
my %allowed;
$allowed{$_} = 1 for @v;
 
my ($p1, $p2) = ($names{$a}, $names{$b});
 
my $e = $solve;
$solve = sub { # <--- sorta like how TeX \let...\def macro
my ($x, $y);
 
($x) = grep { $_->{$p1} eq $a } @tgt;
($y) = grep { $_->{$p2} eq $b } @tgt;
 
$x and $y and
return $allowed{ $x->{idx} - $y->{idx} } && $e->();
 
my $try_stuff = sub {
my ($this, $p, $v, $sign) = @_;
for (@v) {
my $i = $this->{idx} + $sign * $_;
next unless $i >= 0 && $i < @tgt && !$tgt[$i]{$p};
local $tgt[$i]{$p} = $v;
$e->() and return 1;
}
return
};
 
$x and return $try_stuff->($x, $p2, $b, 1);
$y and return $try_stuff->($y, $p1, $a, -1);
 
for $x (@tgt) {
next if $x->{$p1};
local $x->{$p1} = $a;
$try_stuff->($x, $p2, $b, 1) and return 1;
}
};
}
 
# ---- above should be generic for all similar puzzles ---- #
 
# ---- below: per puzzle setup ---- #
# property names and values
setprops (
# Svensk n. a Swede, not a swede (kålrot).
# AEnglisk (from middle Viking "Æŋløsåksen") n. a Brit.
'Who' => [ qw(Deutsch Svensk Norske Danske AEnglisk) ],
'Pet' => [ qw(birds dog horse zebra cats) ],
'Drink' => [ qw(water tea milk beer coffee) ],
'Smoke' => [ qw(dunhill blue_master prince blend pall_mall) ],
'Color' => [ qw(red green yellow white blue) ]
);
 
# constraints
pair qw( AEnglisk red );
pair qw( Svensk dog );
pair qw( Danske tea );
pair qw( green white 1 ); # "to the left of" can mean either 1 or -1: ambiguous
pair qw( coffee green );
pair qw( pall_mall birds );
pair qw( yellow dunhill );
pair qw( 2 milk );
pair qw( 0 Norske );
pair qw( blend cats -1 1 );
pair qw( horse dunhill -1 1 );
pair qw( blue_master beer ); # Nicht das Deutsche Bier trinken? Huh.
pair qw( Deutsch prince );
pair qw( Norske blue -1 1 );
pair qw( water blend -1 1 );
 
$solve->();

Incidentally, the same logic can be used to solve the dwelling problem, if somewhat awkwardly:

...
# property names and values
setprops
'Who' => [ qw(baker cooper fletcher miller smith) ],
'Level' => [ qw(one two three four five) ];
 
# constraints
pair qw(0 one);
pair qw(1 two);
pair qw(2 three);
pair qw(3 four);
pair qw(4 five);
pair qw(baker five -4 -3 -2 -1 1 2 3 4);
pair qw(cooper one -4 -3 -2 -1 1 2 3 4);
pair qw(fletcher one -4 -3 -2 -1 1 2 3 4);
pair qw(fletcher five -4 -3 -2 -1 1 2 3 4);
pair qw(miller cooper -1 -2 -3 -4);
pair qw(smith fletcher 4 3 2 -2 -3 -4);
pair qw(cooper fletcher 4 3 2 -2 -3 -4);
 
$solve->();

[edit] PicoLisp

(be match (@House @Person @Drink @Pet @Cigarettes)
(permute (red blue green yellow white) @House)
(left-of @House white @House green)
 
(permute (Norwegian English Swede German Dane) @Person)
(has @Person English @House red)
(equal @Person (Norwegian . @))
(next-to @Person Norwegian @House blue)
 
(permute (tea coffee milk beer water) @Drink)
(has @Drink tea @Person Dane)
(has @Drink coffee @House green)
(equal @Drink (@ @ milk . @))
 
(permute (dog birds cats horse zebra) @Pet)
(has @Pet dog @Person Swede)
 
(permute (Pall-Mall Dunhill Blend Blue-Master Prince) @Cigarettes)
(has @Cigarettes Pall-Mall @Pet birds)
(has @Cigarettes Dunhill @House yellow)
(next-to @Cigarettes Blend @Pet cats)
(next-to @Cigarettes Dunhill @Pet horse)
(has @Cigarettes Blue-Master @Drink beer)
(has @Cigarettes Prince @Person German)
 
(next-to @Drink water @Cigarettes Blend) )
 
(be has ((@A . @X) @A (@B . @Y) @B))
(be has ((@ . @X) @A (@ . @Y) @B)
(has @X @A @Y @B) )
 
(be right-of ((@A . @X) @A (@ @B . @Y) @B))
(be right-of ((@ . @X) @A (@ . @Y) @B)
(right-of @X @A @Y @B) )
 
(be left-of ((@ @A . @X) @A (@B . @Y) @B))
(be left-of ((@ . @X) @A (@ . @Y) @B)
(left-of @X @A @Y @B) )
 
(be next-to (@X @A @Y @B) (right-of @X @A @Y @B))
(be next-to (@X @A @Y @B) (left-of @X @A @Y @B))

Test:

(pilog '((match @House @Person @Drink @Pet @Cigarettes))
(let Fmt (-8 -11 -8 -7 -11)
(tab Fmt "HOUSE" "PERSON" "DRINKS" "HAS" "SMOKES")
(mapc '(@ (pass tab Fmt))
@House @Person @Drink @Pet @Cigarettes ) ) )

Output:

HOUSE   PERSON     DRINKS  HAS    SMOKES
yellow  Norwegian  water   cats   Dunhill
blue    Dane       tea     horse  Blend
red     English    milk    birds  Pall-Mall
green   German     coffee  zebra  Prince
white   Swede      beer    dog    Blue-Master

[edit] Prolog

In Prolog we can specify the domain by selecting elements from it, making mutually exclusive choices for efficiency:

select([A|As],S):- select(A,S,S1),select(As,S1).
select([],_).
 
next_to(A,B,C):- left_of(A,B,C) ; left_of(B,A,C).
left_of(A,B,C):- append(_,[A,B|_],C).
 
zebra(Owns, HS):- % color,nation,pet,drink,smokes
HS = [h(_,norwegian,_,_,_),_, h(_,_,_,milk,_),_,_],
select( [h(red,englishman,_,_,_),h(_,swede,dog,_,_),
h(_,dane,_,tea,_), h(_,german,_,_,prince)], HS),
select( [h(_,_,birds,_,pallmall),h(yellow,_,_,_,dunhill),
h(_,_,_,beer,bluemaster)], HS),
left_of( h(green,_,_,coffee,_), h(white,_,_,_,_), HS),
next_to( h(_,_,_,_,dunhill), h(_,_,horse,_,_), HS),
next_to( h(_,_,_,_,blend), h(_,_,cats, _,_), HS),
next_to( h(_,_,_,_,blend), h(_,_,_,water,_), HS),
next_to( h(_,norwegian,_,_,_), h(blue,_,_,_,_), HS),
member( h(_,Owns,zebra,_,_), HS).
 
:- ?- time(( zebra(Who, HS), maplist(writeln,HS), nl, write(Who), nl, nl, fail
; write('No more solutions.') )).

Output:

h(yellow,norwegian, cats,  water, dunhill)
h(blue,  dane,      horse, tea,   blend)
h(red,   englishman,birds, milk,  pallmall)
h(green, german,    zebra, coffee,prince)
h(white, swede,     dog,   beer,  bluemaster)

german

No more solutions.
% 5,959 inferences, 0.000 CPU in 0.060 seconds (0% CPU, Infinite Lips)
true.

Works with SWI-Prolog. More verbose translation of the specification works as well.

[edit] Direct rule by rule translation

Using extensible records:

% populate domain by selecting from it
nation(H,V):- memberchk( nation(X), H), X=V. % select the "nation" attribute
owns( H,V):- memberchk( owns( X), H), X=V. % ...
smoke( H,V):- memberchk( smoke( X), H), X=V.
color( H,V):- memberchk( color( X), H), X=V.
drink( H,V):- memberchk( drink( X), H), X=V.
 
to_the_left(A,B,HS):- append(_,[A,B|_],HS).
next_to(A,B,HS):- to_the_left(A,B,HS) ; to_the_left(B,A,HS).
middle(A, [_,_,A,_,_]).
first(A, [A|_]).
 
zebra(Zebra,Houses):-
length(Houses,5),
member(H2, Houses), nation(H2, englishman), color( H2, red),
member(H3, Houses), nation(H3, swede), owns( H3, dog),
member(H4, Houses), nation(H4, dane), drink( H4, tea),
to_the_left(H5,H5b,Houses), color(H5, green), color(H5b, white),
member(H6, Houses), drink( H6, coffee), color( H6, green),
member(H7, Houses), smoke( H7, 'Pall Mall'), owns( H7, birds),
member(H8, Houses), color( H8, yellow), smoke( H8, 'Dunhill'),
middle(H9, Houses), drink( H9, milk),
first(H10, Houses), nation(H10, norwegian),
next_to(H11,H11b,Houses), smoke( H11, 'Blend'), owns( H11b, cats),
next_to(H12,H12b,Houses), owns( H12, horse), smoke(H12b, 'Dunhill'),
member(H13, Houses), drink( H13, beer), smoke( H13, 'Blue Master'),
member(H14, Houses), nation(H14, german), smoke( H14, 'Prince'),
next_to(H15,H15b,Houses), nation(H15, norwegian), color(H15b, blue),
next_to(H16,H16b,Houses), drink( H16, water), smoke(H16b, 'Blend'),
member(Zebra,Houses), owns(Zebra, zebra).
 

Output:

?- time(( zebra(Z,HS), ( maplist(length,HS,_) -> maplist(sort,HS,S),
maplist(writeln,S),nation(Z,R),nl,writeln(R) ), false ; true)).
 
[color(yellow),drink(water), nation(norwegian), owns(cats), smoke(Dunhill) ]
[color(blue), drink(tea), nation(dane), owns(horse), smoke(Blend) ]
[color(red), drink(milk), nation(englishman),owns(birds), smoke(Pall Mall) ]
[color(green), drink(coffee),nation(german), owns(zebra), smoke(Prince) ]
[color(white), drink(beer), nation(swede), owns(dog), smoke(Blue Master)]
 
german
% 138,899 inferences, 0.060 CPU in 0.110 seconds (55% CPU, 2311655 Lips)
true.
 

[edit] Alternative version

Works with: GNU Prolog
:- initialization(main).
 
 
zebra(X) :-
houses(Hs), member(h(_,X,zebra,_,_), Hs)
, findall(_, (member(H,Hs), write(H), nl), _), nl
, write('the one who keeps zebra: '), write(X), nl
.
 
 
houses(Hs) :-
Hs = [_,_,_,_,_] % 1
, H3 = h(_,_,_,milk,_), Hs = [_,_,H3,_,_] % 9
, H1 = h(_,nvg,_,_,_ ), Hs = [H1|_] % 10
 
, maplist( flip(member,Hs),
[ h(red,eng,_,_,_) % 2
, h(_,swe,dog,_,_) % 3
, h(_,dan,_,tea,_) % 4
, h(green,_,_,coffe,_) % 6
, h(_,_,birds,_,pm) % 7
, h(yellow,_,_,_,dh) % 8
, h(_,_,_,beer,bm) % 13
, h(_,ger,_,_,pri) % 14
])
 
, infix([ h(green,_,_,_,_)
, h(white,_,_,_,_) ], Hs) % 5
 
, maplist( flip(nextto,Hs),
[ [h(_,_,_,_,bl ), h(_,_,cats,_,_)] % 11
, [h(_,_,horse,_,_), h(_,_,_,_,dh )] % 12
, [h(_,nvg,_,_,_ ), h(blue,_,_,_,_)] % 15
, [h(_,_,_,water,_), h(_,_,_,_,bl )] % 16
])
.
 
 
flip(F,X,Y) :- call(F,Y,X).
 
infix(Xs,Ys) :- append(Xs,_,Zs) , append(_,Zs,Ys).
nextto(P,Xs) :- permutation(P,R), infix(R,Xs).
 
 
main :- findall(_, (zebra(_), nl), _), halt.
 
Output:
h(yellow,nvg,cats,water,dh)
h(blue,dan,horse,tea,bl)
h(red,eng,birds,milk,pm)
h(green,ger,zebra,coffe,pri)
h(white,swe,dog,beer,bm)

the one who keeps zebra: ger

[edit] Python

Translation of: D
import psyco; psyco.full()
 
class Content: elems= """Beer Coffee Milk Tea Water
Danish English German Norwegian Swedish
Blue Green Red White Yellow
Blend BlueMaster Dunhill PallMall Prince
Bird Cat Dog Horse Zebra"""
.split()
class Test: elems= "Drink Person Color Smoke Pet".split()
class House: elems= "One Two Three Four Five".split()
 
for c in (Content, Test, House):
c.values = range(len(c.elems))
for i, e in enumerate(c.elems):
exec "%s.%s = %d" % (c.__name__, e, i)
 
def finalChecks(M):
def diff(a, b, ca, cb):
for h1 in House.values:
for h2 in House.values:
if M[ca][h1] == a and M[cb][h2] == b:
return h1 - h2
assert False
 
return abs(diff(Content.Norwegian, Content.Blue,
Test.Person, Test.Color)) == 1 and \
diff(Content.Green, Content.White,
Test.Color, Test.Color) == -1 and \
abs(diff(Content.Horse, Content.Dunhill,
Test.Pet, Test.Smoke)) == 1 and \
abs(diff(Content.Water, Content.Blend,
Test.Drink, Test.Smoke)) == 1 and \
abs(diff(Content.Blend, Content.Cat,
Test.Smoke, Test.Pet)) == 1
 
def constrained(M, atest):
if atest == Test.Drink:
return M[Test.Drink][House.Three] == Content.Milk
elif atest == Test.Person:
for h in House.values:
if ((M[Test.Person][h] == Content.Norwegian and
h != House.One) or
(M[Test.Person][h] == Content.Danish and
M[Test.Drink][h] != Content.Tea)):
return False
return True
elif atest == Test.Color:
for h in House.values:
if ((M[Test.Person][h] == Content.English and
M[Test.Color][h] != Content.Red) or
(M[Test.Drink][h] == Content.Coffee and
M[Test.Color][h] != Content.Green)):
return False
return True
elif atest == Test.Smoke:
for h in House.values:
if ((M[Test.Color][h] == Content.Yellow and
M[Test.Smoke][h] != Content.Dunhill) or
(M[Test.Smoke][h] == Content.BlueMaster and
M[Test.Drink][h] != Content.Beer) or
(M[Test.Person][h] == Content.German and
M[Test.Smoke][h] != Content.Prince)):
return False
return True
elif atest == Test.Pet:
for h in House.values:
if ((M[Test.Person][h] == Content.Swedish and
M[Test.Pet][h] != Content.Dog) or
(M[Test.Smoke][h] == Content.PallMall and
M[Test.Pet][h] != Content.Bird)):
return False
return finalChecks(M)
 
def show(M):
for h in House.values:
print "%5s:" % House.elems[h],
for t in Test.values:
print "%10s" % Content.elems[M[t][h]],
print
 
def solve(M, t, n):
if n == 1 and constrained(M, t):
if t < 4:
solve(M, Test.values[t + 1], 5)
else:
show(M)
return
 
for i in xrange(n):
solve(M, t, n - 1)
M[t][0 if n % 2 else i], M[t][n - 1] = \
M[t][n - 1], M[t][0 if n % 2 else i]
 
def main():
M = [[None] * len(Test.elems) for _ in xrange(len(House.elems))]
for t in Test.values:
for h in House.values:
M[t][h] = Content.values[t * 5 + h]
 
solve(M, Test.Drink, 5)
 
main()
Output:
  One:      Water  Norwegian     Yellow    Dunhill        Cat
  Two:        Tea     Danish       Blue      Blend      Horse
Three:       Milk    English        Red   PallMall       Bird
 Four:     Coffee     German      Green     Prince      Zebra
 Five:       Beer    Swedish      White BlueMaster        Dog

Runtime about 0.18 seconds.

[edit] Alternative Version

from itertools import permutations
import psyco
psyco.full()
 
class Number:elems= "One Two Three Four Five".split()
class Color: elems= "Red Green Blue White Yellow".split()
class Drink: elems= "Milk Coffee Water Beer Tea".split()
class Smoke: elems= "PallMall Dunhill Blend BlueMaster Prince".split()
class Pet: elems= "Dog Cat Zebra Horse Bird".split()
class Nation:elems= "British Swedish Danish Norvegian German".split()
 
for c in (Number, Color, Drink, Smoke, Pet, Nation):
for i, e in enumerate(c.elems):
exec "%s.%s = %d" % (c.__name__, e, i)
 
def is_possible(number, color, drink, smoke, pet):
if number and number[Nation.Norvegian] != Number.One:
return False
if color and color[Nation.British] != Color.Red:
return False
if drink and drink[Nation.Danish] != Drink.Tea:
return False
if smoke and smoke[Nation.German] != Smoke.Prince:
return False
if pet and pet[Nation.Swedish] != Pet.Dog:
return False
 
if not number or not color or not drink or not smoke or not pet:
return True
 
for i in xrange(5):
if color[i] == Color.Green and drink[i] != Drink.Coffee:
return False
if smoke[i] == Smoke.PallMall and pet[i] != Pet.Bird:
return False
if color[i] == Color.Yellow and smoke[i] != Smoke.Dunhill:
return False
if number[i] == Number.Three and drink[i] != Drink.Milk:
return False
if smoke[i] == Smoke.BlueMaster and drink[i] != Drink.Beer:
return False
if color[i] == Color.Blue and number[i] != Number.Two:
return False
 
for j in xrange(5):
if (color[i] == Color.Green and
color[j] == Color.White and
number[j] - number[i] != 1):
return False
 
diff = abs(number[i] - number[j])
if smoke[i] == Smoke.Blend and pet[j] == Pet.Cat and diff != 1:
return False
if pet[i]==Pet.Horse and smoke[j]==Smoke.Dunhill and diff != 1:
return False
if smoke[i]==Smoke.Blend and drink[j]==Drink.Water and diff!=1:
return False
 
return True
 
def show_row(t, data):
print "%6s: %12s%12s%12s%12s%12s" % (
t.__name__, t.elems[data[0]],
t.elems[data[1]], t.elems[data[2]],
t.elems[data[3]], t.elems[data[4]])
 
def main():
perms = list(permutations(range(5)))
 
for number in perms:
if is_possible(number, None, None, None, None):
for color in perms:
if is_possible(number, color, None, None, None):
for drink in perms:
if is_possible(number, color, drink, None, None):
for smoke in perms:
if is_possible(number, color, drink, smoke, None):
for pet in perms:
if is_possible(number, color, drink, smoke, pet):
print "Found a solution:"
show_row(Nation, range(5))
show_row(Number, number)
show_row(Color, color)
show_row(Drink, drink)
show_row(Smoke, smoke)
show_row(Pet, pet)
print
 
main()

Output:

Found a solution:
Nation:      British     Swedish      Danish   Norvegian      German
Number:        Three        Five         Two         One        Four
 Color:          Red       White        Blue      Yellow       Green
 Drink:         Milk        Beer         Tea       Water      Coffee
 Smoke:     PallMall  BlueMaster       Blend     Dunhill      Prince
   Pet:         Bird         Dog       Horse         Cat       Zebra

[edit] Racket

Translation of: Prolog
#lang racket
 
(require racklog)
 
(define %select
(%rel (x xs S S1)
[(x (cons x xs) xs)]
[(x (cons S xs) (cons S S1)) (%select x xs S1)]
[((cons x xs) S)
(%select x S S1)
(%select xs S1)]
[('() (_))]))
 
(define %next-to
(%rel (A B C)
[(A B C)
(%or (%left-of A B C)
(%left-of B A C))]))
 
(define %left-of
(%rel (A B C)
[(A B C) (%append (_) (cons A (cons B (_))) C)]))
 
(define %zebra
(%rel (Owns HS)
[(Owns HS)
(%is HS (list (list (_) 'norwegian (_) (_) (_))
(_)
(list (_) (_) (_) 'milk (_))
(_) (_)))
(%select (list (list 'red 'englishman (_) (_) (_))
(list (_) 'swede 'dog (_) (_))
(list (_) 'dane (_) 'tea (_))
(list (_) 'german (_) (_) 'prince))
HS)
(%select (list (list (_) (_) 'birds (_) 'pallmall)
(list 'yellow (_) (_) (_) 'dunhill)
(list (_) (_) (_) 'beer 'bluemaster))
HS)
(%left-of (list 'green (_) (_) 'coffee (_))
(list 'white (_) (_) (_) (_))
HS)
(%next-to (list (_) (_) (_) (_) 'dunhill)
(list (_) (_) 'horse (_) (_))
HS)
(%next-to (list (_) (_) (_) (_) 'blend)
(list (_) (_) 'cats (_) (_))
HS)
(%next-to (list (_) (_) (_) (_) 'blend)
(list (_) (_) (_) 'water (_))
HS)
(%next-to (list (_) 'norwegian (_) (_) (_))
(list 'blue (_) (_) (_) (_))
HS)
(%member (list (_) Owns 'zebra (_) (_)) HS)]))
 
(%which (Who HS) (%zebra Who HS))

Output:

'((Who . german)
  (HS
   (yellow norwegian cats water dunhill)
   (blue dane horse tea blend)
   (red englishman birds milk pallmall)
   (green german zebra coffee prince)
   (white swede dog beer bluemaster)))

[edit] Scala

Library: Scala
/* Note to the rules:
*
* It can further concluded that:
* 5a: The green house cannot be at the h1 position
* 5b: The white house cannot be at the h5 position
*
* 16: This rule is redundant.
*/

 
object Einstein extends App {
class House(val nationality: String, val color: String, val beverage: String, val animal: String, val brand: String) {
override def toString = { f"$nationality%10s, ${color + ", "}%-8s$beverage,\t$animal,\t$brand." }
 
def totalUnEqual(home2: House) =
this.animal != home2.animal &&
this.beverage != home2.beverage &&
this.brand != home2.brand &&
this.color != home2.color &&
this.nationality != home2.nationality
 
//** Checks if the this green house is next to the other white house*/
def checkAdjacentWhite(home2: House) = (this.color == "Green") == (home2.color == "White") // #5
}
 
val possibleMembers = for { //78 members
nationality <- List("Norweigan", "German", "Dane", "Englishman", "Swede")
color <- List("Red", "Green", "Yellow", "White", "Blue")
beverage <- List("Milk", "Coffee", "Tea", "Beer", "Water")
animal <- List("Dog", "Horse", "Birds", "Cats", "Zebra")
brand <- List("Blend", "Pall Mall", "Prince", "Blue Master", "Dunhill")
if ((color == "Red") == (nationality == "Englishman")) // #2
if ((nationality == "Swede") == (animal == "Dog")) // #3
if ((nationality == "Dane") == (beverage == "Tea")) // #4
if ((color == "Green") == (beverage == "Coffee")) // #6
if ((brand == "Pall Mall") == (animal == "Birds")) // #7
if ((brand == "Dunhill") == (color == "Yellow")) // #8
if ((brand == "Blue Master") == (beverage == "Beer")) // #13
if ((brand == "Prince") == (nationality == "German")) // #14
} yield new House(nationality, color, beverage, animal, brand)
 
def matchMiddleBrandAnimal(home1: House, home2: House, home3: House, brand: String, animal: String) =
(home1.animal == animal || home2.brand != brand || home3.animal == animal) &&
(home1.brand == brand || home2.animal != animal || home3.brand == brand)
 
def matchCornerBrandAnimal(corner: House, inner: House, animal: String, brand: String) =
(corner.brand != brand || inner.animal == animal) && (corner.animal == animal || inner.brand != brand)
 
def housesLeftOver(pickedHouses: House*): List[House] = {
possibleMembers.filter(house => pickedHouses.forall(_.totalUnEqual(house)))
}
 
val members = for {
h1 <- housesLeftOver().filter(p => (p.nationality == "Norweigan" /* #10 */ ) && (p.color != "Green") /* #5a */ ) // 28
h3 <- housesLeftOver(h1).filter(p => (p.beverage == "Milk")) // #9 // 24
h2 <- housesLeftOver(h1, h3).filter(_.color == "Blue") // #15
if matchMiddleBrandAnimal(h1, h2, h3, "Blend", "Cats") // #11
if matchCornerBrandAnimal(h1, h2, "Horse", "Dunhill") // #12
h4 <- housesLeftOver(h1, h2, h3).filter(_.checkAdjacentWhite(h3) /* #5 */ )
h5 <- housesLeftOver(h1, h2, h3, h4)
 
// Redundant tests
if h2.checkAdjacentWhite(h1)
if h3.checkAdjacentWhite(h2)
if matchCornerBrandAnimal(h5, h4, "Horse", "Dunhill")
if matchMiddleBrandAnimal(h2, h3, h4, "Blend", "Cats")
if matchMiddleBrandAnimal(h3, h4, h5, "Blend", "Cats")
} yield Seq(h1, h2, h3, h4, h5)
 
// Main program
val beest = "Zebra"
members.flatMap(p => p.filter(p => p.animal == beest)).
foreach(s => println(s"The ${s.nationality} is the owner of the ${beest.toLowerCase()}."))
 
println(s"The ${members.size} solution(s) are:")
members.foreach(solution => solution.zipWithIndex.foreach(h => println("House " + (h._2 + 1) + " " + h._1)))
}
Output:
The German is the owner of the zebra.
The 1 solution(s) are:
House 1  Norweigan, Yellow, Water,	Cats,	Dunhill.
House 2       Dane, Blue,   Tea,	Horse,	Blend.
House 3 Englishman, Red,    Milk,	Birds,	Pall Mall.
House 4      Swede, White,  Beer,	Dog,	Blue Master.
House 5     German, Green,  Coffee,	Zebra,	Prince.

[edit] Tcl

Translation of: Python
Library: Tcllib (Package: struct::list)
package require struct::list
 
# Implements the constants by binding them directly into the named procedures.
# This is much faster than the alternatives!
proc initConstants {args} {
global {}
set remap {}
foreach {class elems} {
Number {One Two Three Four Five}
Color {Red Green Blue White Yellow}
Drink {Milk Coffee Water Beer Tea}
Smoke {PallMall Dunhill Blend BlueMaster Prince}
Pet {Dog Cat Horse Bird Zebra}
Nation {British Swedish Danish Norwegian German}
} {
set i -1
foreach e $elems {lappend remap "\$${class}($e)" [incr i]}
set ($class) $elems
}
foreach procedure $args {
proc $procedure [info args $procedure] \
[string map $remap [info body $procedure]]
}
}
 
proc isPossible {number color drink smoke pet} {
if {[llength $number] && [lindex $number $Nation(Norwegian)] != $Number(One)} {
return false
} elseif {[llength $color] && [lindex $color $Nation(British)] != $Color(Red)} {
return false
} elseif {[llength $drink] && [lindex $drink $Nation(Danish)] != $Drink(Tea)} {
return false
} elseif {[llength $smoke] && [lindex $smoke $Nation(German)] != $Smoke(Prince)} {
return false
} elseif {[llength $pet] && [lindex $pet $Nation(Swedish)] != $Pet(Dog)} {
return false
}
 
if {!([llength $number] && [llength $color] && [llength $drink] && [llength $smoke] && [llength $pet])} {
return true
}
 
for {set i 0} {$i < 5} {incr i} {
if {[lindex $color $i] == $Color(Green) && [lindex $drink $i] != $Drink(Coffee)} {
return false
} elseif {[lindex $smoke $i] == $Smoke(PallMall) && [lindex $pet $i] != $Pet(Bird)} {
return false
} elseif {[lindex $color $i] == $Color(Yellow) && [lindex $smoke $i] != $Smoke(Dunhill)} {
return false
} elseif {[lindex $number $i] == $Number(Three) && [lindex $drink $i] != $Drink(Milk)} {
return false
} elseif {[lindex $smoke $i] == $Smoke(BlueMaster) && [lindex $drink $i] != $Drink(Beer)} {
return false
} elseif {[lindex $color $i] == $Color(Blue) && [lindex $number $i] != $Number(Two)} {
return false
}
 
for {set j 0} {$j < 5} {incr j} {
if {[lindex $color $i] == $Color(Green) && [lindex $color $j] == $Color(White) && [lindex $number $j] - [lindex $number $i] != 1} {
return false
}
 
set diff [expr {abs([lindex $number $i] - [lindex $number $j])}]
if {[lindex $smoke $i] == $Smoke(Blend) && [lindex $pet $j] == $Pet(Cat) && $diff != 1} {
return false
} elseif {[lindex $pet $i] == $Pet(Horse) && [lindex $smoke $j] == $Smoke(Dunhill) && $diff != 1} {
return false
} elseif {[lindex $smoke $i] == $Smoke(Blend) && [lindex $drink $j] == $Drink(Water) && $diff != 1} {
return false
}
}
}
 
return true
}
 
proc showRow {t data} {
upvar #0 ($t) elems
puts [format "%6s: %12s%12s%12s%12s%12s" $t \
[lindex $elems [lindex $data 0]] \
[lindex $elems [lindex $data 1]] \
[lindex $elems [lindex $data 2]] \
[lindex $elems [lindex $data 3]] \
[lindex $elems [lindex $data 4]]]
}
 
proc main {} {
set perms [struct::list permutations {0 1 2 3 4}]
foreach number $perms {
if {![isPossible $number {} {} {} {}]} continue
foreach color $perms {
if {![isPossible $number $color {} {} {}]} continue
foreach drink $perms {
if {![isPossible $number $color $drink {} {}]} continue
foreach smoke $perms {
if {![isPossible $number $color $drink $smoke {}]} continue
foreach pet $perms {
if {[isPossible $number $color $drink $smoke $pet]} {
puts "Found a solution:"
showRow Nation {0 1 2 3 4}
showRow Number $number
showRow Color $color
showRow Drink $drink
showRow Smoke $smoke
showRow Pet $pet
puts ""
}
}
}
}
}
}
}
 
initConstants isPossible
main
Output:
Found a solution:
Nation:      British     Swedish      Danish   Norwegian      German
Number:        Three        Five         Two         One        Four
 Color:          Red       White        Blue      Yellow       Green
 Drink:         Milk        Beer         Tea       Water      Coffee
 Smoke:     PallMall  BlueMaster       Blend     Dunhill      Prince
   Pet:         Bird         Dog       Horse         Cat       Zebra
Personal tools
Namespaces

Variants
Actions
Community
Explore
Misc
Toolbox