Zebra puzzle: Difference between revisions
Content deleted Content added
No edit summary |
→{{header|C}}: well, sort of |
||
Line 23:
cf. [[Dinesman's multiple-dwelling problem]]
=={{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>
=={{header|Prolog}}==
| |||