Add possibly useful utility procedures

mceval/amb-natural-language.rkt

@@ -24,10 +24,23 @@
     (set! *unparsed* (cdr *unparsed*))
     (list (car word-list) found-word)))
 
+;; Exercise 4.48: generate a word by ignoring the unparsed input and
+;; just working through all possible sentences.
 (define (generate-word word-list)
-  (let ((word-type (car word-list)))
-    (amb (list word-type (cadr word-list))
-         (parse-word (cons word-type (cdr (cdr word-list)))))))
+  (if null? (cdr word-list) (amb)
+      (let ((word-type (car word-list)))
+        (amb (list word-type (cadr word-list))
+             (generate-word (cons word-type (cdr (cdr word-list))))))))
+
+;; Exercise 4.50: use ramb instead of amb to avoid getting stuck in
+;; recursions.
+(define (generate-word-ramb word-list)
+  (if (null? (cdr word-list)) (amb)
+      (let ((word-type (car word-list)))
+        (ramb (list word-type (cadr word-list))
+              (generate-word-ramb (cons word-type (cdr (cdr word-list))))))))
+
+
 
 (define *unparsed* '())
 
@@ -282,3 +295,60 @@ 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/amb-utilities.rkt

@@ -31,5 +31,23 @@
       (if (null? l) true
           (if (f (car l))
               true
-              false)))))
+              false)))
+
+    (define (length l)
+      (if (null? l)
+          0
+          (+ 1 (length (cdr l)))))
+
+    (define (list-ref list k)
+      (if (= k 0)
+          (car list)
+          (list-ref (cdr list) (- k 1))))
+
+    ;; Remove the kth element from list
+    (define (remove list k)
+      (if (= k 0)
+          (cdr list)
+          (cons (car list)
+                (remove (cdr list) (- k 1)))))
+    ))
 

mceval/ambeval.rkt

@@ -17,6 +17,8 @@
            amb-eval-program)
 
 (define (amb? exp) (tagged-list? exp 'amb))
+(define (ramb? exp) (tagged-list? exp 'ramb))
+(define (amb-form exp) (car exp))       ; amb or ramb
 (define (amb-choices exp) (cdr exp))
 
 ;; analyze from 4.1.6, with clause from 4.3.3 added
@@ -34,6 +36,7 @@
         ((cond? exp) (analyze (cond->if exp)))
         ((let? exp) (analyze (let->combination exp))) ;**
         ((amb? exp) (analyze-amb exp))                ;**
+        ((ramb? exp) (analyze-amb exp))
         ((application? exp) (analyze-application exp))
         (else
          (error "Unknown expression type -- ANALYZE" exp))))
@@ -179,16 +182,36 @@
 
 ;;;amb expressions
 
+;; Make this generic for amb and ramb.  For ramb, we pick a random
+;; element rather than car.
+;; If we are in a ramb form, then then next index to select is chosen
+;; randomly.  If we are in an amb form, then the index is 0.  We
+;; define next-choice and rest-choices in terms of this index.
+
+(define (remove-element list k)
+      (if (= k 0)
+          (cdr list)
+          (cons (car list)
+                (remove-element (cdr list) (- k 1)))))
+
 (define (analyze-amb exp)
-  (let ((cprocs (map analyze (amb-choices exp))))
+  (let ((form (amb-form exp))
+        (cprocs (map analyze (amb-choices exp))))
     (lambda (env succeed fail)
       (define (try-next choices)
         (if (null? choices)
             (fail)
-            ((car choices) env
-                           succeed
-                           (lambda ()
-                             (try-next (cdr choices))))))
+            (let* ((index (if (eq? form 'ramb)
+                              (random (length choices))
+                              0))
+                   (next-choice
+                    (lambda (l) (list-ref l index)))
+                   (rest-choices
+                    (lambda (l) (remove-element l index))))
+              ((next-choice choices) env
+                                     succeed
+                                     (lambda ()
+                                       (try-next (rest-choices choices)))))))
       (try-next cprocs))))
 
 ;;;Driver loop