sicp-ex-3.38



<< Previous exercise (3.37) | Index | Next exercise (3.39) >>


a)

If no interleaving is possible the resulting values can be:

45: Peter +10; Paul -20; Mary /2

35: Peter +10; Mary /2; Paul -20

45: Paul -20; Peter +10; Mary /2

50: Paul -20; Mary /2; Peter +10

40: Mary /2; Peter +10; Paul -20

40: Mary /2; Paul -20; Peter +10

b) There are 9!/(3!3!3!)= 1680 possible timing diagrams.

The following procedure yields all possible values.

(define cnt 1)
(define (execute-list lst)
  (display cnt)
  (display ":")
  (set! cnt (inc cnt))
  (define (iter lst)
    (if (null? lst)
        (newline)
        (begin ((car lst)) (iter (cdr lst)))))
  (iter lst))

(define (factorial n)
  (if (= n 0) 1 (* n (factorial (dec n)))))

(define balance 100)
(define (make-person)
  (define mybalance 100)
  (define (access)
    (set! mybalance balance))
  (define (deposit x)
    (set! mybalance (+ mybalance x)))
  (define (withdraw x)
    (set! mybalance (- mybalance x)))
  (define (withdraw-half)
    (set! mybalance (/ mybalance 2)))
  (define (sync)
    (set! balance mybalance))
  (define (check)
    (display mybalance)
    (newline))
  (define (dispatch m)
    (cond ((eq? m 'access) access)
          ((eq? m 'deposit) deposit)
          ((eq? m 'withdraw) withdraw)
          ((eq? m 'withdraw-half) withdraw-half)
          ((eq? m 'sync) sync)
          ((eq? m 'check) check)))
  dispatch)

(define petter (make-person))
(define paul (make-person))
(define mary (make-person))

(define petter-seq (list (petter 'access) (lambda () ((petter 'deposit) 10)) (lambda () ((petter 'sync)))))
(define paul-seq (list (paul 'access) (lambda () ((paul 'withdraw) 20)) (lambda () ((paul 'sync)))))
(define mary-seq (list (mary 'access) (lambda () ((mary 'withdraw-half))) (lambda () ((mary 'sync)))))

(define result '())
(define (interleave petter paul mary temp)
  (if (and (null? petter)
           (null? paul)
           (null? mary))
      (set! result (cons (reverse temp) result)))
  (if (not (null? petter))
      (interleave (cdr petter) paul mary (cons (car petter) temp)))
  (if (not (null? paul))
      (interleave petter (cdr paul) mary (cons (car paul) temp)))
  (if (not (null? mary))
      (interleave petter paul (cdr mary) (cons (car mary) temp))))

(interleave petter-seq paul-seq mary-seq '())
(define (in) (display balance) (set! balance 100))
(define op (map (lambda (x) (append x (list in))) result))
(for-each execute-list op)

Sphinxsky

I think it's 90 possibilities.

  
  
  
  
 (define (count-demo . arrays) 
     (let ((demo-result '())) 
  
         (define (rec result arrays) 
             (let ((arys (filter 
                             (lambda (ary) (not (null? ary))) 
                             arrays))) 
                 (if (null? arys) 
                     (set! demo-result (cons result demo-result)) 
                     (for-each 
                         (lambda (ary) 
                             (rec 
                                 (append result (list (car ary))) 
                                 (map 
                                     (lambda (other) 
                                         (if (eq? other ary) 
                                             (cdr other) 
                                             other)) 
                                     arys))) 
                         arys)))) 
         (rec '() arrays) 
         demo-result)) 
  
 (define (set-balance! new) 
     (put 'bank 'balance new)) 
 (define (get-balance) 
     (get 'bank 'balance)) 
  
 (define (make-process-2 name f) 
     (put name 'read 
         (lambda () 
             (put name 'now (get-balance)))) 
      
     (put name 'write 
         (lambda () 
             (set-balance! (f (get name 'now))))) 
      
     (list (cons name 'read) (cons name 'write))) 
  
 (define (make-process-3 name f) 
     (put name 'read-1 
         (lambda () 
             (put name 'now-1 (get-balance)))) 
     
      (put name 'read-2 
         (lambda () 
             (put name 'now-2 (get-balance)))) 
      
     (put name 'write 
         (lambda () 
             (set-balance! (f (get name 'now-1) (get name 'now-2))))) 
      
     (list (cons name 'read-1) (cons name 'read-2)  (cons name 'write))) 
  
 (define (make-possibility demo) 
     (define (get-proc k-v) 
         (get (car k-v) (cdr k-v))) 
  
     (define (make-info k-v) 
         (string-append 
             (symbol->string (car k-v)) 
             "_" 
             (symbol->string (cdr k-v)))) 
              
     (define (add-info info1 info2) 
         (string-append 
             info1 
             "->" 
             info2)) 
  
     (let ((proc-list (map get-proc demo)) 
           (result 0)) 
         (set-balance! 100) 
         ;(set-balance! 10) 
         (for-each (lambda (proc) (proc)) proc-list) 
         (set! result (get-balance)) 
         (lambda (m) 
             (cond ((eq? m 'result) result) 
                 ((eq? m 'info) 
                     (accumulate add-info "\b\b\t" (map make-info demo))) 
                 (else (error "Unknown operation -- MAKE-RESULT" m)))))) 
  
 (define (make-statistician demos) 
     (let ((possibility-list (map make-possibility demos)) 
           (result-list '())) 
         (define (iter possibility-list) 
             (if (null? possibility-list) 
                 'done 
                 (let ((possibility (car possibility-list))) 
                     (let ((result (possibility 'result)) 
                           (info (possibility 'info))) 
                         (if (memq result result-list) 
                             (put 'result result (cons info (get 'result result))) 
                             (begin 
                                 (set! result-list (cons result result-list)) 
                                 (put 'result result (list info)))) 
                         (iter (cdr possibility-list)))))) 
          
         (iter possibility-list) 
         (lambda (m) 
             (cond ((eq? m 'all) result-list) 
                 ((eq? m 'one) 
                     (lambda (result) 
                         (get 'result result))) 
                 (else (error "Unknown operation -- MAKE-STATISTICIAN" m)))))) 
  
 (define (one-poss statistician result) 
     (for-each 
         (lambda (info) 
             (newline) 
             (display info)) 
         ((statistician 'one) result))) 
  
 (define (all-poss statistician) 
     (statistician 'all)) 
  
  
 (define Peter (make-process-2 'Peter (lambda (x) (+ x 10)))) 
 (define Paul (make-process-2 'Paul (lambda (x) (- x 20)))) 
 (define Mary (make-process-2 'Mary (lambda (x) (/ x 2)))) 
  
 (define S (make-statistician (count-demo Peter Paul Mary))) 
  
 ;; read all possibilities 
 (all-poss S) 
 ;; (35 55 45 110 50 80 90 30 60 40) 
  
 ;; read one possibility of 45 
 (one-poss S 45) 
 ;; peter_read->peter_write->paul_read->paul_write->mary_read->mary_write  
 ;; paul_read->paul_write->peter_read->peter_write->mary_read->mary_write 
  

seok

It worths noting that 65 can appear as a result. Mary's operation is (balance - (balance / 2)), NOT (balance / 2).

 ; 1. Peter changes balance to 110. 
 ; 2. Mary reads balance for the argument of subtraction, getting 110. 
 ; 3. Paul changes balance to 90. 
 ; 4. Mary reads balance for the argument of division, getting 90. 
 ; 5. Mary sets balance to (110 - (90 / 2)) = 65. 

The process described above may have a little problem.. Mary read balance as 110, so (balance / 2) = 55 and read balance again as 90, finally ans = 90 - 55 = 45