felixm
/
SICP
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Implement 4.42

main
Felix Martin 2021-02-04 14:14:52 -05:00
parent a76e30ddca
commit 59a86be7e5
1 changed files with 48 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

50
ex-4_35-xx.scm
View File

@ -214,9 +214,55 @@
(my-assert (multiple-dwelling)
(car (multiple-dwelling-ordinary)))
(display "\nex-4.42\n")
(display "\nex-4.42 - liars-puzzle\n")
(display "\nex-4.43\n")
(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-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 "\nex-4.43 - lornas-father\n")
; (display "\nex-4.44 - eight-queens\n")