Who owns the fish?

A Common Lisp solution to "Einstein's Riddle"

This is a Common Lisp solution to a notorious logical puzzle known as "Einstein's riddle." (I doubt that Einstein really had something do with it, but that's another story.) The problem is stated below:

There are five houses in five different colours starting from left to right. In each house lives a person of a different nationality. These owners all drink a certain type of beverage, smoke a certain brand of cigarette and keep a certain type of pet. No two owners have the same pet, smoke the same brand or drink the same beverage. The question is: WHO OWNS THE FISH??? Hints:
  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 centre house drinks milk
  9. The Norwegian lives in the first house
  10. The person who smokes Marlboro lives next to the one who keeps cats
  11. The person who keeps horses lives next to the person who smokes Dunhill
  12. The person who smokes Winfield drinks beer
  13. The German smokes Rothmans
  14. The Norwegian lives next to the blue house
  15. The person who smokes Marlboro has a neigbor who drinks water

I wrote an ANSI Common Lisp solution to this problem mainly because I wanted to experiment with macros. The program tries to be abstract enough to solve similar problems as well - like, e.g., the "Zebra Problem." I also tried to build a solution that is sufficiently fast and produces readable code.

For want of better words I'll use the following terminology while explaining my code: The problem is described by a couple of property descriptors which consist of a name for the property and a list of the possible values, optionally followed (just for the sake of grammatical beauty) by the plural form of the property's name. Examples would be (cigarette '(marlboro winfield rothmans pallmall dunhill)) or (mouse '(mickey minny) :plural-name mice). The problem size is the dimension of the solution space which is equal to the number of different properties. In the case of Einstein's riddle, the problem size is 5.

The abstract form of a person in Einstein's riddle with all of its associated properties (drink, cigarette, nationality, ...) will be called a unit and will be stored in a CL structure named after the riddle. Every possible solution is called a selection, it is a list (an ordered n-tuple where n is the problem size) of units.

Solving the riddle with my program involves two steps:

  1. initialize the data structures and prepare some macros by calling the macro PREPARE with the problem description
  2. call the function SOLVE

To explain the program I will use a problem that is simpler than Einstein's riddle: Our problem consists of three mice living next to each other in three holes in the wall. Each mouse has a favorite cheese flavor and a favorite TV show. Here are the hints:

  1. Mickey Mouse loves Gouda
  2. Mighty Mouse's favorite TV show is Emergency Room
  3. The mouse that lives in the left hole never misses an episode of Seinfeld
  4. Mickey Mouse and Mighty Mouse have one mouse hole between them
  5. The Simpsons fan does not live on the left of the Brie lover

This is enough information to start with:

  (prepare mouse-hole
	   ((mouse '(mickey minny mighty) :plural-name mice)
	    (cheese-flavor '(emmental gouda brie))
	    (tv-show '(seinfeld simpsons er)))
	   ((cond1 mouse 'mickey cheese-flavor 'gouda)
	    (cond2 mouse 'mighty tv-show 'er)
	    (cond3 :position 0 tv-show 'seinfeld)
	    (cond4 mouse 'mickey mouse 'mighty :distance 2)
            (cond5 tv-show 'simpsons cheese-flavor 'brie :distance 1 :directed t :negate t)))

The call syntax of PREPARE is (PREPARE riddle-name property-descriptor-list condition-list) where riddle-name will be used to name the structure that'll hold the units (see above). The second argument consists of a list of property descriptors which are detailed above. The property names will be become the names of the accessor functions for the structure RIDDLE-NAME.

Every condition in condition-list has the following syntax: (condition-name property1 value1 property2 value2) where each of property1 and property2 is one of the property-names, and value1 and value2 are possible values for these properties. Each property name can also be the keyword :POSITION in which case the associated value should be an integer ranging from zero to the problem size minus one. This feature is used to describe conditions like "The Norwegian lives in the first house." The position is zero-based.

The conditions in the condition list can also have one or more of three optional attributes: :DISTANCE, an integer, describes the distance between the units described by the two property/value pairs. :DIRECTED, if not NIL, means that positive and negative :DISTANCE values will be treated differently. In the default case only the absolute value is considered. :NEGATED, if not NIL, means that the reverse of the condition has to hold. The default values are (:DISTANCE 0 :DIRECTED NIL :NEGATED NIL).

We can now call the function SOLVE and get the following result:

  (#(MICKEY GOUDA SEINFELD) #(MINNY BRIE SIMPSONS) #(MIGHTY EMMENTAL ER)) 	    

Presto!

Here's the function SOLVE that is built by PREPARE,

  (DEFUN SOLVE ()
    (LET ((MOUSE-PERMUTATIONS
           (MAPCAR #'(LAMBDA (PERMUTATION) (MAKE-ARRAY 3 :INITIAL-CONTENTS PERMUTATION))
                   (PERMUTE '(MICKEY MINNY MIGHTY))))
          (CHEESE-FLAVOR-PERMUTATIONS
           (MAPCAR #'(LAMBDA (PERMUTATION) (MAKE-ARRAY 3 :INITIAL-CONTENTS PERMUTATION))
                   (PERMUTE '(EMMENTAL GOUDA BRIE))))
          (TV-SHOW-PERMUTATIONS
           (MAPCAR #'(LAMBDA (PERMUTATION) (MAKE-ARRAY 3 :INITIAL-CONTENTS PERMUTATION))
                   (PERMUTE '(SEINFELD SIMPSONS ER)))))
      (DOLIST (MICE MOUSE-PERMUTATIONS)
        (LET ((RESULT (POSSIBLE-P MICE)))
          (WHEN RESULT
            (DOLIST (CHEESE-FLAVORS CHEESE-FLAVOR-PERMUTATIONS)
              (LET ((RESULT (POSSIBLE-P MICE CHEESE-FLAVORS)))
                (WHEN RESULT
                  (DOLIST (TV-SHOWS TV-SHOW-PERMUTATIONS)
                    (LET ((RESULT (POSSIBLE-P MICE CHEESE-FLAVORS TV-SHOWS)))
                      (WHEN RESULT (PPRINT RESULT))))))))))
      (VALUES))))

which uses the predicate POSSIBLE-P that is built at the same time:

  (DEFUN POSSIBLE-P
         (&OPTIONAL (MICE *NOT-YET-DEFINED*)
                    (CHEESE-FLAVORS *NOT-YET-DEFINED*)
                    (TV-SHOWS *NOT-YET-DEFINED*))
    (DOTIMES (M 3)
      (SETF (MOUSE (SVREF *SELECTION* M)) (SVREF MICE M))
      (SETF (CHEESE-FLAVOR (SVREF *SELECTION* M)) (SVREF CHEESE-FLAVORS M))
      (SETF (TV-SHOW (SVREF *SELECTION* M)) (SVREF TV-SHOWS M)))
    (WHEN (AND (COND1 *SELECTION*)
               (COND2 *SELECTION*)
               (COND3 *SELECTION*)
               (COND4 *SELECTION*)
               (COND5 *SELECTION*))
      *SELECTION*))

(Note that it's MICE, not MOUSES, here although this doesn't alter the correctness of the function... :)

POSSIBLE-P checks whether all conditions hold for one particular selection and returns this selection if they hold, NIL otherwise. This function's main duty is to convert its input values (a permutation of the three mice, a permutation of the three cheese flavors, and a permutation of the three TV shows) into a simple-vector (the special variable *SELECTION*) of three MOUSE-HOLE structures that can be handed to the conditions in the logical AND at the end of the function.

A typical condition from our example, also built by PREPARE, is here:

  (DEFUN COND5 (SELECTION)
    (LET ((POSITION1 
	   (POSITION-IF #'(LAMBDA (UNIT)
				  (EQ (TV-SHOW UNIT) 'SIMPSONS))
			SELECTION))
          (POSITION2
	   (POSITION-IF #'(LAMBDA (UNIT)
				  (EQ (CHEESE-FLAVOR UNIT) 'BRIE))
			SELECTION)))
      (IF (OR (NULL POSITION1)
	      (NULL POSITION2))
	  T
	  (NOT (= 1 (- POSITION2 POSITION1))))))

Note that every condition has to return T if - during the backtracking algorithm - not all of its parameters are defined yet. Also note that SOLVE and POSSIBLE-P are different for each problem as they are built from the property descriptions and the conditions.

The problem definition for "Einstein's Riddle" is:

   (prepare einstein
	    ((nation '(british swedish norwegian german danish))
    	     (house '(red green yellow blue white))
	     (animal '(dog horse cat bird fish))
	     (cigarette '(marlboro winfield rothmans pallmall dunhill))
	     (drink '(tea coffee milk beer water)))
	    ((cond-position-first-norwegian :position 0 nation 'norwegian)
	     (cond-left-green-white house 'green house 'white :distance 1 :directed t)
	     (cond-british-red nation 'british house 'red)
	     (cond-neighbor-norwegian-blue nation 'norwegian house 'blue :distance 1)
	     (cond-swedish-dog nation 'swedish animal 'dog)
	     (cond-german-rothmans nation 'german cigarette 'rothmans)
	     (cond-yellow-dunhill house 'yellow cigarette 'dunhill)
	     (cond-green-coffee house 'green drink 'coffee)
	     (cond-danish-tea nation 'danish drink 'tea)
	     (cond-bird-pallmall animal 'bird cigarette 'pallmall)
	     (cond-neighbor-cat-marlboro animal 'cat cigarette 'marlboro :distance 1)
	     (cond-neighbor-horse-dunhill animal 'horse cigarette 'dunhill :distance 1)
	     (cond-winfield-beer cigarette 'winfield drink 'beer)
	     (cond-neighbor-marlboro-water cigarette 'marlboro drink 'water :distance 1)
	     (cond-position-middle-milk :position 2 drink 'milk)))

I got the following execution times for a compiled version of SOLVE on my machines:

That's not too shabby for a problem that has 24,883,200,000 possible solutions!


Notes:

$Header: /usr/local/cvsrep/weitz.de/einstein.html,v 1.10 2004/12/25 21:20:29 edi Exp $

BACK TO MY HOMEPAGE