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:
- The Brit lives in the red house
- The Swede keeps dogs as pets
- The Dane drinks tea
- The green house is on the left of the white house
- The green house's owner drinks coffee
- The person who smokes Pall Mall rears birds
- The owner of the yellow house smokes Dunhill
- The man living in the centre house drinks milk
- The Norwegian lives in the first house
- The person who smokes Marlboro lives next to the one who keeps cats
- The person who keeps horses lives next to the person who smokes Dunhill
- The person who smokes Winfield drinks beer
- The German smokes Rothmans
- The Norwegian lives next to the blue house
- 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 is the problem size) of units.
Solving the riddle with my program involves two steps:
PREPAREwith the problem description
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:
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 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
Every condition in
condition-list has the following syntax:
(condition-name property1 value1 property2 value2) where each of
property2 is one of the property-names, 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))
Here's the function
SOLVE that is built by
(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
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
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!
DEFSTRUCTstatement which was kindly ignored by LispWorks.
COMPILE-FILEto a file that included the program code as well as the complete problem definition. I was measuring real time - as opposed to user CPU time or something like that - while a couple of other processes where running. (Off-topic: The results were slightly better with my previous installation - Linux 2.4.4 / SuSE 7.2. Oh well...)
BACK TO MY HOMEPAGE