diff options
| -rw-r--r-- | ps07_amb/bnewbold_ps07.txt | 19 | ||||
| -rw-r--r-- | ps07_amb/bnewbold_ps07_work.scm | 79 |
2 files changed, 98 insertions, 0 deletions
diff --git a/ps07_amb/bnewbold_ps07.txt b/ps07_amb/bnewbold_ps07.txt new file mode 100644 index 0000000..27bc791 --- /dev/null +++ b/ps07_amb/bnewbold_ps07.txt @@ -0,0 +1,19 @@ +;;; 6.945 Problem Set #7 Comments +;;; 03/28/2009 +;;; Bryan Newbold <bnewbold@mit.edu> + +Problem 7.1: Warmup +-------------------------------- +It's Lorna Downing; if we don't know that it's Ann Moore, it could also be +Lorna Parker. + +My implementation could be greatly optimized by removing the redundant ambs +for Ann and Melissa, but it's nicely symmetric as it is. Also I just derived +the who-owns-what-yacht pairings by hand because it only takes one elimination. + +[see code in bnewbold_ps07_work.scm] + +Problem 7.2: +-------------------------------- + + diff --git a/ps07_amb/bnewbold_ps07_work.scm b/ps07_amb/bnewbold_ps07_work.scm new file mode 100644 index 0000000..9419ac8 --- /dev/null +++ b/ps07_amb/bnewbold_ps07_work.scm @@ -0,0 +1,79 @@ +;;; 6.945 Problem Set #7 Source Code +;;; 03/28/2009 +;;; Bryan Newbold <bnewbold@mit.edu> + +;(load "load") + +;;;------------------------------------------------------------------------ +;;; Problem 7.1: Warmup + +(define (unique . list) + (cond ((null? list) #t) + ((memq (car list) (cdr list)) #f) + (else (apply unique (cdr list))))) +#| +(unique 'a 'b 'c 'd) +; #t +(unique 'a '1 'c '1) +; #f +|# + +(define (find-daughters) + (let ((ann (amb 'moore 'downing 'hall 'hood 'parker)) + (gabrielle (amb 'moore 'downing 'hall 'hood 'parker)) + (lorna (amb 'moore 'downing 'hall 'hood 'parker)) + (rosalind (amb 'moore 'downing 'hall 'hood 'parker)) + (melissa (amb 'moore 'downing 'hall 'hood 'parker)) + (moore 'lorna) + (downing 'melissa) + (hall 'rosalind) + (hood 'gabrielle) + (parker 'ann)) + (require (eq? melissa 'hood)) + ;(require (eq? ann 'moore)) + (require (unique melissa ann gabrielle lorna rosalind)) + (require (not (eq? gabrielle 'hood))) + (require (not (eq? lorna 'moore))) + (require (not (eq? rosalind 'hall))) + (require (not (eq? gabrielle 'parker))) + (let ((yachts (list (list 'moore lorna) + (list 'downing melissa) + (list 'hall rosalind) + (list 'hood gabrielle) + (list 'parker ann)))) + (require (eq? (cadr (assv gabrielle yachts)) 'parker)) + (display (list (list 'ann ann) + (list 'gabrielle gabrielle) + (list 'lorna lorna) + (list 'rosaline rosalind) + (list 'melissa melissa))) + (newline) + (amb)))) + +(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 +|# + +;;;------------------------------------------------------------------------ +;;; Problem 7.2 + +(define (snark-hunt l) + (call-with-current-continuation + (lambda (return) + (letrec ((hunt (lambda (s) + (cond ((null? s) #f) + ((list? (car s)) (or (hunt (car s)) + (hunt (cdr s)))) + ((eq? (car s) 'snark) (return #t)) + (else (hunt (cdr s))))))) + (hunt l))))) + +#| +(snark-hunt '(a (1 2 3) v w)) +; #f +(snark-hunt '(a (1 2 'snark 3) v w)) +; #t +|#
\ No newline at end of file |