Add amb-8-queens.rkt (exercise 4.44)

Currently fixed for n = 8.

mceval/amb-8-queens.rkt

@@ -0,0 +1,49 @@
+
+
+(define (enumerate-interval low high)
+  (if (> low high)
+      '()
+      (cons low (enumerate-interval (+ low 1) high))))
+
+(define (list-ref l n)
+  (if (= n 0) (car l)
+      (list-ref (cdr l) (- n 1))))
+
+
+;; Not sure how to get a procedure to create (amb 1 ... n) for
+;; arbitrary n without doing quasiquote, unsplice, etc, so fix for
+;; n=8.
+(define (queens)
+  (define (position row col) (cons row col))
+  (define (row position) (car position))
+  (define (col position) (cdr position))
+  (define (positive-intercept position)
+    (- (row position) (col position)))
+  (define (negative-intercept position)
+    (+ (row position) (col position)))
+  (define (safe? k positions)
+    (if (< k 2) true
+        (let ((kth-position (list-ref positions (- k 1)))
+              (pre-kth-positions (cdr (reverse positions))))
+          ;; If the row, positive or negative intercept of the k-th position
+          ;; is equal to any of the first k-1 positions, then the k-th
+          ;; position is not safe.
+          (if (memv (row kth-position) (map row pre-kth-positions))
+              false
+              (if (memv (positive-intercept kth-position)
+                        (map positive-intercept pre-kth-positions))
+                  false
+                  (if (memv (negative-intercept kth-position)
+                            (map negative-intercept pre-kth-positions))
+                      false
+                      true))))))
+  (define (queens-add-columns current-queens column)
+    (if (> column 8) current-queens
+        (let ((new-queens
+               (append current-queens
+                       (list (position (amb 1 2 3 4 5 6 7 8) column)))))
+          (require (safe? column new-queens))
+          (queens-add-columns new-queens (+ column 1)))))
+  (queens-add-columns '() 1))
+
+

mceval/amb-utilities.rkt

@@ -25,5 +25,11 @@
     (define (map f l)
       (if (null? l) '()
           (cons (f (car l))
-                (map f (cdr l)))))))
+                (map f (cdr l)))))
+
+    (define (and-map f l)
+      (if (null? l) true
+          (if (f (car l))
+              true
+              false)))))
 

mceval/environment.rkt

@@ -163,7 +163,10 @@
         (list 'cons cons)
         (list 'null? null?)
         (list 'list list)
+        (list 'reverse reverse)
+        (list 'append append)
         (list 'memq memq)
+        (list 'memv memv)
         (list 'member member)
         (list 'not not)
         (list '= =)