Fix solution to liars-puzzle where my code yielded a wrong result previously

ex-4_35-44.scm

@@ -238,65 +238,29 @@
 
 (display "\nex-4.42 - liars-puzzle\n")
 
-;    Five schoolgirls sat for an examination. Their parents -- so they thought
-;    -- showed an undue degree of interest in the result. They therefore agreed
-;    that, in writing home about the examination, each girl should make one
-;    true statement and one untrue one. The following are the relevant passages
-;    from their letters:
-;
-;        Betty: ``Kitty was second in the examination. I was only third.''
-;        Ethel: ``You'll be glad to hear that I was on top. Joan was second.''
-;        Joan: ``I was third, and poor old Ethel was bottom.''
-;        Kitty: ``I came out second. Mary was only fourth.''
-;        Mary: ``I was fourth. Top place was taken by Betty.''
-;
-;    What in fact was the order in which the five girls were placed?
+(define (xor p q)
+  (require (or (and p (not q)) (and (not p) q))))
 
-(define (no-violation new-stmt stmts)
-  (if (null? stmts)
-    #t
-    (let ((stmt (car stmts)))
-      (cond
-        ((and (eq? (car new-stmt) (car stmt))
-              (not (eq? (cadr new-stmt) (cadr stmt)))) #f)
-        ((and (not (eq? (car new-stmt) (car stmt)))
-              (eq? (cadr new-stmt) (cadr stmt))) #f)
-        (else (no-violation new-stmt (cdr stmts)))))))
+(define (liars-puzzle)
+  (let ((ethel (an-integer-between 1 5))
+        (joan (an-integer-between 1 5)))
+    (xor (= ethel 1) (= joan 2))
+    (xor (= joan 3) (= ethel 5))
+    (let ((kitty (an-integer-between 1 5))
+          (betty (an-integer-between 1 5))
+          (mary (an-integer-between 1 5)))
+      (xor (= kitty 2) (= betty 3))
+      (xor (= kitty 2) (= mary 4))
+      (xor (= mary 4) (= betty 1))
+      (require (distinct? (list kitty betty ethel joan mary)))
+      (map list '(kitty betty ethel joan mary) (list kitty betty ethel joan mary)))))
 
-(define (liars-puzzle-1)
-  (let ((stmt-1 (amb '(kitty 2) '(betty 3))))
-    (require (no-violation stmt-1 '()))
-    (let ((stmt-2 (amb '(ethel 1) '(joan 2))))
-      (require (no-violation stmt-2 (list stmt-1)))
-      (let ((stmt-3 (amb '(joan 3) '(ethel 5))))
-        (require (no-violation stmt-3 (list stmt-1 stmt-2)))
-        (let ((stmt-4 (amb '(kitty 2) '(mary 4))))
-          (require (no-violation stmt-4 (list stmt-1 stmt-2 stmt-3)))
-          (let ((stmt-5 (amb '(mary 4) '(betty 1))))
-            (require (no-violation stmt-5 (list stmt-1 stmt-2 stmt-3 stmt-4)))
-            (list stmt-1 stmt-2 stmt-3 stmt-4 stmt-5)))))))
-
-(define (liars-puzzle statements solution)
-  (if (null? statements)
-    solution
-    (let ((stmt ((car statements))))
-      (require (no-violation stmt solution))
-      (liars-puzzle (cdr statements) (append solution (list stmt))))))
-
-(define statements (list
-                     (lambda () (amb '(kitty 2) '(betty 3)))
-                     (lambda () (amb '(ethel 1) '(joan 2)))
-                     (lambda () (amb '(joan 3) '(ethel 5)))
-                     (lambda () (amb '(kitty 2) '(mary 4)))
-                     (lambda () (amb '(mary 4) '(betty 1)))))
-
-(my-assert (liars-puzzle-1) (liars-puzzle statements '()))
-
-; Two implementations of the same algorithm. Note that the solution does not
-; show the position of all students. It only provides a subset of states that
-; do no result in a violation. We would have to do some further computations on
-; that result to get the position of each individual student.
+(display (liars-puzzle)) (newline)
 
+; My solution to this problem was previously wrong because I didn't check for
+; the either or conditions at the same step of the search. Consequently, a true
+; statement of one student could be a false statement of the other student.
+; This cannot happen when we check at the same time.
 
 (display "\nex-4.43 - lornas-father\n")