## 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.

Pages: 1 2

### 7 Responses to “Multiple Dwellings”

1. Pied said

In an appartment house?

P!

2. FalconNL said

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
```
3. [...] 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? [...]

4. Eric Pierce said

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)]
```
5. kawas said

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])
```
6. j0sejuan said

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)
}
}
}