src/sicp/ex4_40.rkt

   1 #lang racket
   2
   3 #|
   4
   5 how many sets of assignments are there of people to floors, both before and after the requirement that floor assignments be distinct?
   6
   7 Before - 5 * 5 * 5 * 5 * 5 = 3125
   8 After  - 5 * 4 * 3 * 2 * 1 = 120
   9
  10 |#
  11
  12 (require "amb-eli.rkt")
  13 (require "distinct.rkt")
  14
  15 (define (multiple-dwelling-1)
  16   (let ([baker (amb 1 2 3 4)]
  17         [cooper (amb 2 3 4 5)]
  18         [fletcher (amb 2 3 4)]
  19         [miller (amb 3 4 5)]
  20         [smith (amb 1 2 3 4 5)])
  21     ;(assert (not (= baker 5)))
  22     ;(assert (not (= cooper 1)))
  23     ;(assert (not (= fletcher 5)))
  24     ;(assert (not (= fletcher 1)))
  25     (assert (> miller cooper))
  26     (assert (not (= (abs (- smith fletcher)) 1)))
  27     (assert (not (= (abs (- fletcher cooper)) 1)))
  28     (assert (distinct? (list baker cooper fletcher miller smith)))
  29     (list (list 'baker baker)
  30           (list 'cooper cooper)
  31           (list 'fletcher fletcher)
  32           (list 'miller miller)
  33           (list 'smith smith))))
  34
  35 (collect (multiple-dwelling-1))
  36
  37 ;; another implementation
  38 (define (multiple-dwelling-2)
  39   (let ([cooper (amb 2 3 4 5)]
  40         [miller (amb 3 4 5)])
  41     (assert (> miller cooper))
  42     (let ([fletcher (amb 2 3 4)])
  43       (assert (not (= (abs (- fletcher cooper)) 1)))
  44       (let ([smith (amb 1 2 3 4 5)])
  45         (assert (not (= (abs (- smith fletcher)) 1)))
  46         (let ([baker (amb 1 2 3 4)])
  47           (assert (distinct? (list baker cooper fletcher miller smith)))
  48           (list (list 'baker baker)
  49                 (list 'cooper cooper)
  50                 (list 'fletcher fletcher)
  51                 (list 'miller miller)
  52                 (list 'smith smith)))))))
  53
  54 (collect (multiple-dwelling-2))