Compare commits
4 Commits
a16df8cca2
...
d794e64d06
Author | SHA1 | Date |
---|---|---|
Oliver Payne | d794e64d06 | |
Oliver Payne | 6df1a27539 | |
Oliver Payne | a457194e11 | |
Oliver Payne | fd1d3682f3 |
|
@ -0,0 +1,150 @@
|
||||||
|
(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 (not (= (abs (- smith fletcher)) 1)))
|
||||||
|
(require (not (= (abs (- fletcher cooper)) 1)))
|
||||||
|
(require
|
||||||
|
(distinct? (list baker cooper fletcher miller smith)))
|
||||||
|
(require (not (= baker 5)))
|
||||||
|
(require (not (= cooper 1)))
|
||||||
|
(require (not (= fletcher 5)))
|
||||||
|
(require (not (= fletcher 1)))
|
||||||
|
(require (> miller cooper))
|
||||||
|
(list (list 'baker baker)
|
||||||
|
(list 'cooper cooper)
|
||||||
|
(list 'fletcher fletcher)
|
||||||
|
(list 'miller miller)
|
||||||
|
(list 'smith smith))))
|
||||||
|
|
||||||
|
;; Output (with millisecond timer printed): total time ~117ms
|
||||||
|
|
||||||
|
;;; Amb-Eval input:
|
||||||
|
(multiple-dwelling)
|
||||||
|
|
||||||
|
;;; Starting a new problem
|
||||||
|
|
||||||
|
;;; Amb-Eval value:
|
||||||
|
37
|
||||||
|
((baker 3) (cooper 2) (fletcher 4) (miller 5) (smith 1))
|
||||||
|
|
||||||
|
;;; Amb-Eval input:
|
||||||
|
try-again
|
||||||
|
|
||||||
|
;;; There are no more values of
|
||||||
|
80
|
||||||
|
(multiple-dwelling)
|
||||||
|
|
||||||
|
|
||||||
|
;; Exercise 4.38: without the constraint that smith and fletcher do
|
||||||
|
;; not live on adjacent floors, there are 5 solutions:
|
||||||
|
|
||||||
|
(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 (not (= (abs (- fletcher cooper)) 1)))
|
||||||
|
(require
|
||||||
|
(distinct? (list baker cooper fletcher miller smith)))
|
||||||
|
(require (not (= baker 5)))
|
||||||
|
(require (not (= cooper 1)))
|
||||||
|
(require (not (= fletcher 5)))
|
||||||
|
(require (not (= fletcher 1)))
|
||||||
|
(require (> miller cooper))
|
||||||
|
(list (list 'baker baker)
|
||||||
|
(list 'cooper cooper)
|
||||||
|
(list 'fletcher fletcher)
|
||||||
|
(list 'miller miller)
|
||||||
|
(list 'smith smith))))
|
||||||
|
|
||||||
|
;;; Amb-Eval input:
|
||||||
|
(multiple-dwelling)
|
||||||
|
|
||||||
|
;;; Starting a new problem
|
||||||
|
;;; Amb-Eval value:
|
||||||
|
((baker 1) (cooper 2) (fletcher 4) (miller 3) (smith 5))
|
||||||
|
|
||||||
|
;;; Amb-Eval input:
|
||||||
|
try-again
|
||||||
|
|
||||||
|
;;; Amb-Eval value:
|
||||||
|
((baker 1) (cooper 2) (fletcher 4) (miller 5) (smith 3))
|
||||||
|
|
||||||
|
;;; Amb-Eval input:
|
||||||
|
try-again
|
||||||
|
|
||||||
|
;;; Amb-Eval value:
|
||||||
|
((baker 1) (cooper 4) (fletcher 2) (miller 5) (smith 3))
|
||||||
|
|
||||||
|
;;; Amb-Eval input:
|
||||||
|
try-again
|
||||||
|
|
||||||
|
;;; Amb-Eval value:
|
||||||
|
((baker 3) (cooper 2) (fletcher 4) (miller 5) (smith 1))
|
||||||
|
|
||||||
|
;;; Amb-Eval input:
|
||||||
|
try-again
|
||||||
|
|
||||||
|
;;; Amb-Eval value:
|
||||||
|
((baker 3) (cooper 4) (fletcher 2) (miller 5) (smith 1))
|
||||||
|
|
||||||
|
;;; Amb-Eval input:
|
||||||
|
try-again
|
||||||
|
|
||||||
|
;;; There are no more values of
|
||||||
|
(multiple-dwelling)
|
||||||
|
|
||||||
|
;; Exercise 4.39: I think that the order of the restrictions will not
|
||||||
|
;; make much difference, as the computation time is dominated by the
|
||||||
|
;; backtracking search, and this will done every time none of the
|
||||||
|
;; restrictions calls (amb). So assuming we always continue to try
|
||||||
|
;; again until there are no more solutions, then the running time will
|
||||||
|
;; be about the same. However, the order of restrictions could easily
|
||||||
|
;; affect how quickly the first solution is found, as it may affect
|
||||||
|
;; the number of searches needed before the first match.
|
||||||
|
|
||||||
|
;; Exercise 4.40
|
||||||
|
|
||||||
|
(define (multiple-dwelling)
|
||||||
|
(let ((miller (amb 3 4 5))
|
||||||
|
(cooper (amb 2 3 4 5)))
|
||||||
|
(require (> miller cooper))
|
||||||
|
(let ((fletcher (amb 2 3 4)))
|
||||||
|
(require (not (= (abs (- fletcher cooper)) 1)))
|
||||||
|
(let ((smith (amb 1 2 3 4 5)))
|
||||||
|
(require (not (= (abs (- smith fletcher)) 1)))
|
||||||
|
(let ((baker (amb 1 2 3 4)))
|
||||||
|
(require
|
||||||
|
(distinct? (list baker
|
||||||
|
cooper
|
||||||
|
fletcher
|
||||||
|
miller
|
||||||
|
smith)))
|
||||||
|
(list (list 'baker baker)
|
||||||
|
(list 'cooper cooper)
|
||||||
|
(list 'fletcher fletcher)
|
||||||
|
(list 'miller miller)
|
||||||
|
(list 'smith smith)))))))
|
||||||
|
|
||||||
|
;; Output (with millisecond counter printed). Total time ~8ms (about
|
||||||
|
;; 14 times faster than the original implementation).
|
||||||
|
|
||||||
|
;;; Amb-Eval input:
|
||||||
|
(multiple-dwelling)
|
||||||
|
|
||||||
|
;;; Starting a new problem
|
||||||
|
|
||||||
|
;;; Amb-Eval value:
|
||||||
|
2
|
||||||
|
((baker 3) (cooper 2) (fletcher 4) (miller 5) (smith 1))
|
||||||
|
|
||||||
|
;;; Amb-Eval input:
|
||||||
|
try-again
|
||||||
|
|
||||||
|
;;; There are no more values of
|
||||||
|
6
|
||||||
|
(multiple-dwelling)
|
|
@ -6,10 +6,15 @@
|
||||||
"syntax.rkt"
|
"syntax.rkt"
|
||||||
"environment.rkt"
|
"environment.rkt"
|
||||||
"common.rkt"
|
"common.rkt"
|
||||||
"special-forms.rkt")
|
"special-forms.rkt"
|
||||||
|
"timing.rkt")
|
||||||
|
|
||||||
|
(#%require (only racket current-process-milliseconds))
|
||||||
|
(#%require (only racket string-append))
|
||||||
|
|
||||||
(#%provide ambeval
|
(#%provide ambeval
|
||||||
driver-loop)
|
amb-driver-loop
|
||||||
|
amb-eval-program)
|
||||||
|
|
||||||
(define (amb? exp) (tagged-list? exp 'amb))
|
(define (amb? exp) (tagged-list? exp 'amb))
|
||||||
(define (amb-choices exp) (cdr exp))
|
(define (amb-choices exp) (cdr exp))
|
||||||
|
@ -191,20 +196,12 @@
|
||||||
(define input-prompt ";;; Amb-Eval input:")
|
(define input-prompt ";;; Amb-Eval input:")
|
||||||
(define output-prompt ";;; Amb-Eval value:")
|
(define output-prompt ";;; Amb-Eval value:")
|
||||||
|
|
||||||
(define (driver-loop)
|
(define (amb-driver-loop)
|
||||||
(define env (setup-environment))
|
(define env (setup-environment))
|
||||||
;; Need to pass success and failure continuations to ambeval, so
|
;; Need to pass success and failure continuations to ambeval, so
|
||||||
;; will probably need a different eval-program.
|
;; will probably need a different eval-program.
|
||||||
(eval-program amb-utilities-program
|
(amb-eval-program-in-env amb-utilities-program env)
|
||||||
(lambda (exp env) ; Evaluate exp using ambeval
|
(define start-time 0)
|
||||||
; passing in appropriate
|
|
||||||
; continuations
|
|
||||||
(ambeval exp
|
|
||||||
env
|
|
||||||
(lambda (value fail) value)
|
|
||||||
(lambda () 'failed)))
|
|
||||||
user-print
|
|
||||||
env)
|
|
||||||
(define (internal-loop try-again)
|
(define (internal-loop try-again)
|
||||||
(prompt-for-input input-prompt)
|
(prompt-for-input input-prompt)
|
||||||
(let ((input (read)))
|
(let ((input (read)))
|
||||||
|
@ -213,24 +210,30 @@
|
||||||
(begin
|
(begin
|
||||||
(newline)
|
(newline)
|
||||||
(display ";;; Starting a new problem ")
|
(display ";;; Starting a new problem ")
|
||||||
|
(set! start-time (current-process-milliseconds))
|
||||||
(ambeval input
|
(ambeval input
|
||||||
env
|
env
|
||||||
;; ambeval success
|
;; ambeval success
|
||||||
(lambda (val next-alternative)
|
(lambda (val next-alternative)
|
||||||
|
(newline)
|
||||||
(announce-output output-prompt)
|
(announce-output output-prompt)
|
||||||
|
(display (- (current-process-milliseconds) start-time))
|
||||||
|
(newline)
|
||||||
(user-print val)
|
(user-print val)
|
||||||
(internal-loop next-alternative))
|
(internal-loop next-alternative))
|
||||||
;; ambeval failure
|
;; ambeval failure
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(announce-output
|
(announce-output
|
||||||
";;; There are no more values of")
|
";;; There are no more values of")
|
||||||
|
(display (- (current-process-milliseconds) start-time))
|
||||||
|
(newline)
|
||||||
(user-print input)
|
(user-print input)
|
||||||
(driver-loop)))))))
|
(amb-driver-loop)))))))
|
||||||
(internal-loop
|
(internal-loop
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(newline)
|
(newline)
|
||||||
(display ";;; There is no current problem")
|
(display ";;; There is no current problem")
|
||||||
(driver-loop))))
|
(amb-driver-loop))))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
@ -251,7 +254,21 @@
|
||||||
(make-combination (make-lambda (map let-var bindings)
|
(make-combination (make-lambda (map let-var bindings)
|
||||||
(let-body exp))
|
(let-body exp))
|
||||||
(map let-val bindings))))
|
(map let-val bindings))))
|
||||||
|
|
||||||
|
(define (amb-eval-program-in-env program env)
|
||||||
|
(eval-program program
|
||||||
|
(lambda (exp env)
|
||||||
|
(ambeval exp
|
||||||
|
env
|
||||||
|
(lambda (value fail) value)
|
||||||
|
(lambda () 'failed)))
|
||||||
|
user-print
|
||||||
|
env))
|
||||||
|
|
||||||
|
(define (amb-eval-program program)
|
||||||
|
(define env (setup-environment))
|
||||||
|
(amb-eval-program-in-env amb-utilities-program env)
|
||||||
|
(amb-eval-program-in-env program env))
|
||||||
|
|
||||||
|
|
||||||
'AMB-EVALUATOR-LOADED
|
'AMB-EVALUATOR-LOADED
|
||||||
|
|
|
@ -1,64 +0,0 @@
|
||||||
#lang sicp
|
|
||||||
|
|
||||||
(#%require "ambeval.rkt")
|
|
||||||
|
|
||||||
(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)))
|
|
||||||
(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)))
|
|
||||||
(require (not (= (abs (- fletcher cooper)) 1)))
|
|
||||||
(list (list 'baker baker)
|
|
||||||
(list 'cooper cooper)
|
|
||||||
(list 'fletcher fletcher)
|
|
||||||
(list 'miller miller)
|
|
||||||
(list 'smith smith))))
|
|
||||||
|
|
||||||
;; Exercise 4.38: without the constraint that smith and fletcher do
|
|
||||||
;; not live on adjacent floors, there are 5 solutions:
|
|
||||||
|
|
||||||
;;; Amb-Eval input:
|
|
||||||
(multiple-dwelling)
|
|
||||||
|
|
||||||
;;; Starting a new problem
|
|
||||||
;;; Amb-Eval value:
|
|
||||||
((baker 1) (cooper 2) (fletcher 4) (miller 3) (smith 5))
|
|
||||||
|
|
||||||
;;; Amb-Eval input:
|
|
||||||
try-again
|
|
||||||
|
|
||||||
;;; Amb-Eval value:
|
|
||||||
((baker 1) (cooper 2) (fletcher 4) (miller 5) (smith 3))
|
|
||||||
|
|
||||||
;;; Amb-Eval input:
|
|
||||||
try-again
|
|
||||||
|
|
||||||
;;; Amb-Eval value:
|
|
||||||
((baker 1) (cooper 4) (fletcher 2) (miller 5) (smith 3))
|
|
||||||
|
|
||||||
;;; Amb-Eval input:
|
|
||||||
try-again
|
|
||||||
|
|
||||||
;;; Amb-Eval value:
|
|
||||||
((baker 3) (cooper 2) (fletcher 4) (miller 5) (smith 1))
|
|
||||||
|
|
||||||
;;; Amb-Eval input:
|
|
||||||
try-again
|
|
||||||
|
|
||||||
;;; Amb-Eval value:
|
|
||||||
((baker 3) (cooper 4) (fletcher 2) (miller 5) (smith 1))
|
|
||||||
|
|
||||||
;;; Amb-Eval input:
|
|
||||||
try-again
|
|
||||||
|
|
||||||
;;; There are no more values of
|
|
||||||
(multiple-dwelling)
|
|
|
@ -5,26 +5,12 @@
|
||||||
|
|
||||||
(#%require "dd-mceval.rkt"
|
(#%require "dd-mceval.rkt"
|
||||||
"analyzing-mceval.rkt"
|
"analyzing-mceval.rkt"
|
||||||
"leval.rkt")
|
"leval.rkt"
|
||||||
|
"timing.rkt")
|
||||||
|
|
||||||
(#%require (only racket current-process-milliseconds))
|
|
||||||
(#%require (only racket/base module+))
|
(#%require (only racket/base module+))
|
||||||
|
|
||||||
|
|
||||||
;; Call proc on args n times and output the average time per run
|
|
||||||
(define time-proc
|
|
||||||
(lambda (iterations proc)
|
|
||||||
(let ((start-time (current-process-milliseconds)))
|
|
||||||
(let loop ((n iterations))
|
|
||||||
(if (> n 0)
|
|
||||||
(begin
|
|
||||||
(proc)
|
|
||||||
(loop (- n 1)))))
|
|
||||||
(exact->inexact
|
|
||||||
(/ (- (current-process-milliseconds)
|
|
||||||
start-time)
|
|
||||||
iterations)))))
|
|
||||||
|
|
||||||
(define (fact-program x)
|
(define (fact-program x)
|
||||||
`((define (fact n)
|
`((define (fact n)
|
||||||
(if (= n 1) 1
|
(if (= n 1) 1
|
||||||
|
|
|
@ -0,0 +1,20 @@
|
||||||
|
#lang sicp
|
||||||
|
|
||||||
|
(#%require (only racket current-process-milliseconds))
|
||||||
|
|
||||||
|
(#%provide time-proc)
|
||||||
|
|
||||||
|
;; Call proc on args n times and output the average time per run
|
||||||
|
(define time-proc
|
||||||
|
(lambda (iterations proc)
|
||||||
|
(let ((start-time (current-process-milliseconds)))
|
||||||
|
(let loop ((n iterations))
|
||||||
|
(if (> n 0)
|
||||||
|
(begin
|
||||||
|
(proc)
|
||||||
|
(loop (- n 1)))))
|
||||||
|
(exact->inexact
|
||||||
|
(/ (- (current-process-milliseconds)
|
||||||
|
start-time)
|
||||||
|
iterations)))))
|
||||||
|
|
Loading…
Reference in New Issue