diff --git a/ex-4_35-44.scm b/ex-4_35-44.scm index f19f6a3..6859a39 100644 --- a/ex-4_35-44.scm +++ b/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")