#!/usr/bin/perl -l
# http://perlmonks.org/?node_id=1209931
use strict;
use warnings;
# columns
# 0 house number left to right
# 1 colors
# 2 pets (only 4 mentioned, 5th called 'spot')
# 3 drink (only 4 mentioned, 5th called 'drink')
# 4 nationality
# 5 smokes
$_ = <<END; # starting configuration
1 blue,red,green,ivory,yellow dog,snails,fox,horse,spot coffee,tea,mil
+k,orangejuice,drink Englishman,Spaniard,Ukrainian,Japanese,Norwegian
+OldGold,Kools,Chesterfields,LuckyStrike,Parliaments
2 blue,red,green,ivory,yellow dog,snails,fox,horse,spot coffee,tea,mil
+k,orangejuice,drink Englishman,Spaniard,Ukrainian,Japanese,Norwegian
+OldGold,Kools,Chesterfields,LuckyStrike,Parliaments
3 blue,red,green,ivory,yellow dog,snails,fox,horse,spot coffee,tea,mil
+k,orangejuice,drink Englishman,Spaniard,Ukrainian,Japanese,Norwegian
+OldGold,Kools,Chesterfields,LuckyStrike,Parliaments
4 blue,red,green,ivory,yellow dog,snails,fox,horse,spot coffee,tea,mil
+k,orangejuice,drink Englishman,Spaniard,Ukrainian,Japanese,Norwegian
+OldGold,Kools,Chesterfields,LuckyStrike,Parliaments
5 blue,red,green,ivory,yellow dog,snails,fox,horse,spot coffee,tea,mil
+k,orangejuice,drink Englishman,Spaniard,Ukrainian,Japanese,Norwegian
+OldGold,Kools,Chesterfields,LuckyStrike,Parliaments
END
my @stack = $_;
while( $_ = pop @stack )
{
my $prev;
do
{
#print;
$prev = $_;
# The Englishman lives in the red house.
s/ \K\S*red\S*(?= (\S+ ){2}Englishman )/red/;
s/ red (\S+ ){2}\K\S*Englishman\S*/Englishman/;
/ red .* (Norwegian|Spaniard|Japanese|Ukrainian) / and next;
/ (blue|ivory|green|yellow) .* Englishman / and next;
# The Spaniard owns the dog.
s/ \K\S*dog\S*(?= \S+ Spaniard )/dog/;
s/ dog \S+ \K\S*Spaniard\S*/Spaniard/;
/ dog .* (Norwegian|Japanese|Englishman|Ukrainian) / and next;
/ (horse|snails|fox|spot) .* Spaniard / and next;
# Coffee is drunk in the green house.
s/ green \S+ \K\S*coffee\S*/coffee/;
s/ \K\S*green\S*(?= \S+ coffee )/green/;
/ green .* (drink|orangejuice|milk|tea) / and next;
/ (red|blue|ivory|yellow) .* coffee / and next;
# The Ukrainian drinks tea.
s/ \K\S*tea\S*(?= Ukrainian )/tea/;
s/ tea \K\S*Ukrainian\S*/Ukrainian/;
/ tea (Norwegian|Spaniard|Japanese|Englishman) / and next;
/ (drink|orangejuice|milk|coffee) Ukrainian / and next;
# The green house is immediately to the right of the ivory house.
s/1 \K(green,|,green)//;
s/5 .*\K(ivory,|,ivory)//;
s/ ivory .*\n\d \K\S*green\S*/green/;
s/ \K\S*ivory\S*(?= .*\n.* green )/ivory/;
/ ivory (.*\n){2,}.* green / and next;
/ green (.*\n)+.* ivory / and next;
# The Old Gold smoker owns snails.
s/ \K\S*snails\S*(?= (\S+ ){2}OldGold\s)/snails/;
s/ snails (\S+ ){2}\K\S*OldGold\S*/OldGold/;
/ snails .* (LuckyStrike|Parliaments|Chesterfields|Kools)\s/ and n
+ext;
/ (dog|fox|house|spot) .* OldGold\s/ and next;
# Kools are smoked in the yellow house.
s/ yellow (\S+ ){3}\K\S*Kools\S*/Kools/;
s/ \K\S*yellow\S*(?= (\S+ ){3}Kools\s)/yellow/;
/ yellow ,* (LuckyStrike|Parliaments|Chesterfields|Kools)\s/ and n
+ext;
/ (red|blue|ivory|green) .* Kools\s/ and next;
# Milk is drunk in the middle house.
s/3 (\S+ ){2}\K\S*milk\S*/milk/;
# The Norwegian lives in the first house.
s/1 (\S+ ){3}\K\S*Norwegian\S*/Norwegian/;
# The man who smokes Chesterfields lives in the house next to the man
+with the fox.
s/1 .* fox .*\n(\S+ ){5}\K\S*Chesterfields\S*/Chesterfields/;
s/ \K\S*fox\S*(?= .*\n5 .* Chesterfields\n)/fox/;
s/ (dog,horse,snails,spot) .*\n.* Chesterfields\n.* \K\S*fox\S*/fo
+x/;
s/ \K\S*fox\s*(?= .*\n.* Chesterfields\n.* (dog,horse,snails,spot)
+ )/fox/;
/ fox .* Chesterfields\s/ and next;
/ fox (.*\n){2,}.* Chesterfields\s/ and next;
/ Chesterfields\n(.*\n)+.* fox / and next;
# Kools are smoked in the house next to the house where the horse is k
+ept.
s/1 .* Kools\n(\S+ ){2}\K\S*horse\S*/horse/;
s/ \K\S*horse\S*(?= .*\n5 .* Kools\n)/horse/;
/ horse .* Kools\s/ and next;
/ horse (.*\n){2,}.* Kools\s/ and next;
/ Kools\n(.*\n)+.* horse / and next;
# The Lucky Strike smoker drinks orange juice.
s/ orangejuice \S+ \K\S*LuckyStrike\S*/LuckyStrike/;
s/ \K\S*orangejuice\S*(?= \S+ LuckyStrike\s)/orangejuice/;
/ orangejuice .* (OldGold|Parliaments|Chesterfields|Kools)\s/ and
+next;
/ (drink|milk|coffee|tea) .* .LuckyStrike\s/ and next;
# The Japanese smokes Parliaments.
s/ Japanese \K\S*Parliaments\S*/Parliaments/;
s/ \K\S*Japanese\S*(?= Parliaments\s)/Japanese/;
/ Japanese (OldGold|LuckyStrike|Chesterfields|Kools)\s/ and next;
/ (Norwegian|Spaniard|Englishman|Ukrainian) Parliaments\s/ and nex
+t;
# The Norwegian lives next to the blue house.
s/1 .* Norwegian .*\n\d \K\S+/blue/;
s/ \K\S*blue\s*(?= .*\n5 .* Norwegian .*\n)/blue/;
/ blue .* Norwegian / and next;
/ blue (.*\n)+.* Norwegian / and next;
/ Norwegian (.*\n){2,}.* blue / and next;
for my $col (1 .. tr/ // / tr/\n// ) # for each column
{
for my $cell ( /^(?:\S+ ){$col}(\w+)\s/gm ) # find each single c
+ell
{
s/^(?:\S+ ){$col}(?:\K$cell,|\S+\K,$cell\b)//gm; # delete in o
+ther rows
}
}
} until $_ eq $prev;
if( /\S+,\S+/ ) # if some cell has a comma, fork (sort of)
{
push @stack, $` . $_ . $' for split /,/, $&;
}
else
{
print "Solution:\n\n$_";
exit;
}
}
Outputs:
Solution:
1 yellow fox drink Norwegian Kools
2 blue horse tea Ukrainian Chesterfields
3 red snails milk Englishman OldGold
4 ivory dog orangejuice Spaniard LuckyStrike
5 green spot coffee Japanese Parliaments
The s/// are logical cell fillers.
The // and next are validation.
Update
s/spot/zebra/;
s/drink/water/;
| 
