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, $find_all_solutions);
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"; } 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($_);\n" 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] = 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; my $return1 = $find_all_solutions ? "" : "return 1"; print << "SNIPPET";
- 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; \\ }} SNIPPET
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 << "SNIPPET"; /* 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) { SNIPPET 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 << "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
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 it; 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.