Completed up to exercise 4.40

This shows the cumulative number of milliseconds in the current problem

mceval/amb-multiple-dwelling.rkt

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

mceval/ambeval.rkt

@@ -6,10 +6,15 @@
            "syntax.rkt"
            "environment.rkt"
            "common.rkt"
-           "special-forms.rkt")
+           "special-forms.rkt"
+           "timing.rkt")
+
+(#%require (only racket current-process-milliseconds))
+(#%require (only racket string-append))
 
 (#%provide ambeval
-           driver-loop)
+           amb-driver-loop
+           amb-eval-program)
 
 (define (amb? exp) (tagged-list? exp 'amb))
 (define (amb-choices exp) (cdr exp))
@@ -191,20 +196,12 @@
 (define input-prompt ";;; Amb-Eval input:")
 (define output-prompt ";;; Amb-Eval value:")
 
-(define (driver-loop)
+(define (amb-driver-loop)
   (define env (setup-environment))
   ;; Need to pass success and failure continuations to ambeval, so
   ;; will probably need a different eval-program.
-  (eval-program amb-utilities-program
-                (lambda (exp env)       ; Evaluate exp using ambeval
-                                        ; passing in appropriate
-                                        ; continuations
-                  (ambeval exp
-                           env
-                           (lambda (value fail) value)
-                           (lambda () 'failed)))
-                user-print
-                env)
+  (amb-eval-program-in-env amb-utilities-program env)
+  (define start-time 0)
   (define (internal-loop try-again)
     (prompt-for-input input-prompt)
     (let ((input (read)))
@@ -213,24 +210,30 @@
           (begin
             (newline)
             (display ";;; Starting a new problem ")
+            (set! start-time (current-process-milliseconds))
             (ambeval input
                      env
                      ;; ambeval success
                      (lambda (val next-alternative)
+                       (newline)
                        (announce-output output-prompt)
+                       (display (- (current-process-milliseconds) start-time))
+                       (newline)
                        (user-print val)
                        (internal-loop next-alternative))
                      ;; ambeval failure
                      (lambda ()
                        (announce-output
                         ";;; There are no more values of")
+                       (display (- (current-process-milliseconds) start-time))
+                       (newline)
                        (user-print input)
-                       (driver-loop)))))))
+                       (amb-driver-loop)))))))
   (internal-loop
    (lambda ()
      (newline)
      (display ";;; There is no current problem")
-     (driver-loop))))
+     (amb-driver-loop))))
 
 
 
@@ -251,7 +254,21 @@
     (make-combination (make-lambda (map let-var bindings)
                                    (let-body exp))
                       (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

mceval/multiple-dwelling.rkt

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

mceval/test-eval.rkt

@@ -5,26 +5,12 @@
 
 (#%require "dd-mceval.rkt"
            "analyzing-mceval.rkt"
-           "leval.rkt")
+           "leval.rkt"
+           "timing.rkt")
 
-(#%require (only racket current-process-milliseconds))
 (#%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 n)
       (if (= n 1) 1

mceval/timing.rkt

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