# sicp-ex-4.41

xdavidliu

Simple and very efficient solution that treats (list fletcher smith cooper miller baker) as a big-endian base-5 number (with possible digits 1-5 instead of 0-4), which we then iterate through in order.

``` (define (nearby? j k)
(>= 1 (abs (- j k))))

(define (ordinary-multiple-dwelling)
(define (display-solution f s c m b)
(display
(list (list 'baker b) (list 'cooper c)
(list 'fletcher f) (list 'miller m)
(list 'smith s)))
(newline))
(define (iter-f f)
(cond ((= f 1) (iter-f 2))
((= f 5) 'done)
(else (iter-s f 1))))
(define (iter-s f s)
(cond ((> s 5) (iter-f (1+ f)))
((nearby? f s) (iter-s f (1+ s)))  ;; see additional note
(else (iter-c f s 1))))
(define (iter-c f s c)
(cond ((> c 5) (iter-s f (1+ s)))
((or (nearby? f c) (= c 1) (= c s))
(iter-c f s (1+ c)))
(else (iter-m f s c 1))))
(define (iter-m f s c m)
(cond ((> m 5) (iter-c f s (1+ c)))
((or (<= m c) (= m s) (= m f))
(iter-m f s c (1+ m)))
(else (iter-b f s c m 1))))
(define (iter-b f s c m b)
(cond ((> b 5) (iter-m f s c (1+ m)))
(else (if (not (or (= b 5) (= b m) (= b c) (= b s) (= b f)))
(display-solution f s c m b))
(iter-b f s c m (1+ b)))))
(iter-f 1))

(ordinary-multiple-dwelling)
;; ((baker 3) (cooper 2) (fletcher 4) (miller 5) (smith 1))
;Value: done
```

Additional note: if we change the predicate (nearby? f s) to (= f s) and re-run this procedure, we obtain the extra solutions from exercise 4.38:

``` (ordinary-multiple-dwelling)
;; ((baker 3) (cooper 4) (fletcher 2) (miller 5) (smith 1))
;; ((baker 1) (cooper 4) (fletcher 2) (miller 5) (smith 3))
;; ((baker 3) (cooper 2) (fletcher 4) (miller 5) (smith 1))
;; ((baker 1) (cooper 2) (fletcher 4) (miller 5) (smith 3))
;; ((baker 1) (cooper 2) (fletcher 4) (miller 3) (smith 5))
;; ;Value: done
```

meteorgan

```

(define (flatmap proc li)
(if (null? li)
'()
(let ((result (proc (car li)))
(rest (flatmap proc (cdr li))))
(if (pair? result)
(append result rest)
(cons result rest)))))

(define (permutations lists)
(if (null? lists)
'(())
(flatmap (lambda (x)
(map (lambda (y) (cons x y))
(permutations (cdr lists))))
(car lists))))

(define (restrictions l)
(apply
(lambda (baker cooper fletcher miller smith)
(and (> miller cooper)
(not (= (abs (- smith fletcher)) 1))
(not (= (abs (- fletcher cooper)) 1))
(distinct? (list baker cooper fletcher miller smith))))
l))

(define (mutiple-dwelling)
(let ((baker '(1 2 3 4))
(cooper '(2 3 4 5))
(fletcher '(2 3 4))
(miller '(3 4 5))
(smith '(1 2 3 4 5)))
(filter restrictions (permutations (list baker cooper fletcher miller smith)))))
```

Felix021

another solution, closer to the original amb program.

```

(define (multiple-dwelling)
(define (flat-map proc lst)
(if (null? lst)
'()
(let ((first (proc (car lst))))
((if (pair? first) append cons)
first
(flat-map proc (cdr lst))))))

(define (permutations lst)
(if (null? lst)
(list '())
(flat-map
(lambda (first)
(map
(lambda (rest) (cons first rest))
(permutations (filter (lambda (x) (not (= x first))) lst))))
lst)))
(for-each
(lambda (try)
(apply
(lambda (baker cooper fletcher miller smith)
(if (and (!= baker 5)
(!= cooper 1)
(!= fletcher 1)
(!= fletcher 5)
(> miller cooper)
(!= (abs (- smith fletcher)) 1)
(!= (abs (- fletcher cooper)) 1))
(display (list baker cooper fletcher miller smith))))
try))
(permutations '(1 2 3 4 5))))

(multiple-dwelling)
```

Shaw

An ugly solution.

```

(define (flatmap f lst)
(if (null? lst)
null
(let ((result (f (car lst)))
(rest (flatmap f (cdr lst))))
(if (or (pair? result) (null? result))
(append result rest)
(cons result rest)))))

(define (distinct? l)
(define (member? a lst)
(cond ((null? lst) #f)
((eq? (car lst) a) #t)
(else (member? a (cdr lst)))))
(cond
((null? l) #t)
((member? (car l) (cdr l)) #f)
(else (distinct? (cdr l)))))

(define (solve)
(flatmap
(lambda (cooper)
(flatmap
(lambda (baker)
(flatmap
(lambda (fletcher)
(if (= (abs (- cooper fletcher)) 1)
null
(flatmap
(lambda (miller)
(if (not (> miller cooper))
null
(flatmap
(lambda (smith)
(if (and (not (= (abs (- smith fletcher)) 1))
(distinct? (list
cooper baker fletcher miller smith)))
(list (list 'cooper cooper)
(list 'baker baker)
(list 'fletcher fletcher)
(list 'miller miller)
(list 'smith smith))
null))
'(1 2 3 4 5))))
'(3 4 5))))
'(2 3 4)))
'(1 2 3 4)))
'(2 3 4 5)))

;;((cooper 2) (baker 3) (fletcher 4) (miller 5) (smith 1))
```

Shaw

Another ugly solution.

```

(define (solve)
(let ((result '()))
(map
(lambda (cooper)
(map
(lambda (baker)
(map
(lambda (fletcher)
(if (= (abs (- cooper fletcher)) 1)
null
(map
(lambda (miller)
(if (not (> miller cooper))
null
(map
(lambda (smith)
(if (and (not (= (abs (- smith fletcher)) 1))
(distinct? (list
cooper baker fletcher miller smith)))
(set! result
(cons
(list (list 'cooper cooper)
(list 'baker baker)
(list 'fletcher fletcher)
(list 'miller miller)
(list 'smith smith))
result))
null))
'(1 2 3 4 5))))
'(3 4 5))))
'(2 3 4)))
'(1 2 3 4)))
'(2 3 4 5))
(display result)))

;;(((cooper 2) (baker 3) (fletcher 4) (miller 5) (smith 1)))
```

Donald

```
(define (multiple-dwelling)
(let ((result '()))
(define (iter-b b)
(define (iter-c c)
(define (iter-m m)
(define (iter-f f)
(define (iter-s s)
(cond ((or (= s b) (= s c) (= s m) (= s f) (= (abs (- s f)) 1))
(iter-s (+ s 1)))
((> s 5)
(iter-f (+ f 1)))
(else (set! result
(cons (list (list 'baker b)
(list 'cooper c)
(list 'miller m)
(list 'fletcher f)
(list 'smith s))
result))
(iter-s (+ s 1)))))
(cond ((or (= f b) (= f c) (= f m) (= (abs (- f c)) 1))
(iter-f (+ f 1)))
((> f 4)
(iter-m (+ m 1)))
(else (iter-s 1))))
(cond ((or (= m b) (<= m c))
(iter-m (+ m 1)))
((> m 5)
(iter-c (+ c 1)))
(else (iter-f 2))))
(cond ((= c b)
(iter-c (+ c 1)))
((> c 5)
(iter-b (+ b 1)))
(else (iter-m 3))))
(cond ((> b 4)
result)
(else (iter-c 2))))
(iter-b 1)))

;;(((baker 3) (cooper 2) (miller 5) (fletcher 4) (smith 1)
```

stepvhen

Instead of generating permutations, we can consider the separate dwellings as a 5 digit base-5 number, and with each pass we increment that number.

```
(define (multiple-dwellings)
(define (house-iter b c m f s)
(cond ((> b 4) ; Baker can't live on 5th floor.
((> c 5)
(house-iter (+ b 1) 2 3 2 1))
((> m 5)
(house-iter b (+ c 1) (+ c 2) 2 1)) ; miller is above cooper
((> f 4) ; fletcher can't live on 5th floor
(house-iter b c (+ m 1) 2 1))
((> s 5)
(house-iter b c m (+ f 1) 1))
((and (not (= (abs (- s f)) 1))
(not (= (abs (- c f)) 1))
(distinct? (list b c m f s)))
(list (list 'baker b) (list 'cooper c)
(list 'fletcher f) (list 'miller m)
(list 'smith s)))
(else
(house-iter b c m f (+ s 1)))))
(house-iter 1 2 3 2 1)) ; initial values take some restrictions into account
```

timothy235

Racket has great list comprehensions.

```
(define (solution? baker cooper fletcher miller smith)
(and ; (distinct? (list baker cooper fletcher miller smith))
(not (= baker 5))
(not (= cooper 1))
(not (= fletcher 5))
(not (= fletcher 1))
(> miller cooper)
(not (= (abs (- smith fletcher)) 1))
(not (= (abs (- fletcher cooper)) 1))))

(define (show-solutions)
(for/list ([tenants (in-permutations (range 1 6))]
#:when (apply solution? tenants))
(map list
'(baker cooper fletcher miller smith)
tenants)))

(show-solutions)
;; '(((baker 3) (cooper 2) (fletcher 4) (miller 5) (smith 1)))
```