Zebra puzzle: Difference between revisions

=={{header|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] = {{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 <code>perl test.pl | gcc -Wall -x c -; ./a.out</code>):<pre>

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

</pre>