Add exercise 4.53

mceval/amb-implementation.rkt

@@ -0,0 +1,190 @@
+;; Exercise 4.50.  Using ramb for generating sentences stops the
+;; generation getting stuck in the out recursion.
+;;; Amb-Eval input:
+(set! parse-word generate-word-ramb)
+
+;;; Starting a new problem 
+
+
+;;; Amb-Eval value:
+0
+ok
+
+;;; Amb-Eval input:
+(parse '())
+
+;;; Starting a new problem 
+
+
+;;; Amb-Eval value:
+0
+(simple-sentence (simple-noun-phrase (article the) ((noun professor))) (verb studies))
+
+;;; Amb-Eval input:
+try-again
+
+
+;;; Amb-Eval value:
+4
+(compound-sentence (simple-sentence (simple-noun-phrase (article the) ((noun professor))) (verb studies)) (connective and) (simple-sentence (simple-noun-phrase (article a) ((noun cat))) (verb studies)))
+
+;;; Amb-Eval input:
+try-again
+
+
+;;; Amb-Eval value:
+8
+(compound-sentence (compound-sentence (simple-sentence (simple-noun-phrase (article the) ((noun professor))) (verb studies)) (connective and) (simple-sentence (simple-noun-phrase (article a) ((noun cat))) (verb studies))) (connective and) (simple-sentence (simple-noun-phrase (article the) ((noun professor))) (verb studies)))
+
+;;; Amb-Eval input:
+try-again
+
+
+;;; Amb-Eval value:
+13
+(compound-sentence (compound-sentence (compound-sentence (simple-sentence (simple-noun-phrase (article the) ((noun professor))) (verb studies)) (connective and) (simple-sentence (simple-noun-phrase (article a) ((noun cat))) (verb studies))) (connective and) (simple-sentence (simple-noun-phrase (article the) ((noun professor))) (verb studies))) (connective and) (simple-sentence (simple-noun-phrase (article the) ((noun cat))) (verb sleeps)))
+
+;;; Amb-Eval input:
+try-again
+
+
+;;; Amb-Eval value:
+18
+(compound-sentence (compound-sentence (compound-sentence (compound-sentence (simple-sentence (simple-noun-phrase (article the) ((noun professor))) (verb studies)) (connective and) (simple-sentence (simple-noun-phrase (article a) ((noun cat))) (verb studies))) (connective and) (simple-sentence (simple-noun-phrase (article the) ((noun professor))) (verb studies))) (connective and) (simple-sentence (simple-noun-phrase (article the) ((noun cat))) (verb sleeps))) (connective and) (simple-sentence (simple-noun-phrase (article the) ((noun student))) (verb studies)))
+
+;;; Amb-Eval input:
+
+
+;; Exercise 4.51:
+
+;;; Amb-Eval input:
+(define count 0)
+
+          (let ((x (an-element-of '(a b c)))
+                (y (an-element-of '(a b c))))
+            (permanent-set! count (+ count 1))
+            (require (not (eq? x y)))
+            (list x y count))
+
+;;; Starting a new problem 
+
+
+;;; Amb-Eval value:
+0
+ok
+
+;;; Amb-Eval input:
+
+;;; Starting a new problem 
+
+
+;;; Amb-Eval value:
+0
+(a b 2)
+
+;;; Amb-Eval input:
+try-again
+
+
+;;; Amb-Eval value:
+3
+(a c 3)
+
+;; Using set! instead of permanent-set! resets the counter back to 0
+;; on each backtrack of x or y, so will always be 1.
+
+
+;; Exercise 4.52
+
+;;; Amb-Eval input:
+
+;;; Amb-Eval input:
+(if-fail (let ((x (an-element-of '(1 3 5))))
+           (require (even? x))
+           x)
+         'all-odd)
+
+;;; Starting a new problem 
+
+
+;;; Amb-Eval value:
+0
+all-odd
+
+;;; Amb-Eval input:
+(if-fail (let ((x (an-element-of '(1 3 5 8))))
+           (require (even? x))
+           x)
+         'all-odd)
+
+;;; Starting a new problem 
+
+
+;;; Amb-Eval value:
+0
+8
+
+;;; Amb-Eval input:
+try-again
+
+
+;;; Amb-Eval value:
+4
+all-odd
+
+;;; Amb-Eval input:
+try-again
+
+;;; There are no more values of
+7
+(if-fail (let ((x (an-element-of (quote (1 3 5 8))))) (require (even? x)) x) (quote all-odd))
+
+
+;; Exercise 4.53
+
+(define (square x) (* x x))
+
+(define (smallest-divisor n)
+  (find-divisor n 2))
+
+(define (find-divisor n test-divisor)
+  (cond ((> (square test-divisor) n) n)
+        ((divides? test-divisor n) test-divisor)
+        (else (find-divisor n (+ test-divisor 1)))))
+
+(define (divides? a b)
+  (= (remainder b a) 0))
+
+(define (prime? n)
+  (= n (smallest-divisor n)))
+
+(define (prime-sum-pair list1 list2)
+  (let ((a (an-element-of list1))
+        (b (an-element-of list2)))
+    (require (prime? (+ a b)))
+    (list a b)))
+
+
+;;; Amb-Eval input:
+(let ((pairs '()))
+  (if-fail (let ((p (prime-sum-pair '(1 3 5 8) '(20 35 110))))
+             (permanent-set! pairs (cons p pairs))
+             (amb))
+           pairs))
+
+;;; Starting a new problem 
+
+
+;;; Amb-Eval value:
+0
+((8 35) (3 110) (3 20))
+
+;; The call to prime-sum-pair succeeds for each of the pairs that
+;; satisfy the condition.  On success, the let body is entered, which
+;; conses the current result onto pairs.  Then the (amb) call forces
+;; back tracking to the next solution.  For each of these, pairs is
+;; augmented with the candidate solution, until there are no more
+;; solutions.  At this point, the let expression fails, and if-fail
+;; causes pairs to be evaluated.
+
+

mceval/amb-natural-language.rkt

@@ -295,60 +295,3 @@ try-again
 
 ;; The generation gets stuck in the outer-most recursion.  In this
 ;; case, it is the generation of compound sentences from simple sentences.
-
-
-;; Exercise 4.50.  Using ramb for generating sentences stops the
-;; generation getting stuck in the out recursion.
-;;; Amb-Eval input:
-(set! parse-word generate-word-ramb)
-
-;;; Starting a new problem 
-
-
-;;; Amb-Eval value:
-0
-ok
-
-;;; Amb-Eval input:
-(parse '())
-
-;;; Starting a new problem 
-
-
-;;; Amb-Eval value:
-0
-(simple-sentence (simple-noun-phrase (article the) ((noun professor))) (verb studies))
-
-;;; Amb-Eval input:
-try-again
-
-
-;;; Amb-Eval value:
-4
-(compound-sentence (simple-sentence (simple-noun-phrase (article the) ((noun professor))) (verb studies)) (connective and) (simple-sentence (simple-noun-phrase (article a) ((noun cat))) (verb studies)))
-
-;;; Amb-Eval input:
-try-again
-
-
-;;; Amb-Eval value:
-8
-(compound-sentence (compound-sentence (simple-sentence (simple-noun-phrase (article the) ((noun professor))) (verb studies)) (connective and) (simple-sentence (simple-noun-phrase (article a) ((noun cat))) (verb studies))) (connective and) (simple-sentence (simple-noun-phrase (article the) ((noun professor))) (verb studies)))
-
-;;; Amb-Eval input:
-try-again
-
-
-;;; Amb-Eval value:
-13
-(compound-sentence (compound-sentence (compound-sentence (simple-sentence (simple-noun-phrase (article the) ((noun professor))) (verb studies)) (connective and) (simple-sentence (simple-noun-phrase (article a) ((noun cat))) (verb studies))) (connective and) (simple-sentence (simple-noun-phrase (article the) ((noun professor))) (verb studies))) (connective and) (simple-sentence (simple-noun-phrase (article the) ((noun cat))) (verb sleeps)))
-
-;;; Amb-Eval input:
-try-again
-
-
-;;; Amb-Eval value:
-18
-(compound-sentence (compound-sentence (compound-sentence (compound-sentence (simple-sentence (simple-noun-phrase (article the) ((noun professor))) (verb studies)) (connective and) (simple-sentence (simple-noun-phrase (article a) ((noun cat))) (verb studies))) (connective and) (simple-sentence (simple-noun-phrase (article the) ((noun professor))) (verb studies))) (connective and) (simple-sentence (simple-noun-phrase (article the) ((noun cat))) (verb sleeps))) (connective and) (simple-sentence (simple-noun-phrase (article the) ((noun student))) (verb studies)))
-
-;;; Amb-Eval input:

mceval/ambeval.rkt

@@ -29,8 +29,10 @@
         ((quoted? exp) (analyze-quoted exp))
         ((variable? exp) (analyze-variable exp))
         ((assignment? exp) (analyze-assignment exp))
+        ((permanent-assignment? exp) (analyze-permanent-assignment exp))
         ((definition? exp) (analyze-definition exp))
         ((if? exp) (analyze-if exp))
+        ((if-fail? exp) (analyze-if-fail exp))
         ((lambda? exp) (analyze-lambda exp))
         ((begin? exp) (analyze-sequence (begin-actions exp)))
         ((cond? exp) (analyze (cond->if exp)))
@@ -132,6 +134,19 @@
                             (fail2)))))
              fail))))
 
+(define (analyze-permanent-assignment exp)
+  (let ((var (assignment-variable exp))
+        (vproc (analyze (assignment-value exp))))
+    (lambda (env succeed fail)
+      (vproc env
+             (lambda (val fail2)        ; *1*
+               (let ((old-value
+                      (lookup-variable-value var env))) 
+                 (set-variable-value! var val env)
+                 (succeed 'ok
+                          fail2)))
+             fail))))
+
 ;;;Procedure applications
 
 (define (analyze-application exp)
@@ -214,6 +229,14 @@
                                        (try-next (rest-choices choices)))))))
       (try-next cprocs))))
 
+;; if-fail is used to catch failure of an expression
+(define (analyze-if-fail exp)
+  (let ((tproc (analyze (if-fail-test exp)))
+        (cproc (analyze (if-fail-consequent exp))))
+    (lambda (env succeed fail)
+      ;; Use cproc instead of the passed fail procedure
+      (tproc env succeed (lambda () (cproc env succeed fail))))))
+
 ;;;Driver loop
 
 (define input-prompt ";;; Amb-Eval input:")

mceval/environment.rkt

@@ -186,6 +186,7 @@
         (list 'abs abs)
         (list 'max max)
         (list 'remainder remainder)
+        (list 'even? even?)
         (list 'integer? integer?)
         (list 'sqrt sqrt)
         (list 'eq? eq?)

mceval/syntax.rkt

@@ -83,6 +83,8 @@
 ;; Assignment
 (define (assignment? exp)
   (tagged-list? exp 'set!))
+(define (permanent-assignment? exp)
+  (tagged-list? exp 'permanent-set!))
 (define (assignment-variable exp) (cadr exp))
 (define (assignment-value exp) (caddr exp))
 (define (make-assignment variable value)
@@ -478,3 +480,12 @@
   (cadr exp))
 (define (cons-second-exp exp)
   (caddr exp))
+
+
+;; Exercise 4.52
+(define (if-fail? exp)
+  (tagged-list? exp 'if-fail))
+(define (if-fail-test exp)
+  (cadr exp))
+(define (if-fail-consequent exp)
+  (caddr exp))