SICPゼミ第30回

練習問題3.73
(define (RC R C dt)
  (define (calc i v0)
    (add-streams (scale-stream i R) (integral (scale-stream i (/ 1 C)) v0 dt)))
  calc)

民主主義しゅき〜〜(ドナルド・トランプ

練習問題3.74
(define (sign-change-detector now last)
  (if (> (* now last) 0)
      0
      (if (= last 0)
          (if (>= now 0) 0 -1)
          (if (< last 0) 1 0))))
              

(define zero-crossings
  (stream-map sign-change-detector
              sense-data
              (cons-stream 0 sense-data)))
練習問題3.75
(define (make-zero-crossings input-stream last-value last-average)
  (let ((avpt (/ (+ (stream-car input-stream)
    last-value)
    2)))
  (cons-stream
    (sign-change-detector avpt last-average)
    (make-zero-crossings
      (stream-cdr input-stream) (stream-car input-stream) avpt))))

by dolicas

練習問題3.76
(define (smooth input-stream)
  (cons-stream (/ (+ (stream-car input-stream)
                     (stream-car (stream-cdr input-stream)))
                  2)
               (smooth (stream-cdr input-stream))))

SICPゼミ第29回

練習問題3.67
(define (pairs s t)
  (cons-stream
   (list (stream-car s) (stream-car t))
   (interleave
    (interleave
     (stream-map (lambda (x) (list (stream-car t) x))
                 (stream-cdr s))
     (stream-map (lambda (x) (list x (stream-car t)))
                 (stream-cdr s)))
    (pairs (stream-cdr s) (stream-cdr t)))))

実行結果

> (display-stream-count (pairs integers integers) 10)

(1 1)
(1 2)
(2 2)
(2 1)
(2 3)
(1 3)
(3 3)
(3 1)
(3 2)
(1 4)

by tube

練習問題3.68

無限ループする。

関数呼び出しをするとまず引数が評価されるので、Reasonerの(pairs s t)をすると定義内のinterleaveの第2引数である(pairs (stream-cdr s) (stream-cdr t))が評価される。これはpairsの呼び出しの無限ループを引き起こす。

by dolicas

練習問題3.69
(define (triples s t u)
  (cons-stream
    (list (stream-car s) (stream-car t) (stream-car u))
    (interleave
      (stream-map (lambda (x) (cons (stream-car s) x)) (stream-cdr (pairs t u)))
      (triples (stream-cdr s) (stream-cdr t) (stream-cdr u))
      )
    )
  )

by dolicas

(define pythagoras
  (stream-filter
   (lambda (triple)
     (= (+ (square (car triple))
           (square (cadr triple)))
        (square (caddr triple))))
   (triples integers integers integers)))

実行結果

> (display-stream-count pythagoras 4)

(3 4 5)
(6 8 10)
(5 12 13)
(9 12 15)

by tube

練習問題3.70
(define (merge-weighted s1 s2 weight)
  (cond ((stream-null? s1) s2)
        ((stream-null? s2) s1)
        (else
          (let ((s1car (stream-car s1))
                (s2car (stream-car s2)))
            (if (weight s1car s2car)
                (cons-stream
                  s1car
                  (merge-weighted (stream-cdr s1) s2 weight))
                (cons-stream
                  s2car
                  (merge-weighted s1 (stream-cdr s2) weight)))))))

(define (weighted-pairs s t weight)
  (cons-stream
    (list (stream-car s) (stream-car t))
    (merge-weighted
      (stream-map (lambda (x) (list (stream-car s) x))
                  (stream-cdr t))
      (weighted-pairs (stream-cdr s) (stream-cdr t) weight)
      weight)))

(define (weight1 p1 p2)
  (let ((s1 (+ (car p1) (cadr p1)))
        (s2 (+ (car p2) (cadr p2))))
    (< s1 s2)))

(define (weight2 p1 p2)
  (let ((s1 (+ (* (car p1) 2) (* (cadr p1) 3) (* (car p1) (cadr p1) 5)))
        (s2 (+ (* (car p2) 2) (* (cadr p2) 3) (* (car p2) (cadr p2) 5))))
    (< s1 s2)))

(define a (weighted-pairs integers integers weight1))

(define b
  (stream-filter
    (lambda (x)
      (and (not (= (remainder (car x) 2) 0))
           (not (= (remainder (car x) 3) 0))
           (not (= (remainder (car x) 5) 0))
           (not (= (remainder (cadr x) 2) 0))
           (not (= (remainder (cadr x) 3) 0))
           (not (= (remainder (cadr x) 5) 0))))
    (weighted-pairs integers integers weight2)))

by pine

(define (merge-weighted weight s1 s2)
  (cond (( stream-null? s1) s2)
        (( stream-null? s2) s1)
        (else
         (let (( s1car (stream-car s1))
               (s2car (stream-car s2)))
           (cond ((<= (weight s1car) (weight s2car))
                  (cons-stream
                   s1car
                   (merge-weighted weight (stream-cdr s1) s2)))
                 ((> (weight s1car) (weight s2car))
                  (cons-stream
                   s2car
                   (merge-weighted weight s1 (stream-cdr s2)))))))))
(define (weighted-pairs weight s t)
  (cons-stream
   (list (stream-car s) (stream-car t))
   (merge-weighted
    weight
    (stream-map (lambda (x) (list (stream-car t) x))
                (stream-cdr s))
    (weighted-pairs weight (stream-cdr s) (stream-cdr t)))))

実際に問題解いた
a

> (display-stream-count
   (weighted-pairs
    (lambda (pair)
      (+ (car pair)
         (cadr pair)))
    integers integers) 10)

(1 1)
(1 2)
(1 3)
(2 2)
(1 4)
(2 3)
(1 5)
(2 4)
(3 3)
(1 6)

b

> (define s (stream-filter
             (lambda (x)
               (not (or (= (remainder x 2) 0)
                        (= (remainder x 3) 0)
                        (= (remainder x 5) 0)))) integers))
> (display-stream-count
   (weighted-pairs
    (lambda (pair)
      (+ (* 2(car pair))
         (* 3 (cadr pair))
         (* 5 (car pair) (cadr pair)))) s s) 10)

(1 1)
(1 7)
(1 11)
(1 13)
(1 17)
(1 19)
(1 23)
(1 29)
(1 31)
(7 7)

by tube

練習問題3.71
(define (weight1 p1)
  (+ (cube (car p1)) (cube (cadr p1))))

(define (cube x) (* x x x))

(define (ramanujan)
  (define (pair-cube l) (+ (cube (car l)) (cube (cadr l))))
  (define (ramanujan-iter stream)
    (let ((s1 (pair-cube (stream-car stream)))
      (s2 (pair-cube (stream-car (stream-cdr stream)))))
    (if (= s1 s2)
      (stream-cons s1 (ramanujan-iter (stream-cdr stream)))
      (ramanujan-iter (stream-cdr stream)))))
  (ramanujan-iter (weighted-pairs weight1 integers integers)))

実行結果

> (define x (ramanujan))
> (display-stream-count x 15)
1729
4104
13832
20683
32832
39312
40033
46683
64232
65728
110656
110808
134379
149389
165464

by dolicas

練習問題3.72
(define (pseudo-ramanujan)
  (define (pseudo-iter stream)
    (let ((s1 (pair-square (stream-car stream)))
          (s2 (pair-square (stream-car (stream-cdr stream))))
          (s3 (pair-square (stream-car (stream-cdr (stream-cdr stream))))))
      (if (and (= s1 s2) (= s2 s3))
          (cons-stream s1 (pseudo-iter (stream-cdr stream)))
          (pseudo-iter (stream-cdr stream)))))
  (pseudo-iter (weighted-pairs pair-square integers integers)))
> (display-stream-count (pseudo-ramanujan) 10)

325
425
650
725
845
850
925
1025
1105
1105

by tube

SICPゼミ第26回

練習問題3.50
(define (stream-map proc . argstreams)
  (if (null? (car argstreams ))
    the-empty-stream
    (stream-cons
      (apply proc (map stream-car argstreams))
      (apply stream-map
       (cons proc (map stream-cdr argstreams))))))

by dolicas

練習問題3.51
gosh> (define x
(stream-map show
(stream-enumerate-interval 0 10)))

0x
gosh> (stream-ref x 5)

1
2
3
4
55
gosh> (stream-ref x 7)

6
77
練習問題3.52
> (define sum 0)

>(define (accum x) (set! sum (+ x sum)) sum)
> sum
0

> (define seq
(stream-map accum
(stream-enumerate-interval 1 20)))
> sum
1

> (define y (stream-filter even? seq))
> sum
6

> (define z
(stream-filter (lambda (x) (= (remainder x 5) 0))
seq))
> sum
10

> (stream-ref y 7)
136
> sum
136

> (display-stream z)

10
15
45
55
105
120
190
210'done
> sum
210

メモ化していないと、毎回accumが呼ばれてsumに足されていってしまうのでへんなことになる。

by tube

SICPゼミ第25回

練習問題3.48

ループができないから。

serialized-exchange の実装例

;今までの serialized-exchange と同じやつ
(define (serialized-exchange account1 account2)
  (let (( serializer1 (account1 'serializer ))
        (serializer2 (account2 'serializer )))
    (( serializer1 (serializer2 exchange ))
     account1
     account2 )))


(define (serialized-exchange-renewal account1 account2)
  (let ((id1 (get-ID account1))
        (id2 (get-ID account2)))
    (if (> id1 id2)
        (serialized-exchange account2 accoun1)
        (serialized-exchange account1 account2))))

by tube

練習問題3.49

極論を言ってしまえば、使う可能性のあるリソースを全て列挙してID順にロックするというようにしてしまえば、(並列化もくそもないが) デッドロックは回避できる。
そうでなく、確実に必要なリソースのみをロックするようにすれば、条件分岐によってID順に逆らったロックの順番ができてしまい、デッドロックがおきうる。具体例は特に面白くもないので割愛。

SICPゼミ第24回

練習問題3.46

スレッド1が(car cell)した結果falseが返ってくる→スレッド1が(set-car! cell true)する前にスレッド2が(car cell)してfalseを得る→同時に2つのスレッドがmutexを獲得できたものとして実行されてしまう。

練習問題3.47

(a)

(define (make-semaphore n)
  (let ((counter 0) (m (make-mutex)))
    (define (the-semaphore ord)
      (cond
        ((eq? ord 'acquire)
          (begin (m 'acquire)
            (if (< counter n) (begin (set! counter (+ counter 1)) (m 'release))
              (begin (m' release) (the-semaphore 'acquire)))
            ))
        ((eq? ord) (begin (m' acquire) (set! counter (- counter 1)) (m' release))))
       the-semaphore))

by dolicas

(b)

(define (make-semaphore)
  (let ((cell (make-cell n)))
    (define (list-test-and-set! cell)
      (if (test-and-set! cell)
          (if (null? (cdr cell))
              (the-semaphore 'acquire )
              (list-test-and-set! (cdr cell)))
          #f))
    (define (the-semaphore m)
      (cond ((eq? m 'acquire)
             (list-test-and-set! cell))
            ((eq? m 'release) (clear-cell! cell ))))
    the-semaphore ))
  
(define (make-cell n)
  (if (= n 0)
      '()
      (cons #f (make-cell (- n 1)) )))

clear-cell! は無理。

by tube