From 30c84f7888f3dbb37841cdad6a0b0154e3d67b56 Mon Sep 17 00:00:00 2001
From: Oliver Payne <ompayne@sdf.org>
Date: Thu, 16 Nov 2023 23:06:35 +0000
Subject: [PATCH] WIP amb-8-queens

---
 mceval/amb-8-queens.rkt  | 92 ++++++++++++++++++++++++++++++++++++++++
 mceval/amb-utilities.rkt |  8 +++-
 mceval/environment.rkt   |  2 +
 3 files changed, 101 insertions(+), 1 deletion(-)
 create mode 100644 mceval/amb-8-queens.rkt

diff --git a/mceval/amb-8-queens.rkt b/mceval/amb-8-queens.rkt
new file mode 100644
index 0000000..87d0595
--- /dev/null
+++ b/mceval/amb-8-queens.rkt
@@ -0,0 +1,92 @@
+;; EXERCISE 2.42
+(define (queens board-size)
+  (define (queen-cols k)
+    (if (= k 0)
+        (list empty-board)
+        (filter
+         (lambda (positions) (safe? k positions))
+         (flatmap
+          (lambda (rest-of-queens)
+            (map (lambda (new-row)
+                   (adjoin-position new-row k rest-of-queens))
+                 (enumerate-interval 1 board-size)))
+          (queen-cols (- k 1))))))
+  (queen-cols board-size))
+
+(define empty-board '())
+
+(define (position row col) (cons row col))
+(define (row position) (car position))
+(define (col position) (cdr position))
+(define (intercepts horiz pos neg) (list horiz pos neg))
+(define (horiz intercepts) (car intercepts))
+(define (pos intercepts) (cadr intercepts))
+(define (neg intercepts) (caddr intercepts))
+(define (col-k-pos k positions)
+  (car (filter (lambda (x) (= (col x) k)) positions)))
+
+; Compute the y-intercepts of the horizontal line the line
+; of gradient +1 and the line of gradient -1 through the 
+; given position.  Any two positions that share one of these
+; intercepts put are not safe wrt each other.
+(define (compute-intercepts position)
+  (intercepts (row position)
+	      (- (row position) (col position))
+	      (+ (row position) (col position))))
+
+(define (checks pos1 pos2)
+  (if (= (col pos1) (col pos2))
+      #f
+      (let ((int1 (compute-intercepts pos1))
+	    (int2 (compute-intercepts pos2)))
+	   (or (= (horiz int1) (horiz int2))
+	       (= (pos int1) (pos int2))
+	       (= (neg int1) (neg int2))))))
+
+(define (adjoin-position row col rest-of-queens)
+  (append rest-of-queens (list (position row col))))
+
+
+; Calculuate the intercepts of each of the position.  If any
+; match, then the k-th position is not safe.
+(define (safe? k positions) 
+  (if (= (col (car positions)) k) #t  ; Need to only check with first k-1
+      (let* ((k-pos (col-k-pos k positions))
+	     (k-int (compute-intercepts k-pos))
+	     (int (compute-intercepts (car positions))))
+	    (and (not (= (horiz int) (horiz k-int)))
+		 (not (= (pos int) (pos k-int)))
+		 (not (= (neg int) (neg k-int)))
+		 (safe? k (cdr positions))))))
+
+
+
+(define (eight-queens)
+  (define (position row col) (cons row col))
+  (define (row position) (car position))
+  (define (col position) (cdr position))
+  (define (safe? k positions)
+    (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.
+
+      ;; Better would be: look at columns up to k and check that row
+      ;; and intercepts are distinct.
+      (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)))))
+  (let ((queens
+         (map (lambda (col) (position (amb 1 2 3 4 5 6 7 8) col))
+              '(1 2 3 4 5 6 7 8))))
+    (and-map (lambda (k) (safe? k queens))
+             '(1 2 3 4 5 6 7 8))
+    queens))
+
diff --git a/mceval/amb-utilities.rkt b/mceval/amb-utilities.rkt
index c79c1a7..b5efaa6 100644
--- a/mceval/amb-utilities.rkt
+++ b/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)))))
 
diff --git a/mceval/environment.rkt b/mceval/environment.rkt
index a2be090..a375a8c 100644
--- a/mceval/environment.rkt
+++ b/mceval/environment.rkt
@@ -163,7 +163,9 @@
         (list 'cons cons)
         (list 'null? null?)
         (list 'list list)
+        (list 'reverse reverse)
         (list 'memq memq)
+        (list 'memv memv)
         (list 'member member)
         (list 'not not)
         (list '= =)