sol to most ch4 exercises

I had done these exercises while I followed SICP about 1.5 years back, couldn't find time to blog them individually.. so just committed them to google code. They can be found here.

Ex: 3.53 - 3.62

;some code from book
(define (stream-enumerate-interval low high)
 (if (> low high)
     the-empty-stream
     (cons-stream
      low
      (stream-enumerate-interval (+ low 1) high))))
(define (display-stream s)
 (stream-for-each display-line s))
(define (display-line x)
 (newline)
 (display x))
(define (add-streams s1 s2)
 (stream-map + s1 s2))
(define (integers-starting-from n)
 (cons-stream n (integers-starting-from (+ n 1))))
(define integers (integers-starting-from 1))
(define (scale-stream stream factor)
 (stream-map (lambda (x) (* x factor)) stream))

Ex 3.53
Given definition defines a stream whose first term is 1, and next terms are calculated by adding previous term to itself. So the resulting stream is..
1,2,4,8,16...
Lets Verify...

(define s (cons-stream 1 (add-streams s s)))
1 ]=> (stream-ref s 0)
;Value: 1
1 ]=> (stream-ref s 1)
;Value: 2
1 ]=> (stream-ref s 2)
;Value: 4
1 ]=> (stream-ref s 3)
;Value: 8
1 ]=> (stream-ref s 4)
;Value: 16
1 ]=> (stream-ref s 5)
;Value: 32

Ex - 3.54

(define (mul-streams s1 s2)
 (stream-map * s1 s2))
(define factorials (cons-stream 1 (mul-streams integers factorials)))

Ex-3.55
Partial-sums of a stream is a stream whose first term is that of the input stream and next terms are calculated by adding next term of the input stream and previous term of the Partial-sums of the stream.

(define (partial-sums s)
 (cons-stream (stream-car s)
              (add-streams (stream-cdr s) (partial-sums s))))

;Verify
(define s (partial-sums integers))
1 ]=> (stream-ref s 0)
;Value: 1
1 ]=> (stream-ref s 1)
;Value: 3
1 ]=> (stream-ref s 2)
;Value: 6
1 ]=> (stream-ref s 3)
;Value: 10
1 ]=> (stream-ref s 4)
;Value: 15
1 ]=> (stream-ref s 5)
;Value: 21

Ex-3.56

(define (merge s1 s2)
 (cond ((stream-null? s1) s2)
       ((stream-null? s2) s1)
       (else
        (let ((s1car (stream-car s1))
   (s2car (stream-car s2)))
(cond ((<> s1car s2car)
      (cons-stream s2car (merge s1 (stream-cdr s2))))
     (else
      (cons-stream s1car
                   (merge (stream-cdr s1)
                          (stream-cdr s2)))))))))
(define S (cons-stream 1 (merge
                         (merge (scale-stream s 2) (scale-stream s 3))
                         (scale-stream s 5))))

Ex-3.57



Ex-3.58
first element is (quotient (* num radix) den)
and next elements are calculated recursively from
num = (remainder (* num radix) den) with same radix and den.

(define (expand num den radix)
 (cons-stream
  (quotient (* num radix) den)
  (expand (remainder (* num radix) den) den radix)))

(expand 1 7 10) should be
1 4 2 8 5 7....

;From the interpreter
1 ]=> (define s (expand 1 7 10))
;Value: s
1 ]=> (stream-ref s 0)
;Value: 1
1 ]=> (stream-ref s 1)
;Value: 4
1 ]=> (stream-ref s 2)
;Value: 2
1 ]=> (stream-ref s 3)
;Value: 8
1 ]=> (stream-ref s 4)
;Value: 5

Ex-3.59

;(a)
;inverted-integers = 1 1/2 1/3 1/4........
(define inverted-integers (stream-map (lambda (x) (/ 1 x)) integers))
(define (integrate-series s)
 (mul-streams s inverted-integers))

;(b)
(define cosine-series
 (cons-stream 1 (integrate-series (stream-map (lambda (x) (- x)) sine-series))))
(define sine-series
 (cons-stream 0 (integrate-series cosine-series)))

Ex-3.60

(define (mul-series s1 s2)
 (cons-stream (* (stream-car s1) (stream-car s2))
              (add-streams
               (scale-stream (stream-cdr s1) (stream-car s2))
               (mul-series s1 (stream-cdr s2)))))

(define one (add-streams
            (mul-series sine-series sine-series)
            (mul-series cosine-series cosine-series)))

;verification, only constant term is 1
;rest all is 0
1 ]=> (stream-ref one 0)
;Value: 1
1 ]=> (stream-ref one 1)
;Value: 0
1 ]=> (stream-ref one 2)
;Value: 0
1 ]=> (stream-ref one 3)
;Value: 0
1 ]=> (stream-ref one 4)
;Value: 0
1 ]=> (stream-ref one 5)
;Value: 0

Ex-3.61

(define (invert-unit-series s)
 (cons-stream 1
              (stream-map (lambda (x) (- x))
                          (mul-series
                           (stream-cdr s)
                           (invert-unit-series s)))))

;Test
;secX = 1/cosX
(define sec-series (invert-unit-series cosine-series))
1 ]=> (stream-ref cosec-series 0)
;Value: 1
1 ]=> (stream-ref cosec-series 1)
;Value: 0
1 ]=> (stream-ref cosec-series 2)
;Value: 1/2
1 ]=> (stream-ref cosec-series 3)
;Value: 0
1 ]=> (stream-ref cosec-series 4)
;Value: 5/24
1 ]=> (stream-ref cosec-series 6)
;Value: 61/720
1 ]=> (stream-ref cosec-series 8)
;Value: 277/8064

Ex-3.62

;one-zeros = 1 0 0 0 0 0........
(define zeros (cons-stream 0 zeros))
(define one-zeros
 (cons-stream 1 zeros))

;s1/s2 = s1.(1/s2)
;we'll have to bring out the constant term from s2 so as
;to make the constant term 1
(define (div-series s1 s2)
              (scale-stream
               (mul-series s1
                           (invert-unit-series
                            (scale-stream s2 (/ 1 (stream-car s2)))))
               (/ (stream-car s2))))
              
;tanX = sinX/cosX
(define tangent-series
 (div-series sine-series cosine-series))

1 ]=> (stream-ref tangent-series 0)
;Value: 0
1 ]=> (stream-ref tangent-series 1)
;Value: 1
1 ]=> (stream-ref tangent-series 2)
;Value: 0
1 ]=> (stream-ref tangent-series 3)
;Value: 1/3
1 ]=> (stream-ref tangent-series 4)
;Value: 0
1 ]=> (stream-ref tangent-series 5)
;Value: 2/15
1 ]=> (stream-ref tangent-series 7)
;Value: 17/315
1 ]=> (stream-ref tangent-series 9)
;Value: 62/2835
1 ]=> (stream-ref tangent-series 11)
;Value: 1382/155925

Ex-3.50 - 3.52

Some code from book to execute the solutions..

(define (stream-enumerate-interval low high)
 (if (> low high)
     the-empty-stream
     (cons-stream
      low
      (stream-enumerate-interval (+ low 1) high))))

(define (stream-ref s n)
 (if (= n 0)
     (stream-car s)
     (stream-ref (stream-cdr s) (- n 1))))

(define (display-stream s)
 (stream-for-each display-line s))
(define (display-line x)
 (newline)
 (display x))

Ex 3.50

(define (stream-map proc . argstreams)
 (if (stream-null? (car argstreams))
     the-empty-stream
     (cons-stream
      (apply proc (map stream-car argstreams))
      (apply stream-map
             (cons proc (map stream-cdr argstreams))))))

;Test
(define s1 (cons-stream 1 (cons-stream 2 the-empty-stream)))
(define s2 (cons-stream 1 (cons-stream 2 the-empty-stream)))
(define s3 (stream-map + s1 s2))
s3 ;Value 12: (2 . #[promise 13])
(display-stream s3) ;(2,4)

Ex-3.51

(define (show x)
 (display-line x)
 x)
(define x (stream-map show (stream-enumerate-interval 0 10)))
(stream-ref x 5)
(stream-ref x 7)

;Results Printed
1 ]=> (stream-ref x 5)

1
2
3
4
5
;Value: 5

1 ]=> (stream-ref x 7)

6
7
;Value: 7

Explaination: (stream-ref x 5) printed 1,2,3,4,5 because all the show calls were done after calling it and memoized values are stored and hence (stream-ref x 7) just displays 6,7

Ex-3.52

(define sum 0)
;sum = 0

(define (accum x)
 (set! sum (+ x sum))
 sum)
;sum = 0

(define seq (stream-map accum (stream-enumerate-interval 1 20)))
;sum = 1 , only one call to accum is evaluated to get first element of seq

(define y (stream-filter even? seq))
;sum = 6 ; only calls to accum are evaluated to get first element even element in seq  which is 6

(define z (stream-filter (lambda (x) (= (remainder x 5) 0))
                        seq))
;sum = 10 , only calls to accum are evaluated to get first element in seq that is divisible by 5

(stream-ref y 7)
;Value: 136
;sum = 136 ,only calls to accum upto calculating 7th element in y are evaluated

(display-stream z)
;(10 15 45 55 105 120 190 210)
;sum = 210 ,all the calls are evaluated

No, If we do not use memoization then these results will not stay the same as same accum calls will be evaluated multiple times and hence modifying sum multiple times for the same accum calls.

Ex-3.47

A mutex is an object that supports two operations - aquire and release. Once a mutex is aquired, no other process can aquire it unless it has been released. mutex is implemented using an *atomic* operation test-and-set! that tests value in a cell, returns true if cell value is already set to true or else sets the cell value to true and returns false.

A semaphore (of size n) is a generalization of a mutex. Like a mutex, a semaphore supports acquire and release operations, but it is more general in that up to n processes can acquire it concurrently. Additional processes that attempt to acquire the semaphore must wait for release operations.

(a) - semaphore implementation using mutex

(define (make-semaphore n)
(let ((m (make-mutex))
   (count 0)
   (result false))
(define (aquire)
 (m 'aquire)
 (if (> count 0)
     (set! count (- count 1)))
 (m 'release))
(define (dispatch msg)
 (cond
  ((eq? msg 'aquire) (aquire))
  ((eq? msg 'release) (release))
  (else "Unknown msg to SEMAPHORE: " msg)))
dispatch))

(b) - semaphore implementation using test-and-set

(define (clear! cell)
(set-car! cell false))

(define (make-semaphore n)
;makes a list of n cells
(define (make-cells n)
  (define (iter n a)
    (if (= n 0) a
        (iter (- n 1) (cons (list false) a))))
  (iter n '()))

(let ((cells (make-cells n)))
  (define (aquire)
    (define (iter cells)
      (cond
       ((null? cells) (aquire))
       ((not (test-and-set! (car cells)))
        true)
       (else (iter (cdr cells)))))
    (iter cells))
  (define (release)
    (define (iter cells)
      (cond
       ((null? cells)
        ;all the cells are already in released state
        ;nothing to do
        'ok)
       ((caar cells)
        (clear! (car cells)) 'ok)
       (else (iter (cdr cells)))))
    (iter cells))
  (define (dispatch msg)
    (cond
     ((eq? msg 'aquire) (aquire))
     ((eq? msg 'release) (release))
     (else "Unknown msg to SEMAPHORE: " msg)))
  dispatch))

Ex-3.46

Let say 2 processes try to aquire the mutex simultaneously when its in released state

(define (test-and-set! cell)
  (if (car cell)
      true
      (begin (set-car! cell true)
             false)))

Let P1 denote the event of first process calling (car cell) and P2 denote the event of first process calling (set-car! cell true). Similarly let Q1 denote the event of second process calling (car cell) and Q2 denote the event of second process calling (set-car! cell true).

Since test-and-set! is not atomic, so following interleaved execution sequence is possible...

P1 Q1 P2 Q2

With this sequence both the processes will aquire the mutex and mutex symantics that only one can aquire it at one time is broken.

Serializer Implementation..

Serializer is implemented in terms of another primitive called "mutex", that has two operations to "aquire" and "release" it. At one time only one process can aquire the mutex, other processes trying to aquire it at that time will block untill the mutex is released by the process that has the mutex aquired.
BTW, if multiple processes were waiting for the mutex to be released.. which of those processes get to aquire the mutex depends upon a component called scheduler.

Ex-3.45

There will be a deadlock. Here is why...

(serialized-exchange account1 account2)
...
...
(serializer1 (serializer2 exchange) account1 account2)
...
Notice, call to exchange is serialized in both the
serializers, so they won't let any other serialized
procedure run unless this call completes.

exchange makes following call..
(- (account1 'balance) (account2 'balance))
...
(account1 'balance)
This is a serialized call with the given code in the 
problem and will be blocked because serializer1 is still 
waiting for exchange call to complete.

Ex-3.44

No, given implementation of transfer is fine. Its different from exchange because in exchange, difference between the balance of two accounts is calculated without any serialization constraints and transfer doesn't have it.

Ex-3.42

It is safe and there is no difference.

Ex-3.41

No, checking the balance is a read-only operation and doesn't result in any anomalous behavior even when unserialized. Serializing it will just hamper the performance for no good.

Ex-3.40

(define x 10)
(parallel-execute (lambda () (set! x (* x x)))
                  (lambda () (set! x (* x x x))))

Let P, Q represent both procedures and Pk/Qk denotes accessing value of x the kth time then following possibilities are possible..

x = 1000000: P1, P2, P sets x, Q1, Q2, Q3, Q sets x
x = 1000000: Q1, Q2, Q3, Q sets x, P1, P2, P sets x
x = 10000: P1, Q1, Q2, Q3, Q sets x, P2, P sets x
x = 100: P1, P2, Q1, Q2, Q3, Q sets x, P sets x
x = 100000: Q1, P1, P2 ,P sets x, Q2, Q3, Q sets x
x = 10000: Q1, Q2, P1, P2, P sets x, Q3, Q sets x
x = 1000: Q1, Q2, Q3, P1, P2, P sets X, Q sets x

.... There are other execution sequences possible also, but all the possible values that x can take after the execution are {100, 1000, 10000, 100000, 1000000}

In the next case when P, Q are serialized. After the execution, x can only be 1000000.

In general, This phenomenon when multiple threads/processes are modifying the same resource and final value of the resource could be different depending upon the interleaving is called "Race Condition"

Ex-3.39

Following 3 possibilities remain..

101: P1 sets x to 100 and then P2 increments x to 101.
121: P2 increments x to 11 and then P1 sets x to x times x.
100: P1 accesses x (twice), then P2 sets x to 11, then P1 sets x.

Ex-3.38

;Ex-3.38 a
Without interleaving there are 6(Fact(3) ways in which they can do their transactions) cases possible.

1. Peter, Paul, Mary .. balance: $45
2. Paul, Peter, Mary .. balance: $45
3. Peter, Mary, Paul .. balance: $35
4. Paul, Mary, Peter .. balance: $50
5. Mary, Peter, Paul .. balance: $40
6. Mary, Paul, Peter .. balance: $40

;Ex-3.38b
deposit/withdraw of Peter/Paul can be divided in 2 steps
(set! balance (+/ balance amt))
1. Access the current balance
2. Calculating (+/- balance amt) and setting balance to the calculated value.

Let us denote these 2 steps for both person's transactions as Peter-1, Peter-2, and Paul-1, Paul-2.

withdraw of Mary can be divided in 3 steps
(set! balance (- balance (/ balance 2)))
Mary-1: Access the balance for calculating (/ balance 2)
Mary-2: Access the balance for calculating (- balance (/..
Mary-3: Setting balance to value calculated in step Mary-2


One of the possible execution sequence could be....

Peter-1 Paul-1 Mary-1 Peter-2 Paul-2 Mary-2 Mary-3

..with this sequence the final balance would be... $30

Ex-3.35

code from book for constraint network.

(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))
        (if (has-value? a)
            (set-value! b (square (get-value a)) me))))
  (define (process-forget-value)
    (forget-value! a me)
    (forget-value! b 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)

;;tests
(define A (make-connector))
(define B (make-connector))
(probe "A" A)
(probe "B" B)

(squarer A B)

(set-value! A 3 'user)
;Probe: B = 9
;Probe: A = 3
;Value: done

(forget-value! A 'user)
;Probe: B = ?
;Probe: A = ?
;Value: done

(set-value! B 25 'user)
;Probe: A = 5
;Probe: B = 25
;Value: done 

Ex-3.34

code from book for constraint network.

;;Lets Experiment
(define (squarer a b)
 (multiplier a a b))
(define A (make-connector))
(define B (make-connector))
(Probe "A" A)
(Probe "B" B)
(squarer a b)

(set-value! A 5 'user)
;Probe: A = 5
;Probe: B = 25
;Value: done

(forget-value! A 'user)
;Probe: A = ?
;Probe: B = ?
;Value: done

(set-value! B 16 'user)
;Probe: B = 16
;Value: done 

Case-I: Setting value in A ,B doesn't have a value yet.
It works - No issue.

Case-II: Setting value in B, A doesn't have a value yet.
It does *NOT* work.
Reason:
On setting the value in B, when multiplier will be informed about value.. no cond clause are applicable because two of the three connectors does not have any value(as two connectors are same) and the call is simply ignored.

Ex-3.33

code from book for constraint network.

(define (averager a1 a2 av)
(define (process-new-value)
  (cond ((and (has-value? a1) (has-value? a2))
         (set-value! av
                     (/
                      (+ (get-value a1) (get-value a2))
                      2) me))
        ((and (has-value? a1) (has-value? av))
         (set-value! a2
                     (- (* 2 (get-value av)) (get-value a1))
                     me))
        ((and (has-value? a2) (has-value? av))
         (set-value! a1
                     (- (* 2 (get-value av)) (get-value a2))
                     me))))
(define (process-forget-value)
  (forget-value! av 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 -- AVERAGER" request))))
(connect a1 me)
(connect a2 me)
(connect av me)
me)

;;Test
(define A (make-connector))
(define B (make-connector))
(define C (make-connector))
(probe "A" A)
(probe "B" B)
(probe "C" C)
(averager A B C)

(set-value! A 2 'user)
;Probe: A = 2
;Value: done
(set-value! B 4 'user)
;Probe: C = 3
;Probe: B = 4
;Value: done
(forget-value! A 'user)
;Probe: C = ?
;Probe: A = ?
;Value: done
(set-value! C 8 'user)
;Probe: A = 12
;Probe: C = 8
;Value: done
(forget-value! B 'user)
;Probe: A = ?
;Probe: B = ?
;Value: done
(forget-value! C 'user)
;Probe: C = ?
;Value: done
(set-value! A 4 'user)
;Probe: A = 4
;Value: done
(ser-value! C 10 'user)
;Probe: B = 16
;Probe: C = 10
;Value: done

section-3.3.5 Propagation of Constraint code

Just pasting the code for Constraint Networks from book here to run and interact with it...

;;========CONNECTOR============
;;connector implementation
(define (make-connector)
  (let ((value false) (informant false) (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)
      (if (not (memq new-constraint constraints))
          (set! constraints
                (cons new-constraint constraints)))
      (if (has-value? me)
          (inform-about-value new-constraint))
      'done)
    (define (me request)
      (cond ((eq? request 'has-value?)
             (if informant true false))
            ((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))

;;connector interface
(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))

;;==========CONSTRAINTS================

;;generic constraint interface
(define (inform-about-value constraint)
  (constraint 'I-have-a-value))
(define (inform-about-no-value constraint)
  (constraint 'I-lost-my-value))

;;adder constraint 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)

;;multiplier constraint implementation
(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)

;;constant constraint implementation
(define (constant value connector)
  (define (me request)
    (error "Unknown request -- CONSTANT" request))
  (connect connector me)
  (set-value! connector value me)
  me)



;; Probe
(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)

;;====== 9C = 5(F - 32) Relation Simulation ========
(define (celsius-fahrenheit-converter c f)
  (let ((u (make-connector))
        (v (make-connector))
        (w (make-connector))
        (x (make-connector))
        (y (make-connector)))
    (multiplier c w u)
    (multiplier v x u)
    (adder v y f)
    (constant 9 w)
    (constant 5 x)
    (constant 32 y)
    'ok))

(define C (make-connector))
(define F (make-connector))
(probe "Celsius temp" C)
(probe "Fahrenheit temp" F)

(celsius-fahrenheit-converter C F)
(set-value! C 25 'user)
;Probe: Celsius temp = 25
;Probe: Fahrenheit temp = 77
;done

(set-value! F 212 'user)
;Error! Contradiction (77 212)

(forget-value! C 'user)
;Probe: Celsius temp = ?
;Probe: Fahrenheit temp = ?
;done

(set-value! F 212 'user)
;Probe: Fahrenheit temp = 212
;Probe: Celsius temp = 100
;done

event-driven simulation

In section 3.3.4, SICP presents a digital circuit simulator that implements it using a design called event-driven programming. In such designs basically actions("events") triggers further events that happen at a later time and those in turn trigger further events and so on.
To be particular about the example given in the book, Wire is the main object where we can set signal and can add any number of events(no-arg procedures). Whenever a signal changes(event of signal change happens), it triggers all the events added to it and those events when happen change signal on other wires which in turn trigger more events and so on... that is how the signal propagates.

I also wrote a port of this example in scala here.

functions and relations

Usually, we create programs that do one directional computations, which performs operations on given quantities to produce desired output. In some models, we don't have such one directional operations but we know the relation among quantities like the relation between celsius and fahrenheit, 9C = 5(F - 32). Translating this equation into a traditional computer language will force us to calculate one in terms of another instead of specifying the relation and measuring one when other changes. Programming paradigm where we can specify relations is called logic programming.

Ex-3.28 - 3.32

Some code from the book that is needed to run the various solutions..

;queue impl
(define (front-ptr queue) (car queue))
(define (rear-ptr queue) (cdr queue))
(define (set-front-ptr! queue item) (set-car! queue item))
(define (set-rear-ptr! queue item) (set-cdr! queue item))
(define (empty-queue? queue) (null? (front-ptr queue)))
(define (make-queue) (cons '() '()))
(define (front-queue queue)
  (if (empty-queue? queue)
      (error "FRONT called with an empty queue" queue)
      (car (front-ptr queue))))
(define (insert-queue! queue item)
  (let ((new-pair (cons item '())))
    (cond ((empty-queue? queue)
           (set-front-ptr! queue new-pair)
           (set-rear-ptr! queue new-pair)
           queue)
          (else
           (set-cdr! (rear-ptr queue) new-pair)
           (set-rear-ptr! queue new-pair)
           queue))))
(define (delete-queue! queue)
  (cond ((empty-queue? queue)
         (error "DELETE! called with an empty queue" queue))
        (else
         (set-front-ptr! queue (cdr (front-ptr queue)))
         queue)))

;agenda
(define (make-time-segment time queue)
  (cons time queue))
(define (segment-time s) (car s))
(define (segment-queue s) (cdr s))
(define (make-agenda) (list 0))
(define (current-time agenda) (car agenda))
(define (set-current-time! agenda time)
  (set-car! agenda time))
(define (segments agenda) (cdr agenda))
(define (set-segments! agenda segments)
  (set-cdr! agenda segments))
(define (first-segment agenda) (car (segments agenda)))
(define (rest-segments agenda) (cdr (segments agenda)))
(define (empty-agenda? agenda)
  (null? (segments agenda)))
(define (add-to-agenda! time action agenda)
  (define (belongs-before? segments)
    (or (null? segments)
        (< time (segment-time (car segments)))))
  (define (make-new-time-segment time action)
    (let ((q (make-queue)))
      (insert-queue! q action)
      (make-time-segment time q)))
  (define (add-to-segments! segments)
    (if (= (segment-time (car segments)) time)
        (insert-queue! (segment-queue (car segments))
                         action)
        (let ((rest (cdr segments)))
          (if (belongs-before? rest)
              (set-cdr!
                segments
                (cons (make-new-time-segment time action)
                      (cdr segments)))
              (add-to-segments! rest)))))
  (let ((segments (segments agenda)))
    (if (belongs-before? segments)
        (set-segments!
         agenda
         (cons (make-new-time-segment time action)
                segments))
        (add-to-segments! segments))))
(define (remove-first-agenda-item! agenda)
  (let ((q (segment-queue (first-segment agenda))))
    (delete-queue! q)
    (if (empty-queue? q)
        (set-segments! agenda (rest-segments agenda)))))
(define (first-agenda-item agenda)
  (if (empty-agenda? agenda)
      (error "Agenda is empty -- FIRST-AGENDA-ITEM")
      (let ((first-seg (first-segment agenda)))
        (set-current-time! agenda (segment-time first-seg))
        (front-queue (segment-queue first-seg)))))

(define the-agenda (make-agenda))
(define (after-delay delay action)
  (add-to-agenda! (+ delay (current-time the-agenda))
                  action
                  the-agenda))
(define (propagate)
  (if (empty-agenda? the-agenda)
      'done
      (let ((first-item (first-agenda-item the-agenda)))
        (first-item)
        (remove-first-agenda-item! the-agenda)
        (propagate))))
;wire
(define (make-wire)
  (let ((signal-value 0) (action-procedures '()))
    (define (set-my-signal! new-value)
      (if (not (= signal-value new-value))
          (begin (set! signal-value new-value)
                  (call-each action-procedures))
          'done))
    (define (accept-action-procedure! proc)
      (set! action-procedures (cons proc action-procedures))
      (proc))
    (define (dispatch m)
      (cond ((eq? m 'get-signal) signal-value)
            ((eq? m 'set-signal!) set-my-signal!)
            ((eq? m 'add-action!) accept-action-procedure!)
            (else (error "Unknown operation -- WIRE" m))))
    dispatch))
(define (call-each procedures)
  (if (null? procedures)
      'done
      (begin
        ((car procedures))
        (call-each (cdr procedures)))))
(define (get-signal wire)
  (wire 'get-signal))
(define (set-signal! wire new-value)
  ((wire 'set-signal!) new-value))
(define (add-action! wire action-procedure)
  ((wire 'add-action!) action-procedure))

;adders
(define (half-adder a b s c)
  (let ((d (make-wire)) (e (make-wire)))
    (or-gate a b d)
    (and-gate a b c)
    (inverter c e)
    (and-gate d e s)
    'ok))
(define (full-adder a b c-in sum c-out)(let ((s (make-wire))
      (c1 (make-wire))
      (c2 (make-wire)))
  (half-adder b c-in s c1)
  (half-adder a s sum c2)
  (or-gate c1 c2 c-out)
  'ok))

;gates
(define inverter-delay 2)
(define and-gate-delay 3)
(define or-gate-delay 5)
(define (inverter input output)
  (define (invert-input)
    (let ((new-value (logical-not (get-signal input))))
       (after-delay inverter-delay
                     (lambda ()
                       (set-signal! output new-value)))))
  (add-action! input invert-input)
  'ok)
(define (logical-not s)
  (cond ((= s 0) 1)
         ((= s 1) 0)
         (else (error "Invalid signal" s))))

(define (and-gate a1 a2 output)
  (define (and-action-procedure)
    (let ((new-value
            (logical-and (get-signal a1) (get-signal a2))))
       (after-delay and-gate-delay
                    (lambda ()
                      (set-signal! output new-value)))))
  (add-action! a1 and-action-procedure)
  (add-action! a2 and-action-procedure)
  'ok)
(define (logical-and s1 s2)
  (cond ((and (= s1 1) (= s2 1)) 1)
 ((or
   (and (= s1 1) (= s2 0))
   (and (= s1 0) (= s2 0))
   (and (= s1 0) (= s2 1))) 0)
 (else (error "Invalid signal" s1 s2))))

;probe
(define (probe name wire)
  (add-action! wire
               (lambda ()
                 (newline)
                 (display name)
                 (display " ")
                 (display (current-time the-agenda))
                 (display " New-value = ")
                 (display (get-signal wire)))))

Ex-3.28

(define (or-gate a1 a2 output)
  (define (or-action-procedure)
    (let ((new-value
            (logical-or (get-signal a1) (get-signal a2))))
       (after-delay or-gate-delay
                    (lambda ()
                      (set-signal! output new-value)))))
  (add-action! a1 or-action-procedure)
  (add-action! a2 or-action-procedure)
  'ok)
(define (logical-or s1 s2)
  (cond ((and (= s1 0) (= s2 0)) 0)
 ((or
   (and (= s1 1) (= s2 0))
   (and (= s1 1) (= s2 1))
   (and (= s1 0) (= s2 1))) 1)
 (else (error "Invalid signal" s1 s2))))

;;test
> (define a (make-wire))
> (define b (make-wire))
> (define c (make-wire))
> (or-gate a b c)
ok
> (get-signal c)
0
> (set-signal! a 1)
done
> (propagate)
done
> (get-signal c)
1
> 

Ex-3.29

;A OR B  = -(-A AND -B)
(define (or-gate a1 a2 output)
  (let ((not-a1 (make-wire))
 (not-a2 (make-wire))
 (not-a1-and-not-a2 (make-wire)))
    (inverter a1 not-a1)
    (inverter a2 not-a2)
    (and-gate not-a1 not-a2 not-a1-and-not-a2)
    (inverter not-a1-and-not-a2 output)))

;delay in this case would be
;inverter-delay + and-gate-delay + inverter-delay 

Ex-3.30

(define (ripple-carry-adder Ak Bk Sk C)
  (if (not (null? Ak))
      (let ((c-in (make-wire)))
 (full-adder (car Ak) (car Bk) c-in (car Sk) C)
 (ripple-carry-adder (cdr Ak) (cdr Bk) (cdr Sk) c-in))))

;test
;adding 11 and 10, result should be 101
(define A1 (make-wire))
(define A2 (make-wire))
(define Ak (list A1 A2))
(define B1 (make-wire))
(define B2 (make-wire))
(define Bk (list B1 B2))
(define S1 (make-wire))
(define S2 (make-wire))
(define Sk (list S1 S2))
(define C (make-wire))
(ripple-carry-adder Ak Bk Sk C)

(set-signal! A1 1)
(set-signal! A2 1)
(set-signal! B1 1)
(set-signal! B2 0)
(propagate)

(get-signal C)  ;should be 1
(get-signal S1) ;should be 0 
(get-signal S2) ;should be 1 

Ex-3.31

(define (make-wire)
  (let ((signal-value 0) (action-procedures '()))
    (define (set-my-signal! new-value)
      (if (not (= signal-value new-value))
          (begin (set! signal-value new-value)
                  (call-each action-procedures))
          'done))
    (define (accept-action-procedure! proc)
      (set! action-procedures (cons proc action-procedures)))
    (define (dispatch m)
      (cond ((eq? m 'get-signal) signal-value)
            ((eq? m 'set-signal!) set-my-signal!)
            ((eq? m 'add-action!) accept-action-procedure!)
            (else (error "Unknown operation -- WIRE" m))))
    dispatch))

(define a (make-wire))
(define b (make-wire))
(define s (make-wire))
(define c (make-wire))

(probe 'a a)
(probe 'b b)
(probe 's s)
(probe 'c c)

(half-adder a b s c)

;proc run for a and b, that sets d
;proc added for a b, that sets c
;proc added for c that sets e
;proc added for d, e that set s 

The initialization is necessary so as to initialize the value of intermediate wires. As in the case of half-adder, due to initialization e gets set to 1. If the initialization calls were not there then e would remain 0 to start with and that will lead to following trouble. Let say you build the half adder circuit with above version of make-wire that doesn't call proc to start with. If you set a to 1, s would still remain 0 though it should be 1 and the reason is following. Here is what will happen when you set a to 1, following procs gets added to the agenda...

(set-signal! d (logical-or 1 0)) ;or of a and b
(set-signal! c (logical-and 1 0)) ;and of a and b

when above are executed, followings get added to the agenda

;and of d and e(NOTICE, e is 0 at this point)
(set-signal! s (logical-and 1 0)) 
(set-signal! e (logical-not 1)) ;not c and s gets set to 1 

Ex-3.32
(a1 a2) change from (0 1) to (1 0)
When signal of a1 changes from 0->1(a2 is still 1) following procedure is added to agenda
(set-signal! output (logical-and 1 1))

and then signal of a2 changes from 1->0(a1 is 1 at this time) following procedure is added to agenda
(set-signal! output (logical-and 1 0))

If above two procedure were run in the lifo order that is
(set-signal! output (logical-and 1 0))
(set-signal! output (logical-and 1 1))
then output is going to be 1, which is wrong. This is why the order is important.