Einstein's problem
Posted on December 24, 2009
by Tommy McGuire
Recently on the Haskell beginner's list, Patrick LeBoutillier posted a link to Einstein's problem, a logic puzzle attributed to Albert Einstein. Patrick requested comments on his solution, but because I had nothing better to do today other than watching the Star Wars films on Spike, I decided to come up with my own solution. (I did eventually look at his solution and at the excellent comments by Daniel Fischer, and the code I am presenting here includes changes based on those comments.)According to the linked article, the puzzle is based on the following facts:
- There are 5 houses (along the street) in 5 different colors: blue, green, red, white and yellow.
- In each house lives a person of a different nationality: Brit, Dane, German, Norwegian and Swede.
- These 5 owners
- drink a certain beverage: beer, coffee, milk, tea and water,
- smoke a certain brand of cigar: Blue Master, Dunhill, Pall Mall, Prince and blend, and
- keep a certain pet: cat, bird, dog, fish and horse.
- drink a certain beverage: beer, coffee, milk, tea and water,
- No owners have the same pet, smoke the same brand of cigar, or drink the same beverage.
It also include the following hints:
- The Brit lives in a red house.
- The Swede keeps dogs as pets.
- The Dane drinks tea.
- The green house is on the left of the white house (next to it).
- The green house owner drinks coffee.
- The person who smokes Pall Mall rears birds.
- The owner of the yellow house smokes Dunhill.
- The man living in the house right in the center drinks milk.
- The Norwegian lives in the first house.
- The man who smokes blend lives next to the one who keeps cats.
- The man who keeps horses lives next to the man who smokes Dunhill.
- The owner who smokes Blue Master drinks beer.
- The German smokes Prince.
- The Norwegian lives next to the blue house.
- The man who smokes blend has a neighbor who drinks water.
The question is: Who keeps fish?
My solution follows:
import Data.List
import Data.Maybe
data House = Blue | Green | Red | White | Yellow deriving (Eq, Show, Enum, Bounded)
data Nationality = Brit | Dane | German | Norwegian | Swede deriving (Eq, Show, Enum, Bounded)
data Beverage = Beer | Coffee | Milk | Tea | Water deriving (Eq, Show, Enum, Bounded)
data Cigar = BlueMaster | Dunhill | PallMall | Prince | Blend deriving (Eq, Show, Enum, Bounded)
data Pet = Cat | Bird | Dog | Fish | Horse deriving (Eq, Show, Enum, Bounded)
type Owner = (House, Nationality, Beverage, Cigar, Pet)
First, some preliminaries. I defined five types, each containing five values for each of the characteristics of the owners of the houses. Haskell is capable of automatically deriving instances of the typeclasses Eq, Show, Enum, and Bounded, automatically allowing the values of my types to be compared for equality, printed, and to act as enumerations (and bounded enumerations, which I will mention shortly). I also create a type to represent the characteristics of a given house.
My plan for finding the solution is significantly different from Patrick's; I decided naively to create a list of all possible combinations of the characteristics, filter out those that did not match the necessary hints, then create five-element permutations of the houses representing possible streets, and finally filter those streets to find the one satisfactory configuration. My goal was to make the simplest, clearest possible solution rather than the fastest.
Specifically, I did not want to encode any hint-specific details as structural elements of my code. What I wanted to do was to isolate things like "The Norwegian lives in the first house" to well-defined elements of the code rather than have them encoded as part of the system that generates the sequence of houses on the street.
To create the list of every possible Owner, I first needed lists of the possible values of each characteristic.
allValues :: (Enum a, Bounded a) => [a]
allValues = [ minBound .. maxBound ]
houses = allValues
nationalities = allValues
beverages = allValues
cigars = allValues
pets = allValues
This is where the Bounded typeclass comes in. allValues is a polymorphic list of all of the elements of a bounded enumeration; its actual value depends on the type that it has when it is evaluated. Since it is polymorphic (and the type declaration for it is necessary), I can use it multiple times with different types. As a result, the houses list is typed as [House], the nationalities list is typed as [Nationality], and the others likewise; each takes the list of values for the appropriate type. (I did not bother to provide type declarations for each because that would be a lot of work, and the types are fixed by the next value. Type inference is wonderful.)
possibilities :: [Owner]
possibilities = [ (house, nationality, beverage, cigar, pet)
| house <- houses,
nationality <- nationalities,
beverage <- beverages,
cigar <- cigars,
pet <- pets ]
The value of possibilities is a list of all possible combinations of each of the characteristics. It is defined by a list comprehension. house takes one value from houses, nationality from nationalities, and so on, and the result is the five-tuple creating an Owner. In fact, house takes on each value from houses in turn. As a result, possibilities has 3125 elements.
The next question is how to filter the possibilities. Several of the hints (1, 2, and 3 for example) relate to properties of a single household (or Owner). Take a look at hint 2 for instance. It says that the Swede's household contains the Dog; or alternatively, if a household contains the Swede then it contains the Dog and if a household contains the Dog, then it contains the Swede. If the household does not contain either the Swede or the Dog, then this hint provides no information. When filtering the possibilities, this hint disallows those households containing the Swede or the Dog, but not both. That is a standard logical connective, pronounced "if and only if", and written "iff" or "<->" (normal implication would be only half of <->, so it would be written "->"). So, what I need are base-level predicates indicating "this house has the Swede" and combinators like <->. This is how I did that:
type Predicate = Owner -> Bool
house color (c,_,_,_,_) = color == c
nationality nat (_,n,_,_,_) = nat == n
beverage bev (_,_,b,_,_) = bev == b
cigar cig (_,_,_,c,_) = cig == c
pet pt (_,_,_,_,p) = pt == p
(<->) :: Predicate -> Predicate -> Predicate
(<->) l r owner = ((not lo) || ro) && ((not ro) || lo)
where
lo = l owner
ro = r owner
A Predicate is a function which maps the five elements of an Owner (or household) to True, if the Owner matches the specific predicate, or False, if it does not. The following functions are used to define the base-level predicates: cigar accepts an argument, cig, which is one of the values of Cigar, and produces a Predicate (by virtue of Haskell's automatic currying). So, for example, "cigar Dunhill" results in a function which further takes an Owner and returns true if that Owner smokes Dunhill.
The <-> function takes two other predicates and uses them to compute a combined Predicate as in hint 6: (cigar PallMall) <-> (pet Bird), which indicates that any Owner which includes PallMall as a cigar should also include a Bird as a pet. <-> is defined using the two individual implications, adjusted by a standard transformation to use only negation and disjunction which are available in Haskell as standard operations. The only real complication of <-> is the additional Owner argument it takes and which it supplies to the lower-level Predicates.
How are these Predicates used? Here are the first group of hints:
hint1 = (house Red) <-> (nationality Brit)
hint2 = (nationality Swede) <-> (pet Dog)
hint3 = (nationality Dane) <-> (beverage Tea)
hint5 = (house Green) <-> (beverage Coffee)
hint6 = (cigar PallMall) <-> (pet Bird)
hint7 = (house Yellow) <-> (cigar Dunhill)
hintC = (beverage Beer) <-> (cigar BlueMaster)
hintD = (nationality German) <-> (cigar Prince)
(I broke into hexadecimal for hints greater than 9 so everything would line up.)
To make use of the hints to filter the possibilities, I created another Predicate that allows me to conjoin the hint predicates into a single test to be applied to the possibilities. (Actually, I created two; I'll use the second, disjunction, later.) These are basically the normal logical and (&&) and or (||) lifted to work as Predicates instead of simple boolean operations.
(/\),(\/) :: Predicate -> Predicate -> Predicate
(/\) l r o = (l o) && (r o)
(\/) l r o = (l o) || (r o)
possibilities' = filter (hint1 /\ hint2 /\ hint3 /\ hint5 /\ hint6 /\ hint7 /\ hintC /\ hintD) possibilities
If you are curious, /\ is "and" and \/ is "or" in the first logical notation I learned.)
These hints filter possibilities significantly; possibilities has 3125 elements and possibilities' has only 78. However, the remaining hints relate Owners together with their positions on a Street, which is another kettle of fish.
type Street = [Owner]
Since I know there are five houses on the street, a Street will be a five-element list. I could have used a better representation for this, one that would explicitly show the number of households, but I figured that would be an unnecessary complication that would better be left implicit.
For the moment, I intend to ignore how I get the Streets. Instead, I first focused on further, higher-level predicates that operate on Streets. To make these predicates simpler, I chose to represent a StreetPredicate as a function from a Street to a "Maybe Street"; this is a standard Haskell type containing either Just a Street, or Nothing. The first case indicates that the Street satisfies the predicate (which returns the Street instead of True) and the second case indicates the Street does not satisfy the predicate (which returns a special value Nothing).
type StreetPredicate = Street -> Maybe Street
My first StreetPredicate is from hint 4, which indicates that one household is immediately left of another.
leftOf :: Predicate -> Predicate -> StreetPredicate
leftOf o1 o2 st = do i <- (findIndex o1 st)
h <- if i < 4 then Just $ st !! (i+1) else Nothing
if o2 h then Just st else Nothing
Per the type declaration, this function takes two house-based Predicates and produces a StreetPredicate; it does so by finding the first Owner on the Street who satisfies the first Predicate, checks that it is possible to have a house to its right, and then checks that the Owner to the right satisfies the second Predicate. This function takes the form of a Haskell monadic operation, specifically the Maybe monad, which takes three steps in this function. If either of the first two returns Nothing, the overall function returns Nothing without evaluating the remainder. Assuming execution gets to the final if step, it directly produces either Just the Street st, or Nothing. (Behold the wonder of monads in Haskell!)
Another similar StreetPredicate checks whether two Owners on a Street identified by Predicates are next-door neighbors.
nextTo :: Predicate -> Predicate -> StreetPredicate
nextTo o p st = do i <- (findIndex o st)
j <- (findIndex p st)
if abs (i-j) == 1 then Just st else Nothing
Finally, I created a couple of StreetPredicates to definitively locate households by address. In this case, 0 is the address of the first house on the Street and 2 is the center house on the Street.
address :: Int -> Predicate -> StreetPredicate
address i p st = if p $ st !! i then Just st else Nothing
center = address 2
first = address 0
The remaining hints can be written as:
hint4 = (house Green) `leftOf` (house White)
hint8 = center $ beverage Milk
hint9 = first $ nationality Norwegian
hintA = (cigar Blend) `nextTo` (pet Cat)
hintB = (pet Horse) `nextTo` (cigar Dunhill)
hintE = (nationality Norwegian) `nextTo` (house Blue)
hintF = (cigar Blend) `nextTo` (beverage Water)
As above, I need a way to combine the individual hint StreetPredicates. That is the job of the /^\ operator, which is roughly equivalent to conjunction. (Think of it as a larger version of /\ with the top smushed down.)
(/^\) :: StreetPredicate -> StreetPredicate -> StreetPredicate
(/^\) l r s = do { ls <- l s; rs <- r s; return s }
This function is defined using the Maybe monad; it returns Just the Street s as long as both the two prior steps do not return Nothing.
Now I have gotten to the hairy part. I have a list of 78 possibly satisfactory households, and I wish to filter all possible permutations of five of those households to find the one Street which meets all of the requirements. Creating permutations is relatively simple in Haskell, but as it turns out there are over 2 million such permutations. That is far too many to handle. Continuing my tradition of being only as smart as necessary, I have to get a little smarter when creating my Street permutations (but only a little).
outOf :: Int -> [Owner] -> [Street]
outOf 0 _ = [[]]
outOf n xs = [ x:xs' | x <- xs, xs' <- (n-1) `outOf` (delete x xs) ]
where
delete (h,n,b,c,p) = filter (not . (house h \/ nationality n \/ beverage b \/ cigar c \/ pet p))
Think of outOf as being used infix, as in "2 `outOf` [1,2,3]", which produces all possible two element permutations from the three element list.
Using the normal definition of delete, this function would produce all 2 million-plus five element permutations ("delete x xs" returns a list of the elements of the list xs that are not equal to x). My minimal smartness is to notice that this is a list of Owners, and that only one Owner on the street can drink Coffee, for example. So, instead of merely removing those elements equal to x, I remove all of them which match it in any characteristic, using the \/ operator I created earlier, the basic Predicates, and a logical negation. ("delete" would normally be something like "delete x xs = filter (\y -> not (x == y)) xs".) The length of "5 `outOf` possibilities'" is only 54720 elements, which is enough of an improvement. I would argue that this is the one place where I have some part of the details of the problem hidden in the structure of my code, but boy do I need this one.
The final results are:
results = mapMaybe (hint4 /^\ hint8 /^\ hint9 /^\ hintA /^\ hintB /^\ hintE /^\ hintF) $ 5 `outOf` possibilities'
This uses mapMaybe, which is somewhat similar to filter except in using Maybes rather that Bools. results finally evaluates to a list containing a single Street, describing the single configuration which satisfies all of the hints.
Conclusions?
First I would like to note that hintF (number 15) is not necessary. The problem is actually over-determined; eliminating hint 15 still results in only one result. None of the other StreetPredicate hints can be removed; I did not check the Predicate hints.
Performance-wise, it is not actually horrible. Subsequent to the mailing list suggestions to Patrick's original solution, his code is somewhere between 5% (interpreted using runhaskell) and a third (compiled) faster than mine. Now, I do not make any claims that mine is particularly idiomatic Haskell, nor that it is in any way fast. However, it seems perfectly acceptable.
My last blog post was about Whitehead's comments on notation. Haskell in this instance has provided some incredible tools for notation. Specifically, I like the ability to define the hints clearly and independently and the ability to operate with multiple levels of logical predicates. In effect, what I have done with my <->, /\, \/, /^\, and so on, is to define a simplified domain-specific language for solving this specific problem.
I could think of implementing the same approach using Java, but the result would be much more verbose if possibly equally satisfactory. As I was discussing with a coworker recently, functional programming (closures in that instance, currying and combinators in this) do not necessarily provide features that cannot be lived without, but having them is much preferable to not having them.
I recently listened to a Software Engineering Radio podcast on the difference between Computer Science and Software Engineering. I will have more to write on that topic at some point soon, but I would like to point out that my solution to this problem (toy that it is) is pure Computer Science with a big C and big S. From Haskell, typeclasses, my idiotic filtering approach, to predicate calculus with custom domain specific predicates, nothing I have done in solving this problem has doodley squat to do with software engineering. Or, from the other side, nothing in my 100-ish lines of code would be apparent to a software engineer who was not interested in ivory-tower, high-falootin', theorem proving Computer Science. And that is bad. What I have done by deliberately avoiding encoding parts of the problem as structural elements in the code, by going out of my way to create as generic a domain specific language as I could, by using a collection of tools straight out of pure Computer Science, is better engineering than anything I would have come up with by going straight at the problem.
In fact, the major criticism I keep hearing in the back of my head about this code is that it is too advanced, too CS-y, too hard for a typical developer to support, understand, and maintain going forward. On the one hand, that criticism is something I understand, something I have to live with, since it is true. The typical developer I have worked with over the last 20-ish years is not going to want to deal with this kind of code. On the other hand, as a professional programmer myself, I find that criticism (and the daily situation) deeply offensive.
