sicp/mceval/amb-multiple-dwelling.rkt

151 lines
4.0 KiB
Racket

(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 (not (= (abs (- smith fletcher)) 1)))
(require (not (= (abs (- fletcher cooper)) 1)))
(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))
(list (list 'baker baker)
(list 'cooper cooper)
(list 'fletcher fletcher)
(list 'miller miller)
(list 'smith smith))))
;; Output (with millisecond timer printed): total time ~117ms
;;; Amb-Eval input:
(multiple-dwelling)
;;; Starting a new problem
;;; Amb-Eval value:
37
((baker 3) (cooper 2) (fletcher 4) (miller 5) (smith 1))
;;; Amb-Eval input:
try-again
;;; There are no more values of
80
(multiple-dwelling)
;; Exercise 4.38: without the constraint that smith and fletcher do
;; not live on adjacent floors, there are 5 solutions:
(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 (not (= (abs (- fletcher cooper)) 1)))
(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))
(list (list 'baker baker)
(list 'cooper cooper)
(list 'fletcher fletcher)
(list 'miller miller)
(list 'smith smith))))
;;; Amb-Eval input:
(multiple-dwelling)
;;; Starting a new problem
;;; Amb-Eval value:
((baker 1) (cooper 2) (fletcher 4) (miller 3) (smith 5))
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
((baker 1) (cooper 2) (fletcher 4) (miller 5) (smith 3))
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
((baker 1) (cooper 4) (fletcher 2) (miller 5) (smith 3))
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
((baker 3) (cooper 2) (fletcher 4) (miller 5) (smith 1))
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
((baker 3) (cooper 4) (fletcher 2) (miller 5) (smith 1))
;;; Amb-Eval input:
try-again
;;; There are no more values of
(multiple-dwelling)
;; Exercise 4.39: I think that the order of the restrictions will not
;; make much difference, as the computation time is dominated by the
;; backtracking search, and this will done every time none of the
;; restrictions calls (amb). So assuming we always continue to try
;; again until there are no more solutions, then the running time will
;; be about the same. However, the order of restrictions could easily
;; affect how quickly the first solution is found, as it may affect
;; the number of searches needed before the first match.
;; Exercise 4.40
(define (multiple-dwelling)
(let ((miller (amb 3 4 5))
(cooper (amb 2 3 4 5)))
(require (> miller cooper))
(let ((fletcher (amb 2 3 4)))
(require (not (= (abs (- fletcher cooper)) 1)))
(let ((smith (amb 1 2 3 4 5)))
(require (not (= (abs (- smith fletcher)) 1)))
(let ((baker (amb 1 2 3 4)))
(require
(distinct? (list baker
cooper
fletcher
miller
smith)))
(list (list 'baker baker)
(list 'cooper cooper)
(list 'fletcher fletcher)
(list 'miller miller)
(list 'smith smith)))))))
;; Output (with millisecond counter printed). Total time ~8ms (about
;; 14 times faster than the original implementation).
;;; Amb-Eval input:
(multiple-dwelling)
;;; Starting a new problem
;;; Amb-Eval value:
2
((baker 3) (cooper 2) (fletcher 4) (miller 5) (smith 1))
;;; Amb-Eval input:
try-again
;;; There are no more values of
6
(multiple-dwelling)