ps progress

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