λ3.5節

問題 3.50  問題 3.51  問題 3.52  問題 3.53  問題 3.54 
問題 3.55  問題 3.56  問題 3.57  問題 3.58  問題 3.59 
問題 3.60  問題 3.61  問題 3.62  問題 3.63  問題 3.64 
問題 3.65  問題 3.66  問題 3.67  問題 3.68  問題 3.69 
問題 3.70  問題 3.71  問題 3.72  問題 3.73  問題 3.74 
問題 3.75  問題 3.76  問題 3.77  問題 3.78  問題 3.79 
問題 3.80  問題 3.81  問題 3.82  ストリーム 

ストリーム
 ;; streams.scmとして読み込む. 
(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 (stream-filter pred stream) (cond ((stream-null? stream) the-empty-stream) ((pred (stream-car stream)) (cons-stream (stream-car stream) (stream-filter pred (stream-cdr stream)))) (else (stream-filter pred (stream-cdr stream))))) (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)))))) (define (stream-for-each proc s) (if (stream-null? s) 'done (begin (proc (stream-car s)) (stream-for-each proc (stream-cdr s))))) (define (display-stream s) (stream-for-each display-line s)) (define (display-line x) (newline) (display x))
問題 3.50
(load "streams.scm")
 ;;一般化したstream-mapはstreams.scmの中にある. 

(display-stream (stream-map (lambda (x y) (* x y)) 
(stream-enumerate-interval 0 10) (stream-enumerate-interval 10 20)))
問題 3.51
(load "streams.scm")

(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)
問題 3.52
(load "streams.scm")

(define sum 0)

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

(define seq (stream-map accum (stream-enumerate-interval 1 20)))
(define y (stream-filter even? seq))
(define z (stream-filter (lambda (x) (= (remainder x 5) 0))
                         seq))

(stream-ref y 7)

(display-stream z)
問題 3.53
;実行してみなくても容易に分るが, 実行してみると:

(load "streams.scm")

(define (add-streams s1 s2)
 (stream-map + s1 s2))

(define s (cons-stream 1 (add-streams s s)))

(display-stream s)

1
2
4
8
16
32
64
128
256
512
1024
...
問題 3.54
(load "streams.scm")

(define (mul-streams s1 s2) (stream-map * s1 s2))

(define (add-streams s1 s2) (stream-map + s1 s2))

(define ones (cons-stream 1 ones))

(define integers (cons-stream 1 (add-streams ones integers)))

(define factorials 
  (cons-stream 1 (mul-streams factorials (stream-cdr integers))))

(display-stream factorials)
問題 3.55
(load "streams.scm")

(define (add-streams s1 s2) (stream-map + s1 s2))

(define ones (cons-stream 1 ones))

(define integers (cons-stream 1 (add-streams ones integers)))

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

(display-stream (partial-sums integers))
問題 3.56
(load "streams.scm")

(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 s1car (merge (stream-cdr s1) s2)))
                 ((> s1car s2car)
                  (cons-stream s2car (merge s1 (stream-cdr s2))))
                 (else
                  (cons-stream s1car
                               (merge (stream-cdr s1)
                                      (stream-cdr s2)))))))))

(define (*3 x) (* 3 x))
(define (*5 x) (* 5 x))
(define (*7 x) (* 7 x))

(define S (cons-stream 1 (merge (stream-map *3 S)
                                (merge (stream-map *5 S)
                                       (stream-map *7 S)))))

(display-stream S)
1
3
5
7
9
15
21
25
27
35
45
49
63
75
81
105
125
135
147
175
189
問題 3.58
(load "streams.scm")
(define (expand num den radix)
  (cons-stream
    (quotient (* num radix) den)
    (expand (remainder (* num radix) den) den radix)))

(display-stream (expand 1 7 10))

1
4
2
8
5
7
1
4
2
8
5
7
1
4
2
8
5
7
1
4
(display-stream (expand 3 8 10))

3
7
5
0
0
0
0
0
0
0

num を den で割った radix進法の商を出力する. 
問題 3.59
(load "streams.scm")

(define (integrate-series coefs)
  (let ((n 0))
    (stream-map (lambda (x) (set! n (+ n 1)) (/ x n)) coefs)))

(define exp-series (cons-stream 1 (integrate-series exp-series)))

;(display-stream exp-series)

(define cosine-series
  (cons-stream 1 (stream-map - (integrate-series sine-series))))


(define sine-series
  (cons-stream 0 (integrate-series cosine-series)))


;(display-stream sine-series)
問題 3.60
(load "streams.scm")

(define (mul-series s1 s2)
  (cons-stream (* (stream-car s1) (stream-car s2))
               (add-streams (stream-map 
                              (lambda (x) (* (stream-car s1) x))
                              (stream-cdr s2))
                            (mul-series (stream-cdr s1) s2))))

(define (integrate-series coefs)
  (let ((n 0))
    (stream-map (lambda (x) (set! n (+ n 1)) (/ x n)) coefs)))

(define cosine-series
  (cons-stream 1 (stream-map - (integrate-series sine-series))))

(define sine-series
  (cons-stream 0 (integrate-series cosine-series)))

;; x は1でもよいのだから, 係数を出力してみる. 

(display-stream 
 (add-streams
  (mul-series sine-series sine-series)
  (mul-series cosine-series cosine-series)))
問題 3.61
(load "streams.scm")

(define (mul-series s1 s2)
  (cons-stream (* (stream-car s1) (stream-car s2))
               (add-streams (stream-map 
                              (lambda (x) (* (stream-car s1) x))
                              (stream-cdr s2))
                            (mul-series (stream-cdr s1) s2))))

(define (invert-unit-series sr)
 (define x (cons-stream 1 (stream-map - (mul-series sr x))))
x)

(define (integrate-series coefs)
  (let ((n 0))
    (stream-map (lambda (x) (set! n (+ n 1)) (/ x n)) coefs)))

(define exp-series 
  (cons-stream 1 (integrate-series exp-series)))

(display-stream
 (mul-series exp-series
   (invert-unit-series (stream-cdr exp-series))))

→  ;; (exp x) * (1 / (exp *)) をやってみると, 

1
0
0
0
0
問題 3.62
(load "streams.scm")

(define (mul-series s1 s2)
  (cons-stream (* (stream-car s1) (stream-car s2))
               (add-streams (stream-map 
                              (lambda (x) (* (stream-car s1) x))
                              (stream-cdr s2))
                            (mul-series (stream-cdr s1) s2))))

(define (integrate-series coefs)
  (let ((n 0))
    (stream-map (lambda (x) (set! n (+ n 1)) (/ x n)) coefs)))

(define cosine-series
  (cons-stream 1 (stream-map - (integrate-series sine-series))))

(define sine-series
  (cons-stream 0 (integrate-series cosine-series)))



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

(define (div-series s1 s2)
  (let ((constant-term (stream-car s2)))
  (if (= constant-term 0) (error "divisor's constant term is zero" (stream-car s2))
      (stream-map (lambda (x) (/ x constant-term))
                  (mul-series s1 (invert-unit-series
                                 (stream-map (lambda (x) (/ x constant-term))
                                             s2)))))))

(display-stream
 (div-series sine-series cosine-series))
問題 3.64
(load "streams.scm")

(define (stream-limit stream tolerance)
  (let ((first (stream-car stream)) (rest (stream-cdr stream)))
    (if (< (abs (- first (stream-car rest))) tolerance)
        first
        (stream-limit rest tolerance))))

(define (sqrt-stream x)
  (define guesses
     (cons-stream 1.0
                  (stream-map (lambda (guess)
                                (sqrt-impreve guess x))
                              guesses)))
  guesses)        

(define (sqrt-impreve guess x)
  (average guess (/ x guess)))

(define (average x y)
  (/ (+ x y) 2))

(define (sqrt x tolerance)
  (stream-limit (sqrt-stream x) tolerance))

(sqrt 2.0 0.001) → 1.4142156862745097
問題 3.65
(load "streams.scm")

(define (add-streams s1 s2) (stream-map + s1 s2))

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


(define (ln2-summands0 n)
  (cons-stream (/ 1.0 n)
               (ln2-summands1 (+ n 1)))))
(define (ln2-summands1 n)
  (cons-stream (/ -1.0 n)
               (ln2-summands0 (+ n 1)))))
(define ln2-stream 
  (partial-sums (ln2-summands0 1)))

(display-stream ln2-stream)

;;.5
;;.8333333333333333
;;.5833333333333333
;;.7833333333333332
;;.6166666666666666
;;.7595238095238095
;;.6345238095238095
;;.7456349206349207
;;.6456349206349207
;;.7365440115440116
;; ...

(define (square x) (* x x))

(define (euler-transform s)
  (let ((s0 (stream-ref s 0))
        (s1 (stream-ref s 1))
        (s2 (stream-ref s 2)))
    (cons-stream (- s2 (/ (square (- s2 s1))
                          (+ s0 (* -2 s1) s2)))
                 (euler-transform (stream-cdr s)))))

(display-stream (euler-transform ln2-stream))

;;.7
;;.6904761904761905
;;.6944444444444444
;;.6924242424242424
;;.6935897435897436
;;.6928571428571428
;;.6933473389355742
;;.6930033416875522
;;.6932539682539683
;;.6930657506744464
;; ...

(define (make-tableau transform s)
  (cons-stream s
               (make-tableau transform
                             (transform s))))

(define (accelerated-sequence transform s)
  (stream-map stream-car
              (make-tableau transform s)))

(display-stream (accelerated-sequence euler-transform
                                      ln2-stream))

;;.7
;;.6932773109243697
;;.6931488693329254
;;.6931471960735491
;;.6931471806635636
;;.6931471805604039
;;.6931471805599445
;;.6931471805599427
;;.6931471805599454
問題 3.66
(load "streams.scm")

(define (add-streams s1 s2) (stream-map + s1 s2))

(define ones (cons-stream 1 ones))

(define integers (cons-stream 1 (add-streams ones integers)))

(define (interleave s1 s2)
  (if (stream-null? s1)
      s2
      (cons-stream (stream-car s1)
                   (interleave s2 (stream-cdr s1)))))

(define (pairs s t)
  (cons-stream
   (list (stream-car s) (stream-car t))
   (interleave
    (stream-map (lambda (x) (list (stream-car s) x))
                (stream-cdr t))
    (pairs (stream-cdr s) (stream-cdr t)))))


;;(display-stream (pairs integers integers))
;;
;;    0     1     2     3     4     5     6     7     8     9
;;00 (1 1) (1 2) (2 2) (1 3) (2 3) (1 4) (3 3) (1 5) (2 4) (1 6)
;;10 (3 4) (1 7) (2 5) (1 8) (4 4) (1 9) (2 6) (1 10)(3 5) (1 11)
;;20 (2 7) (1 12)(4 5) (1 13)(2 8) (1 14)(3 6) (1 15)(2 9) (1 16)
;;30 (5 5) (1 17)(2 10)(1 18)(3 7) (1 19)(2 11)(1 20)(4 6) (1 21)
;;40 (2 12)(1 22)(3 8) (1 23)(2 13)(1 24)(5 6) (1 25)(2 14)(1 26)
;;50 (3 9) (1 27)(2 15)(1 28)(4 7) (1 29)(2 16)(1 30)(3 10)(1 31)

;;考え方
;; (1 1) の後 (1 2) (1 3) (1 4) ...と (2 2)以下のpairsをinterleaveするか
;; ら
;;
;; (1 1) (1 2) (1 3) (1 4) 
;;          (2 2) ...
;;
;;したがって(1 j)の位置は 0番, 1番, 3番, 5番, ...となる
;;(2 2)以下のpairsは
;;(2 2) (2 3) (2 4) (2 5)
;;         (3 3) ...
;;
;;この順では(2 j)の位置は 0番, 1番, 3番, 5番, ...となるが,2番から始まっ
;;て(1 j)の列とinterleaveするから,k番は2k+2番になる. この調子でいくと, 
;;(3 j)の列のk番は 2(2k+2)+k番になる.
;;
;;まず(i i)の位置を考える.
;;p(1 1)=0 
;;p(2 2)=0+2=2
;;p(3 3)=2*2+2=2^2+2^1=6
;;p(4 4)=2*(2^2+2^1)+2=2^3+2^2+2^1=14
;;p(i i)=2^(i-1)+2^(i-2)+ ... 2^2+2^1=2^i-2
;;
;;さて(i j) (ただし(i < j))は(i i)から最初は2^(i-1)番後,それ以降は2^i番ずつ後に並
;;ぶから(j-i-1)*2^i+2^(i-1)を足せばよい.したがって

(define (place i j) ;; 対 i, j (i <= j)が何番目にくるか. (1 1)を0番とする
 (let ((s (expt 2 (- i 1))))
   (if (= i j)
       (+ s s -2)
       (+ s s -2 (* s (+ j j (- i) (- i) -1))))))

(place 1 100) → 197

(place 99 100) → 950737950171172051122527404030

(place 100 100) → 1267650600228229401496703205374
問題 3.67
(load "streams.scm")

(define (integers-starting-from n)
  (cons-stream n (integers-starting-from (+ n 1))))

(define integers (integers-starting-from 1))

(define (interleave s1 s2)
  (if (stream-null? s1)
      s2
      (cons-stream (stream-car s1)
         (interleave s2 (stream-cdr s1)))))
(define (pairs s t)
  (cons-stream (list (stream-car s) (stream-car t))
  (interleave
    (interleave (stream-map (lambda (x) (list (stream-car s) x))
                  (stream-cdr t))
                (stream-map (lambda (x) (list x (stream-car t)))
                  (stream-cdr s)))
    (pairs (stream-cdr s) (stream-cdr t)))))

(define (pairs s t)
 (interleave 
  (stream-map (lambda (x) (list (stream-car s) x))
               t)
   (pairs (stream-cdr s) (stream-cdr t)))
)

(display-stream
 (pairs integers integers))
問題 3.68
pairsの中のinterleaveがすぐpairsを呼ぶので, 呼出しのループに入り, 計算はすすまない. 
問題 3.69
(define (display-stream s)
  (stream-for-each display-line s))

(define (display-line x)
  (newline)
  (display x))

(define (stream-for-each proc s)
  (if (stream-null? s)
      'done
      (begin (proc (stream-car s))
             (stream-for-each proc (stream-cdr s)))))

(define ones (cons-stream 1 ones))

(define (add-streams s1 s2)
  (stream-map + s1 s2))

(define integers (cons-stream 1 (add-streams ones integers)))

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

(define (interleave s1 s2)
  (if (stream-null? s1)
      s2
      (cons-stream (stream-car s1)
                   (interleave s2 (stream-cdr s1)))))

(define (pairs s t)
  (cons-stream
   (list (stream-car s) (stream-car t))
   (interleave
    (stream-map (lambda (x) (list (stream-car s) x))
                (stream-cdr t))
    (pairs (stream-cdr s) (stream-cdr t)))))

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

(define (pythagoras s)
 (let ((triple (stream-car s)))
   (let ((i (car triple)) (j (cadr triple)) (k (caddr triple)))
    (cond ((= (+ (* i i) (* j j)) (* k k))
        (display (list i j k)) (newline)))
    (pythagoras (stream-cdr s)))))

(pythagoras (triples integers integers integers))

;;(3 4 5)
;;(6 8 10)
;;(5 12 13)
;;(9 12 15)
;;(8 15 17)
;;...
問題 3.70
(load "streams.scm")

(define (add-streams s1 s2) (stream-map + s1 s2))

(define ones (cons-stream 1 ones))

(define integers (cons-stream 1 (add-streams ones integers)))

(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)))
          (if (< (apply weight s1car) (apply weight s2car))
              (cons-stream s1car (merge-weighted weight (stream-cdr s1) s2))
              (cons-stream s2car (merge-weighted weight s1 (stream-cdr s2))))))))

(define (weighted-pair weight s1 s2)
  (cons-stream (list (stream-car s1) (stream-car s2))
    (merge-weighted weight (stream-map (lambda (x) (list (stream-car s1) x))
                                       (stream-cdr s2))
                           (weighted-pair weight (stream-cdr s1)
                                                 (stream-cdr s2)))))

;(display-stream
;(weighted-pair (lambda (x y) (+ x y)) integers integers))

(define str (stream-filter 
(lambda (x) (and (> (remainder x 2) 0) (> (remainder x 3) 0)   
   (> (remainder x 5) 0))) integers))

(display-stream
 (weighted-pair (lambda (i j) (+ (* 2 i) (* 3 j) (* 5 i j)))
                str str))

;;(1 1)(1 7)(1 11)(1 13)(1 17)(1 19)(1 23)(1 29)(1 31)(7 7)
;;(1 37)(1 41)(1 43)(1 47)(1 49)(1 53)(7 11)(1 59)(1 61)(7 13)
;;(1 67)(1 71)(1 73)(1 77)(1 79)(11 11)(7 17)(1 83)(1 89)(1 91)
問題 3.71
(load "streams.scm")

(define (add-streams s1 s2) (stream-map + s1 s2))

(define ones (cons-stream 1 ones))

(define integers (cons-stream 1 (add-streams ones integers)))

(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)))
          (if (< (apply weight s1car) (apply weight s2car))
              (cons-stream s1car (merge-weighted weight (stream-cdr s1) s2))
              (cons-stream s2car (merge-weighted weight s1 (stream-cdr s2))))))))

(define (weighted-pair weight s1 s2)
  (cons-stream (list (stream-car s1) (stream-car s2))
    (merge-weighted weight (stream-map (lambda (x) (list (stream-car s1) x))
                                       (stream-cdr s2))
                           (weighted-pair weight (stream-cdr s1) 
                                                 (stream-cdr s2)))))

(define (find-twin stream)
 (let ((first (stream-car stream)) (rest (stream-cdr stream))
       (second (stream-car (stream-cdr stream))))
   (let ((i0 (car first)) (j0 (cadr first)) 
         (i1 (car second)) (j1 (cadr second)))
   (cond ((= (+ (* i0 i0 i0) (* j0 j0 j0)) (+ (* i1 i1 i1) (* j1 j1 j1)))
              (display first) (display second) (newline)))
   (find-twin rest))))

(find-twin
 (weighted-pair (lambda (i j) (+ (* i i i) (* j j j))) integers integers))

;; (9 10)(1 12)
;; (9 15)(2 16)
;; (18 20)(2 24)
;; (19 24)(10 27)
;; (18 30)(4 32)
;; (15 33)(2 34)
;; (16 33)(9 34)
;; (27 30)(3 36)
;; (26 36)(17 39)
;; (31 33)(12 40)
問題 3.72
(load "streams.scm")

(define (add-streams s1 s2) (stream-map + s1 s2))

(define ones (cons-stream 1 ones))

(define integers (cons-stream 1 (add-streams ones integers)))

(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)))
          (if (< (apply weight s1car) (apply weight s2car))
              (cons-stream s1car (merge-weighted weight (stream-cdr s1) s2))
              (cons-stream s2car (merge-weighted weight s1 (stream-cdr s2))))))))

(define (weighted-pair weight s1 s2)
  (cons-stream (list (stream-car s1) (stream-car s2))
    (merge-weighted weight (stream-map (lambda (x) (list (stream-car s1) x))
                                       (stream-cdr s2))
                           (weighted-pair weight (stream-cdr s1) 
                                                 (stream-cdr s2)))))

(define (find-triplet stream)
 (let ((first (stream-car stream)) (rest (stream-cdr stream))
       (second (stream-car (stream-cdr stream)))
       (third (stream-car (stream-cdr (stream-cdr stream)))))
   (let ((i0 (car first)) (j0 (cadr first))
         (i1 (car second)) (j1 (cadr second))
         (i2 (car third)) (j2 (cadr third)))
   (cond ((and
            (= (+ (* i0 i0) (* j0 j0)) (+ (* i1 i1) (* j1 j1)))
            (= (+ (* i0 i0) (* j0 j0)) (+ (* i2 i2) (* j2 j2))))
          (display first) (display second) (display third) (newline)))
   (find-triplet rest))))

(find-triplet
 (weighted-pair (lambda (i j) (+ (* i i) (* j j))) integers integers))

;;(10 15)(6 17)(1 18)
;;(13 16)(8 19)(5 20)
;;(17 19)(11 23)(5 25)
;;(14 23)(10 25)(7 26)
;;(19 22)(13 26)(2 29)
;;(15 25)(11 27)(3 29)
;;(21 22)(14 27)(5 30)
;;(20 25)(8 31)(1 32)
;;(23 24)(12 31)(9 32)
;;(12 31)(9 32)(4 33)
問題 3.73
(define (integral integrand initial-value dt)
  (define int
    (cons-stream initial-value
                 (add-streams (scale-stream integrand dt)
                              int)))
  int)

(define (RC R C dt)
  (lambda (i-stream vo)
    (cons-stream v0
      (add-streams (scale-stream i-stream R)
                   (integral (scale-stream i-stream (/ 1.0 C)) v0)))))

(define RC1 (RC 5 1 0.5))
問題 3.74
(define (list->stream list)
  (if (null? list) the-empty-stream
      (cons-stream (car list) (list->stream (cdr list)))))

(define sense-data 
(list->stream
 '(1  2  1.5  1  0.5  -0.1  -2  -3  -2  -0.5  0.2  3  4)))

(define (sign-change-detector next last)
  (cond ((and (>= next 0) (< last 0)) 1)
        ((and (< next 0) (>= last 0)) -1)
        (else 0)))

(define (make-zero-crossings input-stream last-value)
(if (stream-null? input-stream)
    the-empty-stream
  (cons-stream
   (sign-change-detector (stream-car input-stream) last-value)
   (make-zero-crossings (stream-cdr input-stream)
                        (stream-car input-stream)))))

(define zero-crossings (make-zero-crossings sense-data 0))

(display-stream zero-crossings)

(newline)

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

(define zero-crossings
  (stream-map sign-change-detector sense-data 
(cons-stream 0 sense-data)))

(display-stream zero-crossings)
→
0
0
0
0
0
-1
0
0
0
0
1
0
0

0
0
0
0
0
-1
0
0
0
0
1
0
0
問題 3.75
(define (list->stream list)
  (if (null? list) the-empty-stream
      (cons-stream (car list) (list->stream (cdr list)))))

(define sense-data 
(list->stream
 '(1  2  1.5  1  0.5  -0.1  -2  -3  -2  -0.5  0.2  3  4)))

(define (sign-change-detector next last)
  (cond ((and (>= next 0) (< last 0)) 1)
        ((and (< next 0) (>= last 0)) -1)
        (else 0)))

(define (make-zero-crossings input-stream last-value last-avpt)
(if (stream-null? input-stream)
    the-empty-stream
  (let ((avpt (/ (+ (stream-car input-stream) last-value) 2))
        (next-value (stream-car input-stream)))
    (cons-stream (sign-change-detector avpt last-avpt)
                 (make-zero-crossings (stream-cdr input-stream)
                                      next-value
                                      avpt)))))

(define zero-crossings (make-zero-crossings sense-data 0 0))

(display-stream zero-crossings)
→
0
0
0
0
0
0
-1
0
0
0
0
1
0
問題 3.76
(define (list->stream list)
  (if (null? list) the-empty-stream
      (cons-stream (car list) (list->stream (cdr list)))))

(define sense-data 
(list->stream
 '(1  2  1.5  1  0.5  -0.1  -2  -3  -2  -0.5  0.2  3  4)))

(define (sign-change-detector next last)
  (cond ((and (>= next 0) (< last 0)) 1)
        ((and (< next 0) (>= last 0)) -1)
        (else 0)))

(define (smooth input-stream last-value)
  (if (stream-null? input-stream) the-empty-stream
     (let ((av (/ (+ (stream-car input-stream) last-value) 2)))
       (cons-stream av 
          (smooth (stream-cdr input-stream) (stream-car input-stream))))))

(define (make-zero-crossings input-stream last-value)
(if (stream-null? input-stream)
    the-empty-stream
    (cons-stream (sign-change-detector (stream-car input-stream) last-value)
                 (make-zero-crossings (stream-cdr input-stream)
                                      (stream-car input-stream)))))

(define zero-crossings (make-zero-crossings 
           (smooth sense-data 0) 0))

(display-stream zero-crossings)
→
0
0
0
0
0
0
-1
0
0
0
0
1
0
問題 3.77
(define (integral delayed-integrand initial-value dt)
  (cons-stream initial-value
               (let ((integrand (force delayed-integrand)))
                 (if (stream-null? integrand)
                     the-empty-stream
                     (integral (delay (stream-cdr integrand))
                               (+ (* dt (stream-car integrand))
                                   initial-value)
                               dt)))))

(define (solve f y0 dt)
  (define y (integral (delay dy) y0 dt))
  (define dy (stream-map f y))
  y)

(stream-ref (solve (lambda (y) y) 1 0.001) 1000) → 2.716923932235896
問題 3.78
(define (solve-2nd a b y0 dy0 dt)
  (define y (integral (delay dy) y0 dt))
  (define dy (integral (delay ddy) dy0 dt))
  (define ddy (add-streams (scale-stream dy a) (scale-stream y b)))
  y)

(display-stream (solve-2nd -2 -16 1 0 0.01))
この解は 速度に比例した抵抗を受ける質点の自由振動 を表す.
d2x/dt2+ 2h dx/dt+ k2 x=0 h,k≥0, h<k のとき
x=e-ht{c0 cos(√(k2 -h2 )t)+ c1 sin(√(k2 -h2 )t)} が解.
下の図で青線が解, 黒線が積分値を示す.

問題 3.79
(load "streams.scm")

(define (integral delayed-integrand initial-value dt)
  (cons-stream initial-value
               (let ((integrand (force delayed-integrand)))
                 (if (stream-null? integrand)
                     the-empty-stream
                     (integral (delay (stream-cdr integrand))
                               (+ (* dt (stream-car integrand))
                                   initial-value)
                               dt)))))

(define (solve-2nd f y0 dy0 dt)
  (define y (integral (delay dy) y0 dt))
  (define dy (integral (delay ddy) dy0 dt))
  (define ddy (stream-map f dy y))
y)

(display-stream (solve-2nd (lambda (dy y) (+ (* -2 dy) (* -16 y))) 1 0 0.01))
問題 3.80
(load "streams.scm")

(define (integral delayed-integrand initial-value dt)
  (cons-stream initial-value
               (let ((integrand (force delayed-integrand)))
                 (if (stream-null? integrand)
                     the-empty-stream
                     (integral (delay (stream-cdr integrand))
                               (+ (* dt (stream-car integrand))
                                   initial-value)
                               dt)))))

(define (RLC R L C dt)
  (lambda (vC0 iL0)
    (define vC (integral (delay dvC) vC0 dt))
    (define iL (integral (delay diL) iL0 dt))
    (define dvC (scale-stream iL (/ -1.0 C)))
    (define diL (add-streams
                  (scale-stream vC (/ 1.0 L))
                  (scale-stream iL (/ (- R) L))))
   (cons vC iL)))

(define (stream-for-each-pair proc s t)
  (if (stream-null? s)
      'done
      (begin (proc (stream-car s) (stream-car t))
             (stream-for-each-pair proc (stream-cdr s) (stream-cdr t)))))

(define (display-stream-pair stream)
  (let ((s (car stream)) (t (cdr stream)))
    (stream-for-each-pair display-pair-line s t)))

(define (display-pair-line x y)
  (newline)
  (display x) (display "  ") (display y))

(display-stream-pair
 ((RLC 1 1 0.2 0.1) 10 0))
下の図で青線が電流 iL, 赤線が電圧 vCを示す.

問題 3.81
(define (list->stream list)
  (if (null? list) the-empty-stream
      (cons-stream (car list) (list->stream (cdr list)))))

(define (rand-update x)
  (remainder (+ (* x 3125) 19683) 32768))

(define foo
'(generate generate generate generate reset 100
  generate generate generate generate reset 100
  generate generate generate generate))

(define bar
  (list->stream foo))

(define (random s init)
  (if (stream-null? s)
      the-empty-stream
      (cons-stream init
        (cond ((eq? (stream-car s) 'generate)
               (random (stream-cdr s) (rand-update init)))
              ((eq? (stream-car s) 'reset) 
               (random (stream-cdr (stream-cdr s)) (stream-car (stream-cdr s))))
              (else 'error)))))

(display-stream (random bar 100))
問題 3.82
(define (estimate-integral P x1 x2 y1 y2)
  (define (test passed failed)
    (cons-stream (* (/ passed (+ passed failed)) 36.0)
      (if (P (random-in-range x1 x2) (random-in-range y1 y2))
          (test (+ passed 1) failed)
          (test passed (+ failed 1)))))
  (test 0 1))

(define (random-in-range low high)
  (let ((range (- high low)))
    (+ low (random range))))

(define (square x) (* x x))

(display-stream
  (estimate-integral 
    (lambda (x y) (<= (+ (square (- x 5)) (square (- y 7))) 9))
    2.0 8.0 4.0 10.0))