For real "fun" try to solve this one with regexes

The following version of the puzzle appeared in Life International in 1962:

• There are five houses.
• The Englishman lives in the red house.
• The Spaniard owns the dog.
• Coffee is drunk in the green house.
• The Ukrainian drinks tea.
• The green house is immediately to the right of the ivory house.
• The Old Gold smoker owns snails.
• Kools are smoked in the yellow house.
• Milk is drunk in the middle house.
• The Norwegian lives in the first house.
• The man who smokes Chesterfields lives in the house next to the man with the fox.
• Kools are smoked in the house next to the house where the horse is kept.
• The Lucky Strike smoker drinks orange juice.
• The Japanese smokes Parliaments.
• The Norwegian lives next to the blue house.

update

Now, who drinks water? Who owns the zebra?

In the interest of clarity, it must be added that each of the five houses is painted a different color, and their inhabitants are of different national extractions, own different pets, drink different beverages and smoke different brands of American cigarets sic. One other thing: in statement 6, right means your right.

— Life International, December 17, 1962

update end

At some point you will need a branch and bound algorithm here, maybe by exploiting the backtracking of the regex engine.

Good fun! ;)

Extra motivation: you can add your potential regex solution to Rosetta code then.

That was fun :) Thanks!

#!/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;
    }
  }
[download]

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
[download]

The s/// are logical cell fillers.
The // and next are validation.

Update

s/spot/zebra/;
s/drink/water/;
[download]

>

  if( /\S+,\S+/ ) # if some cell has a comma, fork (sort of)
    {
    push @stack, $` . $_ . $' for split /,/, $&;
    }
[download]

Please correct me, but this looks like branching with pure Perl means.

Instead of recursive calls, you are pushing different alternatives on a stack.

Would be more "fun" if the branching was implemented with regexes... ;-)

Cheers Rolf
_{(addicted to the Perl Programming Language and ☆☆☆☆ :)
Wikisyntax for the Monastery}

> # 2 pets (only 4 mentioned, 5th called 'spot')

> # 3 drink (only 4 mentioned, 5th called 'drink')

Argh sorry, that's clearer if the full question is given:

Now, who drinks water? Who owns the zebra?

I updated my post. :)

Cheers Rolf
_{(addicted to the Perl Programming Language and ☆☆☆☆ :)
Wikisyntax for the Monastery}

A frightening, very SM kind of fun! ;-)