#!/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,milk,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,milk,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,milk,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,milk,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,milk,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 next;
    / (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 next;
    / (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*/fox/;
    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 kept.
    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 next;

# 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 cell
        {
        s/^(?:\S+ ){$col}(?:\K$cell,|\S+\K,$cell\b)//gm; # delete in other 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;
    }
  }