From: Ramakrishnan Muthukrishnan 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/about.html?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))