Version 3 of The Einstein puzzle

Updated 2005-03-19 11:28:02 by suchenwi

if 0 {Richard Suchenwirth 2005-03-19 - Albert Einstein is said to have presented this puzzle (read [L1 ] for details, or google for "Einstein puzzle"):

There's five houses in a row, each in a different color, inhabited by a different national who has a different pet, drinks a different beverage, and smokes a different brand of cigarettes.

Given the initial facts:

  • (1) The Brit lives in the red house.
  • (2) The Swede keeps dogs as pets.
  • (3) The Dane drinks tea.
  • (4) The green house is on the left of the white house.
  • (5) The green house's owner drinks coffee.
  • (6) The person who smokes Pall Mall rears birds.
  • (7) The owner of the yellow house smokes Dunhill.
  • (8) The man living in the center house drinks milk.
  • (9) The Norwegian lives in the first house.
  • (10) The man who smokes Blends lives next to the one who keeps cats.
  • (11) The man who keeps the horse lives next to the man who smokes Dunhill.
  • (12) The owner who smokes Bluemasters drinks beer.
  • (13) The German smokes Prince.
  • (14) The Norwegian lives next to the blue house.
  • (15) The man who smokes Blends has a neighbor who drinks water.

The question is: "Who owns the fish?"

After doing it manually, I wanted to try Tcl on it too. I decided to number the houses as {1 2 3 4 5} from left to right, and implement a "predicate" as a variable which has one of the house numbers as value. Some can be set immediately from the facts ("set milk 3" meaning "the person who drinks milk lives in house 3, i.e. the middle one").

Possible assignments are generated by permutations. To make this code run faster on my 200MHz W95 box, I added quick tests that just cause the testing loop to continue. All possibilities are tried, in case there is more than one solution. }

 proc EinsteinPuzzle {} {
    #-- Immediately resulting from the facts:
    set milk 3      ;# (8)
    set Norwegian 1 ;# (9)
    set blue 2      ;# (14)
    #-- let's try many things!
    try {Brit Swede Dane German} {2 3 4 5} {
        try {red white yellow green} {1 3 4 5} {
            if {$green != $white-1} continue        ;# (4)
            if {$Brit != $red}      continue        ;# (1)
            try {dog birds cats horse fish} {1 2 3 4 5} {
                if {$Swede != $dog} continue        ;# (2)
                try {tea coffee beer water} {1 2 4 5} {
                    if {$Dane != $tea}     continue ;# (3)
                    if {$green != $coffee} continue ;# (5)
                    try {PallMall Dunhill Bluemasters Prince Blends} \
                        {1 2 3 4 5} {
                          #-- test the leftover conditions
                          if {
                            $PallMall == $birds &&
                            $yellow == $Dunhill &&
                            [next $Blends $cats] &&
                            [next $horse $Dunhill] &&
                            $Bluemasters == $beer &&
                            $German == $Prince &&
                            [next $Blends $water]
                          } dump
                    }
                }
            }
        }
    }
 }

#-- Borrowed from Permutations, Lars H's version:

 proc permute {list {prefix ""}} {
    if {![llength $list]} {return [list $prefix]}
    set res [list]
    set n 0
    foreach e $list {
        eval [list lappend res]\
          [permute [lreplace $list $n $n] [linsert $prefix end $e]]
        incr n
    }
    return $res
 }

#-- Neighborhood relation is factored out:

 proc next {x y} {expr {abs($x-$y)==1}}

#-- This control structure is nested as seen above (instigated by Solving cryptarithms)

 proc try {atts values body} {
    foreach perm [permute $values] {
        uplevel 1 "assign {$atts} {$perm}; $body"
    }
 }

#-- assign {a b c} {1 2 3} == set a 1; set b 2; set c 3

 proc assign {atts values} {
    foreach att $atts value $values {
       uplevel 1 set $att $value
    }
    #uplevel 1 dump
 }

if 0 {This dumps all local variables of the caller that have integer value, sorted by that value (so that properties of houses come together):}

 proc dump {} {
    set res {}
    foreach v [lsort [uplevel 1 info locals]] {
        set val [uplevel 1 set $v]
        if {[string is integer -strict $val]} {
            lappend res [list $v $val]
        }
    }
    puts [lsort -index 1 $res]
 }

#-- Let's go, and see how long it takes:

 set t [lindex [time EinsteinPuzzle] 0]
 puts "[expr {$t/1000000.}] sec"

if 0 {This comes out (newlines added; you young guys with your fast boxes will probably beat my time :^)

 C:\_Ricci\sep>tclsh puzzle.tcl
 {Dunhill 1} {Norwegian 1} {cats 1} {water 1} {yellow 1}
 {Blends 2} {Dane 2} {blue 2} {horse 2} {tea 2}
 {Brit 3} {PallMall 3} {birds 3} {milk 3} {red 3}
 {German 4} {Prince 4} {coffee 4} {fish 4} {green 4}
 {Bluemasters 5} {Swede 5} {beer 5} {dog 5} {white 5}
 107.666357 sec

So my (or Tcl's) answer is "The German in house #4 owns the fish."


See also Brute force in velvet gloves


Arts and crafts of Tcl-Tk programming }