From: Ramakrishnan Muthukrishnan <vu3rdd@gmail.com>
Date: Sat, 23 Apr 2011 13:51:16 +0000 (+0530)
Subject: solutions to a bunch of exercises 3.33 to 3.37
X-Git-Url: https://git.rkrishnan.org/(%5B%5E?a=commitdiff_plain;h=40ae99a4ef268d3b1e8de60f70b9ff3df45265da;p=sicp.git

solutions to a bunch of exercises 3.33 to 3.37
---

diff --git a/src/sicp/ex3_32.rkt b/src/sicp/ex3_32.rkt
new file mode 100644
index 0000000..ea4c2e0
--- /dev/null
+++ b/src/sicp/ex3_32.rkt
@@ -0,0 +1,12 @@
+#lang racket
+
+#|
+
+The output is computed at that instant when the gate
+function is called. This value of the output is used
+by set-signal! during the required time segment. So, 
+we don't compute the gate output at the time slot. It
+is already precomputed at definition time. So, we should
+also output them in the same order.
+
+|#
diff --git a/src/sicp/ex3_33.rkt b/src/sicp/ex3_33.rkt
new file mode 100644
index 0000000..2756dd8
--- /dev/null
+++ b/src/sicp/ex3_33.rkt
@@ -0,0 +1,185 @@
+#lang racket
+
+;; implementation
+(define (adder a1 a2 sum)
+  (define (process-new-value)
+    (cond ((and (has-value? a1) (has-value? a2))
+           (set-value! sum
+                       (+ (get-value a1) (get-value a2))
+                       me))
+          ((and (has-value? a1) (has-value? sum))
+           (set-value! a2
+                       (- (get-value sum) (get-value a1))
+                       me))
+          ((and (has-value? a2) (has-value? sum))
+           (set-value! a1
+                       (- (get-value sum) (get-value a2))
+                       me))))
+  (define (process-forget-value)
+    (forget-value! sum me)
+    (forget-value! a1 me)
+    (forget-value! a2 me)
+    (process-new-value))
+  (define (me request)
+    (cond ((eq? request 'I-have-a-value)  
+           (process-new-value))
+          ((eq? request 'I-lost-my-value) 
+           (process-forget-value))
+          (else 
+           (error "Unknown request -- ADDER" request))))
+  (connect a1 me)
+  (connect a2 me)
+  (connect sum me)
+  me)
+
+(define (multiplier m1 m2 product)
+  (define (process-new-value)
+    (cond ((or (and (has-value? m1) (= (get-value m1) 0))
+               (and (has-value? m2) (= (get-value m2) 0)))
+           (set-value! product 0 me))
+          ((and (has-value? m1) (has-value? m2))
+           (set-value! product
+                       (* (get-value m1) (get-value m2))
+                       me))
+          ((and (has-value? product) (has-value? m1))
+           (set-value! m2
+                       (/ (get-value product) (get-value m1))
+                       me))
+          ((and (has-value? product) (has-value? m2))
+           (set-value! m1
+                       (/ (get-value product) (get-value m2))
+                       me))))
+  (define (process-forget-value)
+    (forget-value! product me)
+    (forget-value! m1 me)
+    (forget-value! m2 me)
+    (process-new-value))
+  (define (me request)
+    (cond ((eq? request 'I-have-a-value)
+           (process-new-value))
+          ((eq? request 'I-lost-my-value)
+           (process-forget-value))
+          (else
+           (error "Unknown request -- MULTIPLIER" request))))
+  (connect m1 me)
+  (connect m2 me)
+  (connect product me)
+  me)
+
+(define (constant value connector)
+  (define (me request)
+    (error "Unknown request -- CONSTANT" request))
+  (connect connector me)
+  (set-value! connector value me)
+  me)
+
+(define (probe name connector)
+  (define (print-probe value)
+    (newline)
+    (display "Probe: ")
+    (display name)
+    (display " = ")
+    (display value))
+  (define (process-new-value)
+    (print-probe (get-value connector)))
+  (define (process-forget-value)
+    (print-probe "?"))
+  (define (me request)
+    (cond ((eq? request 'I-have-a-value)
+           (process-new-value))
+          ((eq? request 'I-lost-my-value)
+           (process-forget-value))
+          (else
+           (error "Unknown request -- PROBE" request))))
+  (connect connector me)
+  me)
+
+(define (inform-about-value constraint)
+  (constraint 'I-have-a-value))
+(define (inform-about-no-value constraint)
+  (constraint 'I-lost-my-value))
+
+(define (make-connector)
+  (let ((value #f) (informant #f) (constraints '()))
+    (define (set-my-value newval setter)
+      (cond ((not (has-value? me))
+             (set! value newval)
+             (set! informant setter)
+             (for-each-except setter
+                              inform-about-value
+                              constraints))
+            ((not (= value newval))
+             (error "Contradiction" (list value newval)))
+            (else 'ignored)))
+    (define (forget-my-value retractor)
+      (if (eq? retractor informant)
+          (begin (set! informant false)
+                 (for-each-except retractor
+                                  inform-about-no-value
+                                  constraints))
+          'ignored))
+    (define (connect new-constraint)
+      (when (not (memq new-constraint constraints))
+          (set! constraints 
+                (cons new-constraint constraints)))
+      (when (has-value? me)
+          (inform-about-value new-constraint))
+      'done)
+    (define (me request)
+      (cond ((eq? request 'has-value?)
+             (if informant #t #f))
+            ((eq? request 'value) value)
+            ((eq? request 'set-value!) set-my-value)
+            ((eq? request 'forget) forget-my-value)
+            ((eq? request 'connect) connect)
+            (else (error "Unknown operation -- CONNECTOR"
+                         request))))
+    me))
+
+(define (for-each-except exception procedure list)
+  (define (loop items)
+    (cond ((null? items) 'done)
+          ((eq? (car items) exception) (loop (cdr items)))
+          (else (procedure (car items))
+                (loop (cdr items)))))
+  (loop list))
+
+(define (has-value? connector)
+  (connector 'has-value?))
+(define (get-value connector)
+  (connector 'value))
+(define (set-value! connector new-value informant)
+  ((connector 'set-value!) new-value informant))
+(define (forget-value! connector retractor)
+  ((connector 'forget) retractor))
+(define (connect connector new-constraint)
+  ((connector 'connect) new-constraint))
+
+;; averager
+(define (averager a b c)
+  (let ((u (make-connector))
+        (v (make-connector)))
+    (adder a b u)
+    (constant 0.5 v)
+    (multiplier u v c)))
+
+;; averager
+(define a (make-connector))
+(define b (make-connector))
+(define c (make-connector))
+
+(averager a b c)
+
+(probe "input 1" a)
+(probe "input 2" b)
+(probe "average" c)
+
+(define d (make-connector))
+(define e (make-connector))
+
+(define (squarer a b)
+  (multiplier a a b))
+
+(squarer d e)
+(probe "input to the squarer" d)
+(probe "squarer output" e)
diff --git a/src/sicp/ex3_34.rkt b/src/sicp/ex3_34.rkt
new file mode 100644
index 0000000..ea29802
--- /dev/null
+++ b/src/sicp/ex3_34.rkt
@@ -0,0 +1,28 @@
+#lang racket
+
+#|
+
+If Louis Reasoner implements the squarer with a multiplier, like this:
+
+(define (squarer a b)
+  (multiplier a a b))
+
+let us see how we will use it.
+
+(define a (make-connector))
+(define b (make-connector))
+
+(set-value! a 10 'user)
+
+At this point, we expect b to have the value 100. Indeed it is. Now, instead
+we set the value of b to be 400. But multiplier needs two values to operate.
+We have set only b. So, the contraint never propagates to a. Here is the
+output of a repl session:
+
+> (set-value! e 400 'user)
+
+Probe: squarer output = 400
+'done
+> 
+
+|#
\ No newline at end of file
diff --git a/src/sicp/ex3_35.rkt b/src/sicp/ex3_35.rkt
new file mode 100644
index 0000000..3e704c5
--- /dev/null
+++ b/src/sicp/ex3_35.rkt
@@ -0,0 +1,191 @@
+#lang racket
+
+;; implementation
+(define (adder a1 a2 sum)
+  (define (process-new-value)
+    (cond ((and (has-value? a1) (has-value? a2))
+           (set-value! sum
+                       (+ (get-value a1) (get-value a2))
+                       me))
+          ((and (has-value? a1) (has-value? sum))
+           (set-value! a2
+                       (- (get-value sum) (get-value a1))
+                       me))
+          ((and (has-value? a2) (has-value? sum))
+           (set-value! a1
+                       (- (get-value sum) (get-value a2))
+                       me))))
+  (define (process-forget-value)
+    (forget-value! sum me)
+    (forget-value! a1 me)
+    (forget-value! a2 me)
+    (process-new-value))
+  (define (me request)
+    (cond ((eq? request 'I-have-a-value)  
+           (process-new-value))
+          ((eq? request 'I-lost-my-value) 
+           (process-forget-value))
+          (else 
+           (error "Unknown request -- ADDER" request))))
+  (connect a1 me)
+  (connect a2 me)
+  (connect sum me)
+  me)
+
+(define (multiplier m1 m2 product)
+  (define (process-new-value)
+    (cond ((or (and (has-value? m1) (= (get-value m1) 0))
+               (and (has-value? m2) (= (get-value m2) 0)))
+           (set-value! product 0 me))
+          ((and (has-value? m1) (has-value? m2))
+           (set-value! product
+                       (* (get-value m1) (get-value m2))
+                       me))
+          ((and (has-value? product) (has-value? m1))
+           (set-value! m2
+                       (/ (get-value product) (get-value m1))
+                       me))
+          ((and (has-value? product) (has-value? m2))
+           (set-value! m1
+                       (/ (get-value product) (get-value m2))
+                       me))))
+  (define (process-forget-value)
+    (forget-value! product me)
+    (forget-value! m1 me)
+    (forget-value! m2 me)
+    (process-new-value))
+  (define (me request)
+    (cond ((eq? request 'I-have-a-value)
+           (process-new-value))
+          ((eq? request 'I-lost-my-value)
+           (process-forget-value))
+          (else
+           (error "Unknown request -- MULTIPLIER" request))))
+  (connect m1 me)
+  (connect m2 me)
+  (connect product me)
+  me)
+
+(define (constant value connector)
+  (define (me request)
+    (error "Unknown request -- CONSTANT" request))
+  (connect connector me)
+  (set-value! connector value me)
+  me)
+
+(define (probe name connector)
+  (define (print-probe value)
+    (newline)
+    (display "Probe: ")
+    (display name)
+    (display " = ")
+    (display value))
+  (define (process-new-value)
+    (print-probe (get-value connector)))
+  (define (process-forget-value)
+    (print-probe "?"))
+  (define (me request)
+    (cond ((eq? request 'I-have-a-value)
+           (process-new-value))
+          ((eq? request 'I-lost-my-value)
+           (process-forget-value))
+          (else
+           (error "Unknown request -- PROBE" request))))
+  (connect connector me)
+  me)
+
+(define (inform-about-value constraint)
+  (constraint 'I-have-a-value))
+(define (inform-about-no-value constraint)
+  (constraint 'I-lost-my-value))
+
+(define (make-connector)
+  (let ((value false) (informant #f) (constraints '()))
+    (define (set-my-value newval setter)
+      (cond ((not (has-value? me))
+             (set! value newval)
+             (set! informant setter)
+             (for-each-except setter
+                              inform-about-value
+                              constraints))
+            ((not (= value newval))
+             (error "Contradiction" (list value newval)))
+            (else 'ignored)))
+    (define (forget-my-value retractor)
+      (if (eq? retractor informant)
+          (begin (set! informant false)
+                 (for-each-except retractor
+                                  inform-about-no-value
+                                  constraints))
+          'ignored))
+    (define (connect new-constraint)
+      (when (not (memq new-constraint constraints))
+          (set! constraints 
+                (cons new-constraint constraints)))
+      (when (has-value? me)
+          (inform-about-value new-constraint))
+      'done)
+    (define (me request)
+      (cond ((eq? request 'has-value?)
+             (if informant #t #f))
+            ((eq? request 'value) value)
+            ((eq? request 'set-value!) set-my-value)
+            ((eq? request 'forget) forget-my-value)
+            ((eq? request 'connect) connect)
+            (else (error "Unknown operation -- CONNECTOR"
+                         request))))
+    me))
+
+(define (for-each-except exception procedure list)
+  (define (loop items)
+    (cond ((null? items) 'done)
+          ((eq? (car items) exception) (loop (cdr items)))
+          (else (procedure (car items))
+                (loop (cdr items)))))
+  (loop list))
+
+(define (has-value? connector)
+  (connector 'has-value?))
+(define (get-value connector)
+  (connector 'value))
+(define (set-value! connector new-value informant)
+  ((connector 'set-value!) new-value informant))
+(define (forget-value! connector retractor)
+  ((connector 'forget) retractor))
+(define (connect connector new-constraint)
+  ((connector 'connect) new-constraint))
+
+(define (squarer a b)
+  (define (process-new-value)
+    (if (has-value? b)
+        (if (< (get-value b) 0)
+            (error "square less than 0 -- SQUARER" (get-value b))
+            (set-value! a
+                        (sqrt (get-value b))
+                        me))
+        (when (has-value? a)
+          (set-value! b 
+                      (* (get-value a) (get-value a)) 
+                      me))))
+  (define (process-forget-value)
+    (forget-value! b me)
+    (forget-value! a me)
+    (process-new-value))
+  (define (me request)
+    (cond ((eq? request 'I-have-a-value)  
+           (process-new-value))
+          ((eq? request 'I-lost-my-value) 
+           (process-forget-value))
+          (else 
+           (error "Unknown request -- SQUARER" request))))
+  (connect a me)
+  (connect b me)
+  me)
+
+(define d (make-connector))
+(define e (make-connector))
+
+(squarer d e)
+
+(probe "input to the squarer" d)
+(probe "squarer output" e)
\ No newline at end of file
diff --git a/src/sicp/ex3_37.rkt b/src/sicp/ex3_37.rkt
new file mode 100644
index 0000000..02965b4
--- /dev/null
+++ b/src/sicp/ex3_37.rkt
@@ -0,0 +1,23 @@
+#lang racket
+
+(define (celsius-fahrenheit-converter x)
+  (c+ (c* (c/ (cv 9) (cv 5))
+          x)
+      (cv 32)))
+(define C (make-connector))
+(define F (celsius-fahrenheit-converter C))
+
+(define (c+ a b)
+  (let ((c (make-connector)))
+    (adder a b c)
+    c))
+
+(define (c* x y)
+  (let ((z (make-connector)))
+    (multiplier x y z)
+    z))
+
+(define (cv v)
+  (let ((z (make-connector)))
+    (constant z v)
+    z))