src/sicp/ex4_44.rkt

   1 #lang racket
   2
   3 (require "amb-eli.rkt")
   4 (require "distinct.rkt")
   5
   6 (define (queens)
   7   (let ([q1r (amb 1 2 3 4 5 6 7 8)]
   8         [q1c (amb 1 2 3 4 5 6 7 8)]
   9         [q2r (amb 1 2 3 4 5 6 7 8)]
  10         [q2c (amb 1 2 3 4 5 6 7 8)])
  11     (assert (distinct? (list q1r q2r)))
  12     (assert (distinct? (list q1c q2c)))
  13     (assert (not (diagonal? (list q1r q1c) (list q2r q2c))))
  14     (let ([q3r (amb 1 2 3 4 5 6 7 8)]
  15           [q3c (amb 1 2 3 4 5 6 7 8)])
  16       (for ([qr (list q1r q2r)])
  17         (assert (distinct? (list q3r qr))))
  18       (for ([qc (list q1c q2c)])
  19         (assert (distinct? (list q3c qc))))
  20       (for ([q (list (list q1r q1c) (list q2r q2c))])
  21         (assert (not (diagonal? (list q3r q3c) q))))
  22       (let ([q4r (amb 1 2 3 4 5 6 7 8)]
  23             [q4c (amb 1 2 3 4 5 6 7 8)])
  24         (for ([qr (list q1r q2r q3r)])
  25           (assert (distinct? (list q4r qr))))
  26         (for ([qc (list q1c q2c q3c)])
  27           (assert (distinct? (list q4c qc))))
  28         (for ([q (list (list q1r q1c) (list q2r q2c) (list q3r q3c))])
  29           (assert (not (diagonal? (list q4r q4c) q))))
  30         (let ([q5r (amb 1 2 3 4 5 6 7 8)]
  31               [q5c (amb 1 2 3 4 5 6 7 8)])
  32           (for ([qr (list q1r q2r q3r q4r)])
  33             (assert (distinct? (list q5r qr))))
  34           (for ([qc (list q1c q2c q3c q4c)])
  35             (assert (distinct? (list q5c qc))))
  36           (for ([q (list (list q1r q1c) (list q2r q2c) (list q3r q3c) (list q4r q4c))])
  37             (assert (not (diagonal? (list q5r q5c) q))))
  38           (let ([q6r (amb 1 2 3 4 5 6 7 8)]
  39                 [q6c (amb 1 2 3 4 5 6 7 8)])
  40             (for ([qr (list q1r q2r q3r q4r q5r)])
  41               (assert (distinct? (list q6r qr))))
  42             (for ([qc (list q1c q2c q3c q4c q5c)])
  43               (assert (distinct? (list q6c qc))))
  44             (for ([q (list (list q1r q1c) (list q2r q2c) (list q3r q3c) (list q4r q4c) (list q5r q5c))])
  45               (assert (not (diagonal? (list q6r q6c) q))))
  46             (let ([q7r (amb 1 2 3 4 5 6 7 8)]
  47                   [q7c (amb 1 2 3 4 5 6 7 8)])
  48               (for ([qr (list q1r q2r q3r q4r q5r q6r)])
  49                 (assert (distinct? (list q7r qr))))
  50               (for ([qc (list q1c q2c q3c q4c q5c q6c)])
  51                 (assert (distinct? (list q7c qc))))
  52               (for ([q (list (list q1r q1c) (list q2r q2c) (list q3r q3c) (list q4r q4c) (list q5r q5c) (list q6r q6c))])
  53                 (assert (not (diagonal? (list q7r q7c) q))))
  54               (let ([q8r (amb 1 2 3 4 5 6 7 8)]
  55                     [q8c (amb 1 2 3 4 5 6 7 8)])
  56                 (for ([qr (list q1r q2r q3r q4r q5r q6r q7r)])
  57                   (assert (distinct? (list q8r qr))))
  58                 (for ([qc (list q1c q2c q3c q4c q5c q6c q7c)])
  59                   (assert (distinct? (list q8c qc))))
  60                 (for ([q (list (list q1r q1c) (list q2r q2c) (list q3r q3c) (list q4r q4c) (list q5r q5c) (list q6r q6c) (list q7r q7c))])
  61                   (assert (not (diagonal? (list q8r q8c) q))))
  62                 (list (list 'q1 q1r q1c)
  63                       (list 'q2 q2r q2c)
  64                       (list 'q3 q3r q3c)
  65                       (list 'q4 q4r q4c)
  66                       (list 'q5 q5r q5c)
  67                       (list 'q6 q6r q6c)
  68                       (list 'q7 q7r q7c)
  69                       (list 'q8 q8r q8c))))))))))
  70
  71 (define (diagonal? p1 p2)
  72   (let ([x1 (first p1)]
  73         [y1 (second p1)]
  74         [x2 (first p2)]
  75         [y2 (second p2)])
  76     (= (abs (- x1 x2))
  77        (abs (- y1 y2)))))
  78
  79 (queens)
  80
  81 ;; '((q1 1 1) (q2 2 5) (q3 3 8) (q4 4 6) (q5 5 3) (q6 6 7) (q7 7 2) (q8 8 4))