Zebra puzzle: Difference between revisions

← Older editNewer edit →
Content deleted Content added
→‎{{header|C}}: well, sort of
→‎{{header|C}}: reduce both C and Perl source code size, though the C source source is unreadable without indent (and cpp)
Line 30: Line 30:
no strict;
no strict;


my (%props, %name, @pre, @conds, @works);
my (%props, %name, @pre, @conds, @works, $find_all_solutions);


sub do_consts {
sub do_consts {
Line 43: Line 43:
print "char *string_$p [] = { \"###\", \"@s\" };\n\n";
print "char *string_$p [] = { \"###\", \"@s\" };\n\n";
}
}
print "#define FIND_BY(p) \\
for (keys %props) {
int find_by_##p(int v) { \\
print << "SNIPPET";
int i; \\
int find_by_$_(int val) {
for (i = 0; i < N_ITEMS; i++) \\
int i;
for (i = 0; i < N_ITEMS; i++)
if (house[i].p == v) return i; \\
return -1; }\n";
if (house[i].$_ == val) return i;

return -1;
print "FIND_BY($_);\n" for (keys %props);
}
SNIPPET
}


local $" = ", ";
local $" = ", ";
Line 67: Line 65:
int work0(void) {
int work0(void) {
int i;
int i;
for (i = 0; i < N_ITEMS; i++) {
for (i = 0; i < N_ITEMS; i++)
printf("%d $fmt\\n", i, @arg);
printf("%d $fmt\\n", i, @arg);
puts(\"\");
}
return 1;
return 1;
}
}
Line 89: Line 87:
$name{$_} = $p for @s;
$name{$_} = $p for @s;
}
}
print "#include <stdio.h>\n";
print "#define N_PROPS ", scalar(@k), "\n";

local $" = ", ";
local $" = ", ";
print "#define N_ITEMS $l\n
print "#include <stdio.h>
#define N_ITEMS $l
struct item_t { int @k; } house[N_ITEMS] = {{0}};\n";
struct item_t { int @k; } house[N_ITEMS] = {{0}};\n";
}
}
Line 107: Line 103:
sub make_conditions {
sub make_conditions {
my $idx = 0;
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) {
while (@conds) {
my ($c1, $c2, $diff) = @{ pop @conds };
my ($c1, $c2, $diff) = @{ pop @conds };
Line 112: Line 119:


if ($c1 =~ /^\d+$/) {
if ($c1 =~ /^\d+$/) {
push @pre, "house[$c1].$p2 = $c2;\n";
push @pre, "house[$c1].$p2 = $c2;";
next;
next;
}
}


my $p1 = $name{$c1} or die "bad prop $c1";
my $p1 = $name{$c1} or die "bad prop $c1";
my @txt;
my $next = "work$idx";
my $next = "work$idx";
my $this = "work".++$idx;
my $this = "work".++$idx;


push @txt, << "SNIPPET";
print << "SNIPPET";
/* condition pair($c1, $c2, [@$diff]) */
/* condition pair($c1, $c2, [@$diff]) */
int $this(void) {
int $this(void) {
int a = find_by_$p1($c1);
/*
int b = find_by_$p2($c2);
work0();
if (a != -1 && b != -1) {
puts("$this");
switch(b - a) {
getchar();
*/
int a = find_by_$p1($c1);
int b = find_by_$p2($c2);
if (a != -1 && b != -1) {
switch(b - a) {
SNIPPET
SNIPPET
push @txt, "case $_: " for @$diff;
print "case $_: " for @$diff;
push @txt, "return $next(); default: return 0; }\n";
print "return $next(); default: return 0; }\n } if (a != -1) {";
print "TRY(a, b, $c2, +($_), $p2, $next);" for @$diff;
push @txt, << "SNIPPET";
print " return 0; } if (b != -1) {";
}
print "TRY(b, a, $c1, -($_), $p1, $next);" for @$diff;

print << "SNIPPET";
if (a != -1) {
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
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
}


print "TRY(a, b, $c2, +($_), $p2, $next);" for @$diff;
push @txt, << "SNIPPET";
return 0;
print " house[a].$p1 = 0; } 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
}


print "int main() { @pre return !work$idx(); }";
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
}
}


Line 249: Line 194:
# the logic. It's here just to make sure the code will insert a zebra
# 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
# 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
# final print-out shows it. The C code can be better structured, but
# meh, I ain't reading it, so who cares).
# meh, I ain't reading it, so who cares.
pair(zebra, AEnglisk, [ -4 .. 4 ]);
pair(zebra, AEnglisk, [ -4 .. 4 ]);


# write C code. If it's ugly to you: I didn't write; Perl did.
# write C code. If it's ugly to you: I didn't write it; Perl did.
make_c;</lang>
make_c;</lang>
output (ran as <code>perl test.pl | gcc -Wall -x c -; ./a.out</code>):<pre>
output (ran as <code>perl test.pl | gcc -Wall -x c -; ./a.out</code>):<pre>
Line 262: Line 207:
4 blue_master dog white beer Svensk
4 blue_master dog white beer Svensk
</pre>
</pre>

=={{header|Prolog}}==
=={{header|Prolog}}==


Retrieved from "https://rosettacode.org/wiki/Zebra_puzzle"