sicp-ex-4.50



<< Previous exercise (4.49) | Index | Next exercise (4.51) >>


meteorgan

  
  
 ;; In (analyze expr) adds 
 ((ramb? expr) (analyze-ramb expr)) 
  
 ;; add these code to amb evaluator 
 (define (analyze-ramb expr) 
   (analyze-amb (cons 'amb (ramb-choices expr)))) 
  
 ;; amb expression 
 (define (amb? expr) (tagged-list? expr 'amb)) 
 (define (amb-choices expr) (cdr expr)) 
  
 (define (ramb? expr) (tagged-list? expr 'ramb)) 
 (define (ramb-choices expr) (shuffle-list (cdr expr))) 
  
  
 ;; random-in-place, from CLRS 5.3 
 (define (shuffle-list lst) 
  (define (random-shuffle result rest) 
   (if (null? rest) 
       result 
           (let* ((pos (random (length rest))) 
                  (item (list-ref rest pos))) 
            (if (= pos 0) 
                (random-shuffle (append result (list item)) (cdr rest)) 
                (let ((first-item (car rest))) 
                      (random-shuffle (append result (list item)) 
                                      (insert! first-item (- pos 1) (cdr (delete! pos rest))))))))) 
   (random-shuffle '() lst)) 
  
 ;; insert item to lst in position k. 
 (define (insert! item k lst) 
   (if (or (= k 0) (null? lst)) 
       (append (list item) lst) 
       (cons (car lst) (insert! item (- k 1) (cdr lst))))) 
 (define (delete! k lst) 
   (cond ((null? lst) '()) 
         ((= k 0) (cdr lst)) 
         (else (cons (car lst)  
                     (delete! (- k 1) (cdr lst)))))) 

Rptx

  
 ; this procedure gets the random element to the start of the list. The rest 
 ; is the same as in amb. 
  
 (define (analyze-ramb exp) 
   (define (list-ref-and-delete ref lst)        ; get random item from list. 
     (define (loop count prev-items rest-items) ; and return a list with the 
       (if (= count 0)                          ; random item as its car 
           (cons (car rest-items)               ; and the rest of the list as the cdr 
                 (append prev-items (cdr rest-items))) 
           (loop (- count 1)                    ; this will mangle the list every time 
                 (cons (car rest-items)         ; creating a "random" amb.  
                       prev-items) 
                 (cdr rest-items)))) 
     (if (null? lst) 
         '() 
         (loop ref '() lst))) 
   (let ((cprocs (map analyze (amb-choices exp)))) 
     (lambda (env succeed fail) 
       (define (try-next choices) 
         (if (null? choices) 
               (fail) 
               (let ((randomized (list-ref-and-delete 
                                  (random (length choices)) 
                                  choices))) 
                 ((car randomized) env 
                                   succeed 
                                   (lambda () 
                                     (try-next (cdr randomized))))))) 
       (try-next cprocs))))