Who Owns The Zebra?
June 16, 2009
This famous puzzle was first published by Life magazine on December 17, 1962. It has been variously attributed to both Albert Einstein and Lewis Carroll, but the true author is not known. There are several versions; this is the original from Life:
1 There are five houses.
2 The Englishman lives in the red house.
3 The Spaniard owns the dog.
4 Coffee is drunk in the green house.
5 The Ukrainian drinks tea.
6 The green house is immediately to the right of the ivory house.
7 The Old Gold smoker owns snails.
8 Kools are smoked in the yellow house.
9 Milk is drunk in the middle house.
10 The Norwegian lives in the first house.
11 The man who smokes Chesterfields lives in the house next to the man with the fox.
12 Kools are smoked in the house next to the house where the horse is kept.
13 The Lucky Strike smoker drinks orange juice.
14 The Japanese smokes Parliaments.
15 The Norwegian lives next to the blue house.
In the interest of clarity, it must be added that each of the five houses is painted a different color, and their inhabitants are of different national extractions, own different pets, drink different beverages and smoke different brands of American cigarettes.
Your task is to write a program to solve the puzzle and determine: Who drinks water? Who owns the zebra? When you are finished, you are welcome to read or run a suggested solution, or to post your own solution or discuss the exercise in the comments below.
Programming Praxis 
There’s a slight error in your code: you have the ivory house to the right of the green house instead of the other way round. Flipping the constraint for number 6 around should fix it.
[…] Praxis – Who Owns The Zebra? By Remco Niemeijer In Today’s Programming Praxis problem we have to solve a logic puzzle. The provided solution uses a 182-line […]
My Haskell solution (see http://bonsaicode.wordpress.com/2009/06/16/programming-praxis-who-owns-the-zebra/ for a version with comments):
import Data.List
import qualified Data.Map as M
type Grid = M.Map String (M.Map Int [String])
data Constraint = Link (String, String) (String, String)
| PosLink (String, String) Int
| NextTo (String, String) (String, String)
| RightOf (String, String) (String, String)
deriving Eq
type Solver = ([Constraint], Grid)
addConstraint :: Constraint -> Solver -> Solver
addConstraint c (cs, g) = (c : cs, g)
removeIf :: (String, String) -> (String, String) ->
[String -> String -> Int -> Grid -> Bool] -> Grid -> Grid
removeIf (f1, v1) (f2, v2) cs g = M.adjust (M.mapWithKey (\k ->
if and [c f1 v1 k g | c <- cs] then delete v2 else id)) f2 g notAt :: (Int -> Int) -> String -> String -> Int -> Grid -> Bool
notAt f f1 v1 i g = M.notMember (f i) (g M.! f1) ||
notElem v1 (g M.! f1 M.! (f i))
runConstraint :: Constraint -> Grid -> Grid
runConstraint (Link a b) = removeIf a b conds . removeIf b a conds
where conds = [(\f1 v1 k -> notElem v1 . (M.! k) . (M.! f1))]
runConstraint (PosLink (f1,v1) i) =
M.adjust (M.update (const $ Just [v1]) i) f1
runConstraint (NextTo a b) = removeIf a b [notAt pred, notAt succ]
runConstraint (RightOf a b) = removeIf a b [notAt pred] .
removeIf b a [notAt succ]
adjustOthers :: Eq k => (v -> v) -> k -> M.Map k v -> M.Map k v
adjustOthers f k = M.mapWithKey (\k’ v -> if k’ == k then v else f v)
simplify :: Grid -> Grid
simplify g = foldr ($) (M.mapWithKey (\_ v ->
M.mapWithKey (\i x -> let d = x \\ concat (M.elems $ M.delete i v)
in if length d == 1 then d else x) v) g)
[ M.adjust (adjustOthers (\\ take 1 x) i) f
| (f, v) <- M.assocs g, (i, x) <- M.assocs v, length x == 1] run :: Solver -> Solver
run (cs, g) = (cs, simplify $ foldr runConstraint g cs)
apply :: Solver -> Solver
apply = head . head . dropWhile (null . tail) . group . iterate run
solved :: M.Map k (M.Map k’ [v]) -> Bool
solved g = and [False | (_, v) <- M.assocs g, (_, xs) <- M.assocs v, length xs /= 1] solve :: Solver -> [String]
solve s = map (unwords . map head) . transpose . map (M.elems) .
M.elems $ head [ r | let (cs, g) = apply s,
(f, v) <- M.assocs $ g, (i, xs) <- M.assocs v, x <- xs, let (_, r) = apply (cs, M.adjust (M.adjust (const [x]) i) f g), solved r ] grid :: Grid grid = M.fromList . zip (words "owner brand drink pet color") $ map (M.fromList . zip [1..] . replicate 5) [words "Englishman Ukranian Norwegian Japanese Spaniard", words "Old_Gold Kools Chesterfields Lucky_Strike Parliaments", words "Coffee Tea Milk Orange_Juice Water", words "Dog Snails Horse Fox Zebra", words "Red Green Ivory Yellow Blue"] problem :: Solver problem = foldr addConstraint ([], grid) [Link ("owner", "Englishman") ("color", "Red"), Link ("owner", "Spaniard") ("pet", "Dog"), Link ("drink", "Coffee") ("color", "Green"), Link ("owner", "Ukranian") ("drink", "Tea"), RightOf ("color", "Ivory") ("color", "Green"), Link ("brand", "Old_Gold") ("pet", "Snails"), Link ("brand", "Kools") ("color", "Yellow"), PosLink ("drink", "Milk") 3, PosLink ("owner", "Norwegian") 1, NextTo ("brand", "Chesterfields") ("pet", "Fox"), NextTo ("brand", "Kools") ("pet", "Horse"), Link ("brand", "Lucky_Strike") ("drink", "Orange_Juice"), Link ("owner", "Japanese") ("brand", "Parliaments"), NextTo ("owner", "Norwegian") ("color", "Blue")] main :: IO () main = mapM_ putStrLn $ solve problem [/sourcecode]
A more elegant solution (see http://bonsaicode.wordpress.com/2009/06/22/who-owns-the-zebra-reloaded/ for more detail):
import Data.List
indexOf :: (Eq a) => [a] -> a -> Int
indexOf xs x = head $ elemIndices x xs
nextTo :: Int -> Int -> Bool
nextTo a b = abs (a – b) == 1
rightOf :: Int -> Int -> Bool
rightOf a b = a == b + 1
options :: String -> [[String]]
options = permutations . words
solution :: [[String]]
solution = head [transpose [cs, os, ds, ss, ps] |
cs <- options "red green ivory yellow blue", let color = indexOf cs, color "green" `rightOf` color "ivory", os <- options "english spaniard ukranian norwegian japanese", let owner = indexOf os, owner "norwegian" == 0, owner "english" == color "red", owner "norwegian" `nextTo` color "blue", ds <- options "coffee tea milk juice water", let drinks = indexOf ds, drinks "milk" == 2, drinks "coffee" == color "green", owner "ukranian" == drinks "tea", ss <- options "old_gold kools chesterfields parliaments lucky_strike", let smokes = indexOf ss, smokes "kools" == color "yellow", smokes "lucky_strike" == drinks "juice", owner "japanese" == smokes "parliaments", ps <- options "dog snails fox horse zebra", let pet = indexOf ps, owner "spaniard" == pet "dog", smokes "old_gold" == pet "snails", smokes "chesterfields" `nextTo` pet "fox", smokes "kools" `nextTo` pet "horse"] main :: IO () main = mapM_ print solution [/sourcecode]
One I did in Python 3.0.1, using the stadard library’s itertools module for the permutations:
Here’s the pastebin:
http://pastebin.com/f41c6cbf8