From 48816043d7d91fee3f502f41439f4a590c1581cc Mon Sep 17 00:00:00 2001
From: Felix Martin <mail@felixm.de>
Date: Tue, 2 Feb 2021 14:26:23 -0500
Subject: [PATCH] Answer till 4.40

---
 ex-4_35-xx.scm | 74 ++++++++++++++++++++++++++++++--------------------
 1 file changed, 45 insertions(+), 29 deletions(-)

diff --git a/ex-4_35-xx.scm b/ex-4_35-xx.scm
index dc3b2a5..727bb51 100644
--- a/ex-4_35-xx.scm
+++ b/ex-4_35-xx.scm
@@ -83,8 +83,7 @@
         (fletcher (amb 1 2 3 4 5))
         (miller (amb 1 2 3 4 5))
         (smith (amb 1 2 3 4 5)))
-    (require
-     (distinct? (list baker cooper fletcher miller smith)))
+    (require (distinct? (list baker cooper fletcher miller smith)))
     (require (not (= baker 5)))
     (require (not (= cooper 1)))
     (require (not (= fletcher 5)))
@@ -104,6 +103,13 @@
 
 (display "\nex-4.39 - multiple-dwelling-ordering\n")
 
+; The ordering does not matter because the interpreter first evaluates all ambs
+; and then runs the checks. The interpreter will check all combinations even if
+; they cannot yield a possible solution, such as (fletcher 1). To avoid this one
+; would have to interleave the am expression and the checks.
+
+(display "[answered]\n")
+
 (define (repeat proc n)
   (if (= n 0)
     't
@@ -113,42 +119,52 @@
 
 (let ((start-time (runtime)))
   (repeat multiple-dwelling 10)
-  (display "Default ordering: ")
+  (display "[default = ")
   (display (- (runtime) start-time))
-  (newline))
+  (display "]\n"))
+
+(display "\nex-4.40 - multiple-dwelling-improved\n")
 
 (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
-     (distinct? (list baker cooper fletcher miller smith)))
+  (let ((baker (amb 1 2 3 4 5)))
     (require (not (= baker 5)))
-    (require (not (= cooper 1)))
-    (require (not (= fletcher 5)))
-    (require (not (= fletcher 1)))
-    (require (> miller cooper))
-    (require (not (= (abs (- smith fletcher)) 1))) ; adjacent floors constraint
-    (require (not (= (abs (- fletcher cooper)) 1)))
-    (list (list 'baker baker)
-          (list 'cooper cooper)
-          (list 'fletcher fletcher)
-          (list 'miller miller)
-          (list 'smith smith))))
+    (let ((cooper (amb 1 2 3 4 5)))
+        (require (distinct? (list baker cooper)))
+      (require (not (= baker cooper)))
+      (require (not (= cooper 1)))
+      (let ((fletcher (amb 1 2 3 4 5)))
+        (require (distinct? (list baker cooper fletcher)))
+        (require (not (= cooper fletcher)))
+        (require (not (= fletcher 5)))
+        (require (not (= fletcher 1)))
+        (let ((miller (amb 1 2 3 4 5)))
+          (require (distinct? (list baker cooper fletcher miller)))
+          (require (not (= fletcher miller)))
+          (require (> miller cooper))
+          (require (not (= (abs (- fletcher cooper)) 1)))
+          (let ((smith (amb 1 2 3 4 5)))
+            (require (distinct? (list baker cooper fletcher miller smith)))
+            (require (not (= (abs (- smith fletcher)) 1)))
+            (list (list 'baker baker)
+                  (list 'cooper cooper)
+                  (list 'fletcher fletcher)
+                  (list 'miller miller)
+                  (list 'smith smith))))))))
+
+(my-assert (multiple-dwelling)
+           '((baker 3) (cooper 2) (fletcher 4) (miller 5) (smith 1)))
 
 (let ((start-time (runtime)))
   (repeat multiple-dwelling 10)
-  (display "Improved ordering: ")
+  (display "[improved = ")
   (display (- (runtime) start-time))
-  (newline))
+  (display "]\n"))
 
-; The ordering should matter because the earlier we recognize that the current
-; branch does not have any solutions the faster we can backtrack and the more
-; we prune the search space.
+(display "\nex-4.41 - multiple-dwelling-ordinary\n")
 
-(display "\nex-4.40\n")
 
-(display "\nex-4.41\n")
+(display "\nex-4.42\n")
+
+; (display "\nex-4.43\n")
+; (display "\nex-4.44 - eight-queens\n")