Zebra puzzle
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:
- There are five houses.
- The English man lives in the red house.
- The Swede has a dog.
- The Dane drinks tea.
- The green house is immediately to the left of the white house.
- They drink coffee in the green house.
- The man who smokes Pall Mall has birds.
- In the yellow house they smoke Dunhill.
- In the middle house they drink milk.
- The Norwegian lives in the first house.
- The man who smokes Blend lives in the house next to the house with cats.
- In a house next to the house where they have a horse, they smoke Dunhill.
- The man who smokes Blue Master drinks beer.
- The German smokes Prince.
- The Norwegian lives next to the blue house.
- They drink water in a house next to the house where they smoke Blend.
The question is, who owns the zebra?
cf. Dinesman's multiple-dwelling problem
C
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. <lang perl>#!/usr/bin/perl
use utf8; no strict;
my (%props, %name, @pre, @conds, @works);
sub do_consts { local $"; for my $p (keys %props) { my @s = @{ $props{$p} };
$" = ", "; print "enum { ${p}_none = 0, @s };\n";
$" = '", "'; print "char *string_$p [] = { \"###\", \"@s\" };\n\n"; } for (keys %props) { print << "SNIPPET"; int find_by_$_(int val) { int i; for (i = 0; i < N_ITEMS; i++) if (house[i].$_ == val) return i; return -1; } SNIPPET }
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); } 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; } print "#include <stdio.h>\n"; print "#define N_PROPS ", scalar(@k), "\n";
local $" = ", "; print "#define N_ITEMS $l\n struct item_t { int @k; } house[N_ITEMS] = Template:0;\n"; }
sub pair { my ($c1, $c2, $diff) = @_; $diff //= [0]; $diff = [$diff] unless ref $diff;
push @conds, [$c1, $c2, $diff]; }
sub make_conditions { my $idx = 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;\n"; next; }
my $p1 = $name{$c1} or die "bad prop $c1"; my @txt; my $next = "work$idx"; my $this = "work".++$idx;
push @txt, << "SNIPPET"; /* condition pair($c1, $c2, [@$diff]) */ int $this(void) { /* work0(); puts("$this"); getchar();
- /
int a = find_by_$p1($c1); int b = find_by_$p2($c2); if (a != -1 && b != -1) { switch(b - a) { SNIPPET push @txt, "case $_: " for @$diff; push @txt, "return $next(); default: return 0; }\n"; push @txt, << "SNIPPET"; }
if (a != -1) { SNIPPET for (@$diff) { push @txt, << "SNIPPET"; b = a + ($_); if (b >= 0 && b < N_ITEMS) { if (!house[b].$p2) { house[b].$p2 = $c2; if ($next()) return 1; house[b].$p2 = 0; } } SNIPPET }
push @txt, << "SNIPPET"; return 0; } if (b != -1) { SNIPPET for (@$diff) { push @txt, << "SNIPPET"; a = b - ($_); if (a >= 0 && a < N_ITEMS) { if (!house[a].$p1) { house[a].$p1 = $c1; if ($next()) return 1; house[a].$p1 = 0; } } SNIPPET } push @txt, << "SNIPPET"; 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; SNIPPET for (@$diff) { push @txt, << "SNIPPET"; b = a + ($_); if (b >= 0 && b < N_ITEMS) { if (!house[b].$p2) { house[b].$p2 = $c2; if ($next()) return 1; house[b].$p2 = 0; } } SNIPPET }
push @txt, << "SNIPPET"; house[a].$p1 = 0; } return 0; } SNIPPET push @works, join(, @txt); }
print @works; print << "SNIPPET"; int main() { @pre return !work$idx(); } SNIPPET }
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;</lang>
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
Prolog
In Prolog we can specify the domain by selecting from it, making mutually exclusive choices for efficiency:
<lang Prolog>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(blue,_,_,_,_),h(_,_,_,milk,_),_,_], select( [h(red,eng,_,_,_),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), member( h(_,Owns,zebra,_,_), HS).
- - findall(Who,zebra(Who,_),L).</lang>
Output: <lang Prolog> L = [german].</lang>
Works with SWI-Prolog.