<< Previous exercise (4.49) | Index | Next exercise (4.51) >>
;; 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))))))
; 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))))
This solution is kind of like the above one, but with a clear process.
;; version 1 (define (analyze-ramb exp) (let ((cprocs (map analyze (amb-choices exp)))) (lambda (env succeed fail) (define (try-next choices) (if (null? choices) (fail) (let ((l (length choices))) (let ((c (list-ref choices (random l)))) (c env succeed (lambda () (try-next (remove choices c)))))))) (try-next cprocs)))) (define (remove seq elt) (filter (lambda (x) (not (eq? elt x))) seq)) ;; version 2: won't do extra works during running (define (shuffle seq) (define (iter seq res) (if (null? seq) res (let ((index (random (length seq)))) (let ((element (list-ref seq index))) (iter (remove seq element) (cons element res)))))) (iter seq nil)) (define (ramb-choices exp) (shuffle (cdr exp))) ; analyze-ramb is the same as analyze-amb
A simple shuffle-list can be used once the choices are gotten and then we can apply this method to our choices:
(define (shuffle lst) (map cdr (sort (map (lambda (x) (cons (random 1.0) x)) lst) (lambda (x y) (< (car x) (car y)))))) (define (analyze-amb exp) (let ((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)))))) (try-next (shuffle cprocs))))) ;; here -- or basically anywhere where we grab the choices
The preceding solutions are either shuffling choices during analysis or choosing a random choice in running time. Both methods have flaws, which do not meet the needs of Exercise.
The first method just randomly interprets ramb expressions by rearranging the order of choices, if we define a function with ramb, no matter how many times we call it, its behavior doesn't change, because the order of choices has been fixed during analysis, even if it is random.
The second method try to select a choice in running time randomly, but it makes a mistake that is it treats every option equally. For amb expression having recursion, there needs different weights to make a choice. For instance, ``an-integer-between`` with the second method have 50% chance to select ``low`` which results in a problem that the function prefers to return the numbers At the beginning.
My solution tackles this problem with a technique—specify the probability of a choice. See the following code:
;;; Exercise 4.50 (define the-default-succeed (lambda (value fail) value)) (define the-default-fail (lambda () 'fail)) (define (analyze exp) (cond ((self-evaluating? exp) (analyze-self-evaluating exp)) ((quoted? exp) (analyze-quoted exp)) ((variable? exp) (analyze-variable exp)) ((assignment? exp) (analyze-assignment exp)) ((definition? exp) (analyze-definition exp)) ((if? exp) (analyze-if exp)) ((lambda? exp) (analyze-lambda exp)) ((begin? exp) (analyze-sequence (begin-actions exp))) ((cond? exp) (analyze (cond->if exp))) ((let? exp) (analyze (let->combination exp))) ;** ((amb? exp) (analyze-amb exp)) ;** ((ramb? exp) (analyze-ramb exp)) ;** ((application? exp) (analyze-application exp)) (else (error "Unknown expression type -- ANALYZE" exp)))) ;;; Extended syntax for ``ramb`` is as follows: ;;; (ramb expr ...) ;;; expr ::= value-expr ;;; || (<Prob> value-expr prob-expr) ;;; NOTE: The probability here tends to be a proportion of likelihood. ;;; The first type of expr has ZERO probability. ;;; The probability of the second type is the value of prob-expr. ;;; The total probability is the sum of the probabilities of all expr. (define (ramb? exp) (tagged-list? exp 'ramb)) (define (ramb-choices exp) (map (lambda (x) (if (and (pair? x) (eq? (car x) '<Prob>)) (cadr x) x)) (cdr exp))) (define (ramb-probabilities exp) (map (lambda (x) (if (and (pair? x) (eq? (car x) '<Prob>)) (caddr x) 0)) (cdr exp))) ;;; pmf: Probability Mass Function ;;; return a list of pairs consisiting of a choice(variable) and a probability. (define (ramb-pmf exp) (map list (map analyze (ramb-choices exp)) (map analyze (ramb-probabilities exp)))) (define (pmf-variable pair) (car pair)) (define (pmf-probability pair) (cadr pair)) (define (cdf-variable pair) (car pair)) (define (cdf-probability pair) (cadr pair)) ;;; Cumulative Distribution Function ;;; return a list of pairs consisting of choice(variable) and a cumulative probability. (define (CDF pmf) (let loop ((cumulation 0) (choices-probs pmf) (ans '())) (if (null? choices-probs) (reverse ans) (let ((new-cumulation (+ cumulation (pmf-probability (car choices-probs))))) (loop new-cumulation (cdr choices-probs) (cons (list (pmf-variable (car choices-probs)) new-cumulation) ans)))))) ;;; sort pmf with probability in descending order, and return its CDF (define (distribution pmf) (let* ((sorted-pmf (sort (lambda (x y) (> (cadr x) (cadr y))) pmf)) (cdf (CDF sorted-pmf))) cdf)) ;;; select the first variable if its cumulative probability > r (define (select-with-random cdf r) (if (< r (cdf-probability (car cdf))) (car cdf) (select-with-random (cdr cdf) r))) ;;; if the total probability n is ZERO, then select a variable with the same possibility, ;;; otherwise generate a number between 0 and n - 1 and then call select-with-random. (define (select cdf n) (if (= n 0) (list-ref cdf (random (length cdf))) (select-with-random cdf (random n)))) (define (remove-choice choice pmf) (define (loop pair) (if (eq? choice (caar pair)) (remove (car pair) pmf) (loop (cdr pair)))) (loop pmf)) (define (analyze-ramb exp) (let ((pmf (ramb-pmf exp))) (lambda (env succeed fail) (define (try-next pmf) (let* ((probs (map (lambda (x) ((pmf-probability x) env the-default-succeed the-default-fail)) pmf)) (total-prob (apply-in-underlying-scheme + probs)) (new-pmf (map (lambda (x y) (list (car x) y)) pmf probs)) (cdf (distribution new-pmf))) (if (null? pmf) (fail) (let ((choice (car (select cdf total-prob)))) ; select a choice in running rather analyzing. (choice env succeed (lambda () (try-next (remove-choice choice pmf)))))))) (try-next pmf)))) (ambeval '(define (require p) (if (not p) (ramb))) the-global-environment the-default-succeed the-default-fail) (ambeval '(define (an-integer-between low high) (require (<= low high)) (ramb (<Prob> low 1) (<Prob> (an-integer-between (+ low 1) high) (- high low)))) the-global-environment the-default-succeed the-default-fail) ;;;;;;;;;;;;;;; ;;;; test;;;;;; ;;;;;;;;;;;;;;; ;;; Amb-Eval input: (an-integer-between 1 10) ;;; Starting a new problem ;;; Amb-Eval value: 4 ;;; Amb-Eval input: (an-integer-between 1 10) ;;; Starting a new problem ;;; Amb-Eval value: 2 ;;; Amb-Eval input: (an-integer-between 1 10) ;;; Starting a new problem ;;; Amb-Eval value: 10 ;;; Amb-Eval input: (an-integer-between 1 10) ;;; Starting a new problem ;;; Amb-Eval value: 2 ;;; Amb-Eval input: (an-integer-between 1 10) ;;; Starting a new problem ;;; Amb-Eval value: 8 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;help with Alyssa’s problem;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (an-element-of items) (require (not (null? items))) (ramb (car items) (an-element-of (cdr items)))) (define (generate-word word-list) (require (not (null? *unparsed*))) (let ((word (an-element-of (cdr word-list)))) (set! *unparsed* (cdr *unparsed*)) (list (car word-list) word)))
The shuffle problem you stated could easily be solved by moving the shuffle process into the execution function (shuffle at runtime).
True shuffling.