Multiple Dwellings
February 20, 2009
Cooper doesn’t live on the bottom floor; he also doesn’t live on the top floor, because Miller lives above him. Therefore, Cooper must live on floors two through four, as does Fletcher, and since they don’t live on adjacent floors, one of them must live on the second floor and the other on the fourth floor. Assume for the moment that Fletcher lives on the second floor. Then Smith must live on the top floor, since the second and fourth floors are already occupied and he can’t live on the first or third floors adjacent to Fletcher. But then there is no place for Miller to live, since Cooper is on the fourth floor and Miller must be above him. Thus, the assumption that Fletcher lives on the second floor is impossible, so Fletcher lives on the fourth floor and Cooper lives on the second floor. Smith must live on the first floor, since he doesn’t live adjacent to Fletcher on the third or fifth floors, and the second floor is already occupied. Baker must live on the third floor, since he doesn’t live on the top floor. And Miller lives on the top floor, since it is the only place left, and it is above Cooper on the fourth floor.
This problem is easily solved with John McCarthy’s amb operator, which takes zero or more expressions and non-deterministically returns the value of one of them if it will lead to the success of the overall expression. Amb is an angelic operator, because it always knows the right answer. It works by backtracking, but the client program never sees the backtracking; from the point of view of the client program, it is as if amb mysteriously knows the right answer. Here is an implementation of amb:
(define (fail)
(error 'amb "tree exhausted"))
(define-syntax amb
(syntax-rules ()
((amb) (fail))
((amb expr) expr)
((amb expr ...)
(let ((prev-fail fail))
((call-with-current-continuation
(lambda (success)
(call-with-current-continuation
(lambda (failure)
(set! fail failure)
(success (lambda () expr))))
...
(set! fail prev-fail)
prev-fail)))))))
(define (require condition)
(if (not condition) (amb)))
Given amb, the puzzle is easy to solve. We arrange five variables, one for each dweller, require that the five variables have distinct values, and require each of the conditions given in the puzzle statement.
(define (distinct? xs)
(cond ((null? xs) #t)
((member (car xs) (cdr xs)) #f)
(else (distinct? (cdr xs)))))
(define (multiple-dwelling)
(let ((baker (amb 1 2 3 4 5))
(cooper (amb 1 2 3 4 5))
(fletcher (amb 1 2 3 4 5))
(miller (amb 1 2 3 4 5))
(smith (amb 1 2 3 4 5)))
(require (distinct? (list baker cooper fletcher miller smith)))
(require (not (= baker 5)))
(require (not (= cooper 1)))
(require (not (= fletcher 5)))
(require (not (= fletcher 1)))
(require (> miller cooper))
(require (not (= (abs (- smith fletcher)) 1)))
(require (not (= (abs (- fletcher cooper)) 1)))
(list (list 'baker baker)
(list 'cooper cooper)
(list 'fletcher fletcher)
(list 'miller miller)
(list 'smith smith))))
The solution can be seen at http://programmingpraxis.codepad.org/8XublsDo.
> (multiple-dwelling)
((baker 3) (cooper 2) (fletcher 4) (miller 5) (smith 1))
Any constraint puzzle can be formulated in this way, using amb; for instance, amb provides an easy solution for sudoku puzzles. McCarthy’s original article (from 1961!) describing amb is at http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.55.8479. Abelson and Sussman give an excellent description at http://mitpress.mit.edu/sicp/full-text/book/book-Z-H-28.html#%_sec_4.3.
Programming Praxis 
In an appartment house?
P!
Haskell (assuming 0 = bottom floor):
import Data.Map (fromList, (!))
import Data.List
data Person = Baker | Cooper | Fletcher | Miller | Smith deriving (Enum, Eq, Ord, Show)
main = print . filter conditions . map (fromList . flip zip [0 :: Int ..]) $ permutations [Baker ..]
conditions xs | xs ! Baker == 4 = False
| xs ! Cooper == 0 = False
| xs ! Fletcher == 0 = False
| xs ! Fletcher == 4 = False
| xs ! Miller < xs ! Cooper = False | abs (xs ! Smith - xs ! Fletcher) == 1 = False | abs (xs ! Cooper - xs ! Fletcher) == 1 = False | otherwise = True [/sourcecode]
[…] Multiple Dwellings Baker, Cooper, Fletcher, Miller and Smith live on different floors of an apartment house that contains only five floors. Baker does not live on the top floor. Cooper does not live on the bottom floor. Fletcher does not live on either the top or the bottom floor. Miller lives on a higher floor than does Cooper. Smith does not live on a floor adjacent to Fletcher’s. Fletcher does not live on a floor adjacent to Cooper’s. Where does everyone live? […]
After some false starts, I came up with Haskell solution that isn’t half bad. Here’s mine:
import Data.List import Data.Map (fromList, toList, (!)) people = ["Baker", "Cooper", "Fletcher", "Miller", "Smith"] assignments = [ fromList (zip people floors) | floors <- permutations [0,1,2,3,4] ] -- Return True if the given floor assignments obey the constraints constrain assign = let b = assign ! "Baker" c = assign ! "Cooper" f = assign ! "Fletcher" m = assign ! "Miller" s = assign ! "Smith" in b /= 4 -- Baker is not on top floor && c /= 0 -- Cooper is not on bottom floor && f `notElem` [0, 4] -- Fletcher is not on top or bottom floor && m > c -- Miller is above Cooper && s `notElem` [f-1, f+1] -- Smith is not adjacent to Fletcher && f `notElem` [c-1, c+1] -- Fletcher is not adjacent to Cooper -- Return all floor assignments that fit the constraints solutions = head $ filter constrain assignments main = putStrLn $ show $ toList solutions -- [("Baker",2),("Cooper",1),("Fletcher",3),("Miller",4),("Smith",0)]Clojure code using only a list comprehension for this particular problem.
nb: in my country floors start at zero
;; list comprehension with all constraints in the :when clause (for [b (range 5) c (range 5) f (range 5) m (range 5) s (range 5) :let [sf (- s f) fc (- f c)] :when (and (= 5 (count (distinct [b c f m s]))) (not= b 4) (not= c 0) (< 0 f 4) (> m c) (not= 1 (* sf sf)) (not= 1 (* fc fc)))] [:Baker b :Cooper c :Fletcher f :Miller m :Smith s]) ;; result: ([:Baker 2 :Cooper 1 :Fletcher 3 :Miller 4 :Smith 0])package main import "fmt" func pass(b, c, f, m, s int) bool { return b < 5 && c > 1 && f > 1 && f < 5 && m > c && f-s != 1 && f-s != -1 && f-c != 1 && f-c != -1 && b != c && b != f && b != m && b != s && c != f && c != m && c != s && f != m && f != s && m != s && b >= 1 && c >= 1 && f >= 1 && m >= 1 && s >= 1 && b <= 5 && c <= 5 && f <= 5 && m <= 5 && s <= 5 } func main() { for l := 0; l < 55555; l++ { if pass(l%10,l/10%10,l/100%10,l/1000%10,l/10000%10) { fmt.Printf("lives %d\n", l) } } }https://github.com/ftt/programming-praxis/blob/master/20090220-multiple-dwellings/multiple-dwellings.py
Great problem! I used to do these logic puzzles as a kid by marking off squares on a grid. Here’s my solution in Scala:
def conditions(combo: Seq[String]) = { def floor(person: String) = combo.indexOf(person) def adjacent(person1: String, person2: String) = math.abs(floor(person1) - floor(person2)) == 1 floor("Baker") != 4 && floor("Cooper") != 0 && floor("Fletcher") != 0 && floor("Fletcher") != 4 && floor("Miller") > floor("Cooper") && !adjacent("Smith", "Fletcher") && !adjacent("Cooper", "Fletcher") } val people = Seq("Baker", "Cooper", "Fletcher", "Miller", "Smith") val result = people.permutations filter conditions result foreach printlnAnswer:
1.Miller
2.Fletcher
3.Baker
4.Cooper
5.Smith
Here,1. represents Top floor and so on.