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.