Exercise 4.41.  Write an ordinary Scheme program to solve the multiple 
dwelling puzzle.

————————————————————————————————————————————————————————————————————————

To replace amb we write a procedure which takes a list of values and a 
procedure, and tries the procedure on the values until one succeeds.

To support returning more than one successful choice, we also return a 
procedure containing the continuation on success.

(define (try values proc)
  (if (null? values)
      #f
      (let ((test-value (car values)))
        (let ((result (proc test-value)))
          (if result
              (list result (lambda () (try (cdr values) proc)))
              (try (cdr values) proc))))))

(define (multiple-dwelling)
  (try '(1 2 3 4)
    (lambda (baker)
      (try '(2 3 4 5)
        (lambda (cooper)
          (if (= baker cooper)
              #f
              (try '(2 3 4)
                (lambda (fletcher)
                  (if (or (= fletcher baker)
                          (< (abs (- fletcher cooper)) 2))
                      #f
                      (try '(3 4 5) ; miller > cooper and cooper > 1
                        (lambda (miller)
                          (if (or (= miller baker)
                                  (<= miller cooper)
                                  (= miller fletcher))
                              #f
                              (try '(1 2 3 4 5)
                                (lambda (smith)
                                  (if (or (= smith baker)
                                          (= smith cooper)
                                          (< (abs (- smith fletcher)) 2)
                                          (= smith miller))
                                      #f
                                      (list (list 'baker baker)
                                            (list 'cooper cooper)
                                            (list 'fletcher fletcher)
                                            (list 'miller miller)
                                            (list 'smith smith)))))))))))))))))

To test this:

1 ]=> (define x (multiple-dwelling))

;Value: x

1 ]=> x

;Value 17: (((((((baker 3) (cooper 2) (fletcher 4) (miller 5) (smith 1)) #[compound-procedure 18]) #[compound-procedure 19]) #[compound-procedure 20]) #[compound-procedure 21]) #[compound-procedure 22])

The returned procedures represent the branch points.  We resume the 
search by evaluating the last such procedure:

1 ]=> ((cadr x))

;Value: #f

There are no more values.

If we modify multiple-dwelling to remove the restriction that Smith and 
Fletcher are not adjacent, as in Exer. 4.38, we can test the resume 
feature:

(define (multiple-dwelling)
  (try '(1 2 3 4)
    (lambda (baker)
      (try '(2 3 4 5)
        (lambda (cooper)
          (if (= baker cooper)
              #f
              (try '(2 3 4)
                (lambda (fletcher)
                  (if (or (= fletcher baker)
                          (< (abs (- fletcher cooper)) 2))
                      #f
                      (try '(3 4 5) ; miller > cooper and cooper > 1
                        (lambda (miller)
                          (if (or (= miller baker)
                                  (<= miller cooper)
                                  (= miller fletcher))
                              #f
                              (try '(1 2 3 4 5)
                                (lambda (smith)
                                  (if (or (= smith baker)
                                          (= smith cooper)
                                          ; (< (abs (- smith fletcher)) 2)
                                          (= smith fletcher)
                                          (= smith miller))
                                      #f
                                      (list (list 'baker baker)
                                            (list 'cooper cooper)
                                            (list 'fletcher fletcher)
                                            (list 'miller miller)
                                            (list 'smith smith)))))))))))))))))

Testing this:

1 ]=> (define x (multiple-dwelling))

;Value: x

1 ]=> x

;Value 35: (((((((baker 1) (cooper 2) (fletcher 4) (miller 3) (smith 5)) #[compound-procedure 36]) #[compound-procedure 37]) #[compound-procedure 38]) #[compound-procedure 39]) #[compound-procedure 40])

1 ]=> (set! x ((cadr x)))

;Value 35: (((((((baker 1) (cooper 2) (fletcher 4) (miller 3) (smith 5)) #[compound-procedure 36]) #[compound-procedure 37]) #[compound-procedure 38]) #[compound-procedure 39]) #[compound-procedure 40])

1 ]=> x

;Value 41: (((((((baker 3) (cooper 2) (fletcher 4) (miller 5) (smith 1)) #[compound-procedure 42]) #[compound-procedure 43]) #[compound-procedure 44]) #[compound-procedure 45]) #[compound-procedure 46])

1 ]=> (set! x ((cadr x)))

;Value 41: (((((((baker 3) (cooper 2) (fletcher 4) (miller 5) (smith 1)) #[compound-procedure 42]) #[compound-procedure 43]) #[compound-procedure 44]) #[compound-procedure 45]) #[compound-procedure 46])

1 ]=> x

;Value: #f

So we find two solutions with this restriction lifted.