summaryrefslogtreecommitdiffstats
path: root/ps07_amb
diff options
context:
space:
mode:
Diffstat (limited to 'ps07_amb')
-rw-r--r--ps07_amb/bnewbold_ps07.txt19
-rw-r--r--ps07_amb/bnewbold_ps07_work.scm79
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