if 0 {[Richard Suchenwirth] 2005-03-19 - Albert Einstein is said to have presented this puzzle (read http://www.mindspring.com/~mccarthys/puzzle1.htm for details): 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. Give 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], [LarsH]'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: 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] } 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." ---- [Arts and crafts of Tcl-Tk programming] }