From: Ramakrishnan Muthukrishnan <vu3rdd@gmail.com>
Date: Fri, 4 Jan 2013 16:51:21 +0000 (+0530)
Subject: solutions to 4.38, 4.39 and 4.40
X-Git-Url: https://git.rkrishnan.org/pf/content/en/components/com_hotproperty/something?a=commitdiff_plain;h=50cef372de91c41185de4fac8a1fc456c978b28a;p=sicp.git

solutions to 4.38, 4.39 and 4.40
---

diff --git a/src/sicp/distinct.rkt b/src/sicp/distinct.rkt
new file mode 100644
index 0000000..3f2e2e0
--- /dev/null
+++ b/src/sicp/distinct.rkt
@@ -0,0 +1,26 @@
+#lang racket
+
+(provide distinct?)
+
+(define (distinct? xs)
+  (let loop [(s (set))
+             (r xs)]
+    (cond [(empty? r) #t]
+          [(set-member? s (first r)) #f]
+          [else (loop (set-add s (first r)) (rest r))])))
+
+(module+ test
+  (require rackunit)
+  
+  (check-equal? (distinct? '()) #t)
+  (check-equal? (distinct? '(1)) #t)
+  (check-equal? (distinct? '(1 2)) #t)
+  (check-equal? (distinct? '(1 1)) #f)
+  (check-equal? (distinct? '(1 2 3)) #t)
+  (check-equal? (distinct? '(1 2 3 3 2)) #f)
+  (check-equal? (distinct? '(a b)) #t)
+  (check-equal? (distinct? '(a b a)) #f)
+  (check-equal? (distinct? '(a b c c)) #f)
+  (check-equal? (distinct? '(1 2 3 4)) #t)
+  (check-equal? (distinct? '(1 2 3 4 5)) #t)
+  (check-equal? (distinct? '(1 (2 3) 4 2 3)) #t))
\ No newline at end of file
diff --git a/src/sicp/ex4_38.rkt b/src/sicp/ex4_38.rkt
new file mode 100644
index 0000000..e705ef0
--- /dev/null
+++ b/src/sicp/ex4_38.rkt
@@ -0,0 +1,34 @@
+#lang racket
+
+(require "amb-eli.rkt")
+(require "distinct.rkt")
+
+(define (multiple-dwelling)
+  (let ([baker (amb 1 2 3 4 5)]
+        [cooper (amb 1 2 3 4 5)]
+        [fletcher (amb 1 2 3 4 5)]
+        [miller (amb 1 2 3 4 5)]
+        [smith (amb 1 2 3 4 5)])
+    (assert (distinct? (list baker cooper fletcher miller smith)))
+    (assert (not (= baker 5)))
+    (assert (not (= cooper 1)))
+    (assert (not (= fletcher 5)))
+    (assert (not (= fletcher 1)))
+    (assert (> miller cooper))
+    ;; (assert (not (= (abs (- smith fletcher)) 1)))
+    (assert (not (= (abs (- fletcher cooper)) 1)))
+    (list (list 'baker baker)
+          (list 'cooper cooper)
+          (list 'fletcher fletcher)
+          (list 'miller miller)
+          (list 'smith smith))))
+
+(collect (multiple-dwelling))
+
+#|
+'(((baker 1) (cooper 2) (fletcher 4) (miller 3) (smith 5))
+  ((baker 1) (cooper 2) (fletcher 4) (miller 5) (smith 3))
+  ((baker 1) (cooper 4) (fletcher 2) (miller 5) (smith 3))
+  ((baker 3) (cooper 2) (fletcher 4) (miller 5) (smith 1))
+  ((baker 3) (cooper 4) (fletcher 2) (miller 5) (smith 1)))
+|#
\ No newline at end of file
diff --git a/src/sicp/ex4_39.rkt b/src/sicp/ex4_39.rkt
new file mode 100644
index 0000000..8f91db4
--- /dev/null
+++ b/src/sicp/ex4_39.rkt
@@ -0,0 +1,33 @@
+#lang racket
+
+#|
+
+There are 5*5*5*5*5 possibilities. The order won't affect the results. 
+But it will affect time. The various 'require' or 'assert' statements
+restrict the number of options and the possibility tree.
+ 
+Let us look at the statements now.
+
+1.    (assert (distinct? (list baker cooper fletcher miller smith)))
+2.    (assert (not (= baker 5)))
+3.    (assert (not (= cooper 1)))
+4.    (assert (not (= fletcher 5)))
+5.    (assert (not (= fletcher 1)))
+6.    (assert (> miller cooper))
+7.    (assert (not (= (abs (- fletcher cooper)) 1)))
+
+If we look the constraints in isolation, 
+
+constraint #1, will have 5*4*3*2*1 = 120 successes.
+constraint #2 will have 5*5*5*5*4  = 2400 successes.
+
+When they are put together, let us say #1 and then #2, then we have
+#1 executing for 5^5 times resulting in 120 successes and so #2 executing for 120 times.
+
+If we reverse #2 and #1, then we have #2 executing for 5^5 times giving 2400 possible 
+values and so #1 executes for 2400 times.
+
+So, if any condition takes more time to execute, then these numbers will be an effect, so
+order will affect the execution times.
+
+|#
\ No newline at end of file
diff --git a/src/sicp/ex4_40.rkt b/src/sicp/ex4_40.rkt
new file mode 100644
index 0000000..252c1d8
--- /dev/null
+++ b/src/sicp/ex4_40.rkt
@@ -0,0 +1,54 @@
+#lang racket
+
+#|
+
+how many sets of assignments are there of people to floors, both before and after the requirement that floor assignments be distinct? 
+
+Before - 5 * 5 * 5 * 5 * 5 = 3125
+After  - 5 * 4 * 3 * 2 * 1 = 120
+
+|#
+
+(require "amb-eli.rkt")
+(require "distinct.rkt")
+
+(define (multiple-dwelling-1)
+  (let ([baker (amb 1 2 3 4)]
+        [cooper (amb 2 3 4 5)]
+        [fletcher (amb 2 3 4)]
+        [miller (amb 3 4 5)]
+        [smith (amb 1 2 3 4 5)])
+    ;(assert (not (= baker 5)))
+    ;(assert (not (= cooper 1)))
+    ;(assert (not (= fletcher 5)))
+    ;(assert (not (= fletcher 1)))
+    (assert (> miller cooper))
+    (assert (not (= (abs (- smith fletcher)) 1)))
+    (assert (not (= (abs (- fletcher cooper)) 1)))
+    (assert (distinct? (list baker cooper fletcher miller smith)))
+    (list (list 'baker baker)
+          (list 'cooper cooper)
+          (list 'fletcher fletcher)
+          (list 'miller miller)
+          (list 'smith smith))))
+
+(collect (multiple-dwelling-1))
+
+;; another implementation
+(define (multiple-dwelling-2)
+  (let ([cooper (amb 2 3 4 5)]
+        [miller (amb 3 4 5)])
+    (assert (> miller cooper))
+    (let ([fletcher (amb 2 3 4)])
+      (assert (not (= (abs (- fletcher cooper)) 1)))
+      (let ([smith (amb 1 2 3 4 5)])
+        (assert (not (= (abs (- smith fletcher)) 1)))
+        (let ([baker (amb 1 2 3 4)])
+          (assert (distinct? (list baker cooper fletcher miller smith)))
+          (list (list 'baker baker)
+                (list 'cooper cooper)
+                (list 'fletcher fletcher)
+                (list 'miller miller)
+                (list 'smith smith)))))))
+
+(collect (multiple-dwelling-2))
\ No newline at end of file