diff options
Diffstat (limited to 'ps07_amb/bnewbold_ps07_work.scm')
| -rw-r--r-- | ps07_amb/bnewbold_ps07_work.scm | 219 |
1 files changed, 215 insertions, 4 deletions
diff --git a/ps07_amb/bnewbold_ps07_work.scm b/ps07_amb/bnewbold_ps07_work.scm index 9419ac8..f134fa7 100644 --- a/ps07_amb/bnewbold_ps07_work.scm +++ b/ps07_amb/bnewbold_ps07_work.scm @@ -2,7 +2,7 @@ ;;; 03/28/2009 ;;; Bryan Newbold <bnewbold@mit.edu> -;(load "load") +(load "load") ;;;------------------------------------------------------------------------ ;;; Problem 7.1: Warmup @@ -50,8 +50,9 @@ (newline) (amb)))) -(with-depth-first-schedule find-daughters) + #| +(with-depth-first-schedule find-daughters) ((ann hall) (gabrielle moore) (lorna parker) (rosaline downing) (melissa hood)) ((ann moore) (gabrielle hall) (lorna downing) (rosaline parker) (melissa hood)) ;Value: #f @@ -65,7 +66,7 @@ (lambda (return) (letrec ((hunt (lambda (s) (cond ((null? s) #f) - ((list? (car s)) (or (hunt (car s)) + ((pair? (car s)) (or (hunt (car s)) (hunt (cdr s)))) ((eq? (car s) 'snark) (return #t)) (else (hunt (cdr s))))))) @@ -74,6 +75,216 @@ #| (snark-hunt '(a (1 2 3) v w)) ; #f -(snark-hunt '(a (1 2 'snark 3) v w)) +(snark-hunt '(a (1 2 snark 3) v w)) +; #t +(snark-hunt '(((a b c) d (e f)) g (((snark . "oops") h) (i . j)))) ; #t +|# + +(define (snark-hunt/instrumented l) + (call-with-current-continuation + (lambda (return) + (letrec ((hunt (lambda (s) + (cond ((null? s) #f) + ((pair? (car s)) + (let ((result (or (hunt (car s)) + (hunt (cdr s))))) + (display ";Found: ") + (display result) + (newline) + result)) + ((eq? (car s) 'snark) (return #t)) + (else (hunt (cdr s))))))) + (hunt l))))) + + +#| +(snark-hunt/instrumented '(a (1 2 3) v w)) +;Found: #f +;Value: #f + +(snark-hunt/instrumented '(a (1 2 snark 3) v w)) +;Value: #t + +(snark-hunt/instrumented '(((a b c) d (e f)) g (((snark . "oops") h) (i . j)))) +;Found: #f +;Found: #f +;Value: #t + +|# + + +;;;------------------------------------------------------------------------ +;;; Problem 7.3 + +(define (a-pythagorean-triple-between/verbose low high) + (let ((i (an-integer-between low high))) + (let ((j (an-integer-between i high))) + (let ((k (an-integer-between j high))) + (set! count (+ count 1)) + (pp (list i j k)) + (require (= (+ (* i i) (* j j)) (* k k))) + (list i j k))))) + +(define count 0) + +#| +(begin + (init-amb) + (set! count 0) + (with-breadth-first-schedule + (lambda () (pp (a-pythagorean-triple-between/verbose 10 20))))) + +(begin + (init-amb) + (set! count 0) + (with-depth-first-schedule + (lambda () (pp (a-pythagorean-triple-between/verbose 10 20))))) +|# + +;;;------------------------------------------------------------------------ +;;; Problem 7.4 + +(define (a-nice-itinerary budget) + (let ((city (amb '(boston 0) + '(san-fransisco 250) + '(nyc 30) + '(paris 500) + '(london 500) + '(auckland 1500))) + (meal (amb '(steak 30) + '(falafel 8) + '(foi-gras 100) + '(dumpster-dive 0))) + (hotel (amb '(ritz 800) + '(hostel 20) + '(couch 0))) + (drinks (amb '(0 0) + '(1 5) + '(2 10) + '(3 15) + '(4 20) + '(5 25) + '(6 30))) + (activity (amb '(museum 15) + '(concert 20) + '(opera 100) + '(park 0)))) + ; stay on budget: + (require (>= budget + (fold + 0 (map cadr (list city meal hotel drinks activity))))) + ; mad cow: + (require (not (and (equal? meal 'steak) (equal? city 'london)))) + ; get lost: + (require (not (and (equal? city 'nyc) (> (car drinks) 3)))) + (pp (map car (list city meal hotel drinks activity))) + (amb))) + +; (a-nice-itinerary 40) + +(define (randomize l) + (if (null? l) + '() + (let ((e (list-ref l (random (length l))))) + (cons e (randomize (list-difference l (list e))))))) + +#| +(randomize '(1 2 3 4 5)) +;Value: (3 5 2 1 4) +;Value: (1 5 4 3 2) +;Value: (3 4 5 1 2) +;Value: (5 4 1 2 3) +;Value: (5 1 3 4 2) +;Value: (2 5 4 1 3) +;Value: (1 3 2 5 4) +;Value: (3 2 1 4 5) +|# + +(define (add-left-to-right alternatives) + (for-each (lambda (alternative) + (push! *search-schedule* alternative)) + (reverse alternatives))) + +(define (add-right-to-left alternatives) + (for-each (lambda (alternative) + (push! *search-schedule* alternative)) + alternatives)) + +(define (add-randomly alternatives) + (for-each (lambda (alternative) + (push! *search-schedule* alternative)) + (randomize alternatives))) + +(define (with-left-to-right-alternation thunk) + (call-with-current-continuation + (lambda (k) + (fluid-let ((add-to-search-schedule + add-left-to-right) + (*search-schedule* (empty-search-schedule)) + (*top-level* k)) + (thunk))))) + +(define (with-right-to-left-alternation thunk) + (call-with-current-continuation + (lambda (k) + (fluid-let ((add-to-search-schedule + add-right-to-left) + (*search-schedule* (empty-search-schedule)) + (*top-level* k)) + (thunk))))) + +(define (with-random-alternation thunk) + (call-with-current-continuation + (lambda (k) + (fluid-let ((add-to-search-schedule + add-randomly) + (*search-schedule* (empty-search-schedule)) + (*top-level* k)) + (thunk))))) + +#| +(begin + (init-amb) + (with-left-to-right-alternation + (lambda () + (pp (a-pythagorean-triple-between/verbose 10 20))))) + +(10 10 10) +(10 10 12) +(10 10 13) +(10 10 14) +(10 10 15) +(10 10 16) +(10 10 17) +(etc) + +(begin + (init-amb) + (with-right-to-left-alternation + (lambda () + (pp (a-pythagorean-triple-between/verbose 10 20))))) + +(20 20 20) +(19 20 20) +(19 19 20) +(19 19 19) +(18 20 20) +(18 19 20) +(etc) + + +(begin + (init-amb) + (with-random-alternation + (lambda () + (pp (a-pythagorean-triple-between/verbose 10 20))))) + +(10 13 13) +(10 13 15) +(10 13 16) +(10 13 18) +(10 13 19) +(10 13 20) +(etc) + |#
\ No newline at end of file |