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

Answer till 4.40

main
Felix Martin 2021-02-02 14:26:23 -05:00
parent a23aebd0d0
commit 48816043d7
1 changed files with 45 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

74
ex-4_35-xx.scm
View File

@ -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")