if 0 {Richard Suchenwirth 2005-03-19 - Albert Einstein is said to have presented this puzzle (read [L1 ] for details, or just google for "Einstein puzzle" or "Einstein riddle"):
There are 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:
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 } } } } } }
#-- This custom control structure was 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} }
#-- 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}}
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 var [lsort [uplevel 1 info locals]] { set val [uplevel 1 set $v] if {[string is integer -strict $val]} { lappend res [list $var $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."
A Forth solution is at http://www.albany.net/~hello/Einstein.htm - Common Lisp at http://www.weitz.de/einstein.html - Logo at http://mail.python.org/pipermail/python-list/2001-March/033043.html - and more somewhere out there on the Web...
See also Brute force with velvet gloves