SICP 3.5.3 Exploiting the Stream Paradigm - プログラミング再入門

ノート

「exploit」は英和辞典には「不当利用」的な意味が乗っているが、英英辞典では「最大限に利用する」と言う意味。

Moreover, they avoid some of the theoretical tangles that accompany the introduction of assignment into a programming language.

ストリームによって代入がもたらしたややこしい状況を回避出来る事がある。

Formulating iterations as stream processes

繰り返し処理をストリームで実現。
漸化的に数値を更新して行くプロセスを、ストリームの要素を順々に生成して行く操作に置き換える。
ストリームを辿るプロセスが再帰やループ処理の役割を果たす。
sqrt-streamを動かしてみる。

> (display-stream (sqrt-stream 2))
1.0
1.5
1.4166666666666665
1.4142156862745097
1.4142135623746899
1.414213562373095
1.414213562373095
1.414213562373095
…

pi-summandsは (1/n, -1(n+2),...)を生成する。(pi-summands 1)は(1, -1/3, ...)を生成する。要素を辿る度に二重、三重に(stream-map - ...)が効くので符号が反転する。
partial-sumはストリームの先頭からの累積をそれぞれの要素とする。
累積される値はπ/4なので最後にscale-streamで各要素を４倍する。
pi-streamも動かしてみる。

> (display-stream pi-stream)
4.0
2.666666666666667
3.466666666666667
2.8952380952380956
3.3396825396825403
2.9760461760461765
3.2837384837384844
（中略）
3.1470570936725304
3.1361579111112223
3.1469980195123064
3.1362163483532766

あまり直ぐには収束しない。

時々刻々と変化する値をストリームにする事で、数列を扱った数学のテクニックがそのままの形で利用出来る。
交代級数のオイラー変換を使う。

> (display-stream (euler-transform pi-stream))
3.166666666666667
3.1333333333333337
3.1452380952380956
3.13968253968254
3.1427128427128435
3.1408813408813416
3.142071817071818
3.1412548236077655
3.1418396189294033
以下省略

かなり早く収束している。
次はタブロー（tableau）と言うストリームのストリームを使う方法。オイラー変換したストリームを更にオイラー変換するのか。

> (display-stream (accelerated-sequence euler-transform
                                      pi-stream))
4.0
3.166666666666667
3.142105263157895
3.141599357319005
3.1415927140337785
3.1415926539752927
3.1415926535911765
3.141592653589778
3.1415926535897953
3.141592653589795
+nan.0

Exercise 3.63

元の定義では最初に作るストリームにguessesと言うローカル変数を拘束して、これをstream-mapに渡す。sqrt-streamが返すストリームを辿る過程では

最初の要素は1.0と決まっているので何も計算は無し
２番目の要素を生成する為にメモ化されたstream-mapが評価される。引数はguesses。最初の要素は決まっているのでguessに1.0が渡されてsqrt-improveの結果とメモ化されたstream-cdrに対するstream-map呼び出しの手続きを持つストリームが返される。この結果はguessesの２番目の要素としてのメモ化手続きのローカル変数として残る。
３番目の要素を生成する時に２番目の評価の結果返された手続きが評価される。これはstream-mapの定義の最後の式。ここで引数sはguessesの最初の要素を指しているので(stream-cdr s)はguessesの第２要素を評価してprocに渡す。つまり第２要素が評価されてguessとしてsqrt-improveに渡される。ここの第２要素の評価でメモ化された結果が使用される。sqrt-improveの結果と第４要素としてのメモ化された手続きを持つストリームが返される。この結果はguessesの３番目の要素としてのメモ化手続きのローカル変数として残る。
以下同文

ローカル変数を使わない定義の場合を考える。

最初の要素は1.0と決まっているので何も計算は無し
２番目の要素を生成する為にメモ化されたstream-mapが評価される。引数は(sqrt-stream x)を評価して作った新しいストリーム。最初の要素は決まっているのでguessに1.0が渡されてsqrt-improveの結果とメモ化されたstream-cdrに対するstream-map呼び出しの手続きを持つストリームが返される。この結果は最初の(sqrt-stream x)の呼び出しで作られたストリームの２番目の要素としてのメモ化手続きのローカル変数として残る。
３番目の要素を生成する時に２番目の評価の返された手続きが評価される。これはstream-mapの定義の最後の式。ここで引数sは二つ目のストリームの最初の要素を指しているので(stream-cdr s)は二つ目のストリームの第２要素を評価してprocに渡す事になる。二つ目のストリームの第２要素はまだ評価されていないので(sqrt-stream x)を呼んでまた三つ目のストリームを作り、その第１要素の1.0をguessとしてsqrt-improveを呼び出し、その結果を再びguessとしてsqrt-improveに渡す。sqrt-improveの結果と第４要素としてのメモ化された手続きを持つストリームが返される。ここで一つ目のストリームの最後の要素（メモ化されたstream-map呼び出し）は引数として二つ目のストリームを参照していて、二つ目のストリームの最後の要素は引数として三つ目のストリームを参照している。
以下同文

stream-mapの手続きの引数guessには毎回一つ手前の要素の値が入るので、stream-mapが最初に(sqrt-stream x)が呼ばれた時に作られたストリームを参照していればメモ化が効くが、stream-mapが別のストリームを参照しているとメモ化が効かない。ここでは毎回作られるストリームの最後の要素としてのstream-mapがそれぞれ更に一つ新しいストリームを参照してしまっているのでメモ化は全く効いていない。

メモ化を使わない場合は計算の重複は同じだが、ローカル変数を使わない場合再帰の度にストリームを作ってしまうのでリソース（メモリ）の面で異なる。

実験

(define (sqrt-stream1 x)
  (define guesses
    (cons-stream 1.0
                 (stream-map (lambda (guess) (display "guess = ")(display guess)(newline)
                               (sqrt-improve guess x))
                             guesses)))
  guesses)

(define (sqrt-stream2 x)
  (cons-stream 1.0
               (stream-map (lambda (guess) (display "guess = ")(display guess)(newline)
                             (sqrt-improve guess x))
                           (sqrt-stream2 x))))

こんな手続きにして呼び出してみる。

> (stream-ref (sqrt-stream1 2) 2)
guess = 1.0
guess = 1.5
1.4166666666666665
> (stream-ref (sqrt-stream2 2) 2)
guess = 1.0
guess = 1.0
guess = 1.5
1.4166666666666665
> (stream-ref (sqrt-stream1 2) 3)
guess = 1.0
guess = 1.5
guess = 1.4166666666666665
1.4142156862745097
> (stream-ref (sqrt-stream2 2) 3)
guess = 1.0
guess = 1.0
guess = 1.5
guess = 1.0
guess = 1.5
guess = 1.4166666666666665
1.4142156862745097
> (stream-ref (sqrt-stream1 2) 4)
guess = 1.0
guess = 1.5
guess = 1.4166666666666665
guess = 1.4142156862745097
1.4142135623746899
> (stream-ref (sqrt-stream2 2) 4)
guess = 1.0
guess = 1.0
guess = 1.5
guess = 1.0
guess = 1.5
guess = 1.4166666666666665
guess = 1.0
guess = 1.5
guess = 1.4166666666666665
guess = 1.4142156862745097
1.4142135623746899
>

sqrt-stream2の方もmemo-procは使用しているのに毎回1.0から計算してしまうのは毎回新しいストリームを作ってしまうから。

Exercise 3.64

memo-procが効いている事を前提に分かりやすいコードを目指すと

(define (stream-limit s tolerance)
  (let ((a (stream-car s))
        (b (stream-car (stream-cdr s))))
    (if (< (abs (- a b)) tolerance)
        b
        (stream-limit (stream-cdr s) tolerance))))

動作確認

> (sqrt 2 0.001)
1.4142135623746899
> (sqrt 2 0.00000000001)
1.414213562373095
>

Exercise 3.65

用意する材料。

(define (ln2-summands n)
  (cons-stream (/ 1.0 n)
               (stream-map - (ln2-summands (+ n 1)))))

(define ln2-stream (partial-sums (ln2-summands 1)))

単に級数の部分和を求める、オイラー変換で加速させる、タブローを使ってオイラー変換を更に加速させる方法を比較。

> (log 2)
0.6931471805599453
> (stream->list ln2-stream 10)
'(1.0
  0.5
  0.8333333333333333
  0.5833333333333333
  0.7833333333333332
  0.6166666666666666
  0.7595238095238095
  0.6345238095238095
  0.7456349206349207
  0.6456349206349207)
> (stream->list (euler-transform ln2-stream) 10)
'(0.7
  0.6904761904761905
  0.6944444444444444
  0.6924242424242424
  0.6935897435897436
  0.6928571428571428
  0.6933473389355742
  0.6930033416875522
  0.6932539682539683
  0.6930657506744464)
> (stream->list (accelerated-sequence euler-transform ln2-stream) 10)
'(1.0
  0.7
  0.6932773109243697
  0.6931488693329254
  0.6931471960735491
  0.6931471806635636
  0.6931471805604039
  0.6931471805599445
  0.6931471805599427
  0.6931471805599454)
>

オイラー変換を使った場合、更にタブローを使うと収束が早い事が見て取れる。

Infinite streams of pairs

2.2.3項半に出て来る和が素数となる整数のペアを選び出す問題。2.2.3では上限nを与えて有限のリストを使っていたが、無限ストリームとして実装すればプログラムはもっと簡単になる。
三角行列を３つの部分に分解して、それぞれの生成方法は分かるとして、第２、第3部分をどの様な順番で生成するのかが問題。

Exercise 3.66

(pairs integers integers)を実際に動かしてみる。

> (stream->list (pairs integers integers) 10)
'((1 1) (1 2) (2 2) (1 3) (2 3) (1 4) (3 3) (1 5) (2 4) (1 6))
>

ペア(i, j)が何番目に出現するのかiとjを使って一般式を出せるのかと言う問題。
ペアを30個くらい出力させて、その順番をプロットすると

	1	2	3	4	5	6	7	8	9	10	11	12	13	14	15	16
1	1	2	4	6	8	10	12	14	16	18	20	22	24	26	28	30
2		3	5	9	13	17	21	25	29
3			7	11	19	27
4				15	23

i=jの時、2ⁱ-1番目。
i=1でj>iの時は、2j-2番目。
i=2でj>iの時は、4j-7番目。
i=3でj>iの時は、8j-21番目。
i=4でj>iの時は、16j-57番目（？）。
jの係数は2ⁱなのは簡単に分かるが、引く数は少し難しい。
j-iに着目すると、
i=1でj>iの時は、2(j-i)番目。
i=2でj>iの時は、4(j-i)+1番目。
i=3でj>iの時は、8(j-i)+3番目。
i=4でj>iの時は、16(j-i)+7番目。
これは一般化できそう：2ⁱ(j - i)+(2^i-1-1)=2^i-1{2(j-i)+1}-1
この式をプログラムにしてみる。

(define (position-of i j)
  (if (= i j)
      (- (expt 2 i) 1)
      (- (* (expt 2 (- i 1)) (+ (* 2 (- j i)) 1)) 1)))

これで何番目か調べてみる。(1 100)は

> (position-of 1 100)
198
> (stream->list (pairs integers integers) 198)
'((1 1)
  (1 2)
  (2 2)
…中略
  (1 99)
  (2 51)
  (1 100))
>

198番目なので、その前には197個。
(99 100)は

> (position-of 99 100)
950737950171172051122527404031
> (stream->list (pairs integers integers) (number-of 99 100))

流石にこれは実験出来なかった。とりあえず(99 100)の前には950737950171172051122527404030個のペア。
更に(100 100)は

> (position-of 100 100)
1267650600228229401496703205375
>

(100 100)の前には1267650600228229401496703205374個のペア。

Exercise 3.67

(S₀, T₀)から右方向のストリームと下方向のストリームを混ぜて、最後に(S₁, T₁)以下のペアを混ぜる。

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

30個程表示してみると

> (stream->list (pairs integers integers) 30)
'((1 1)
  (1 2)
  (2 2)
  (2 1)
  (2 3)
  (1 3)
  (3 3)
  (3 1)
  (3 2)
  (1 4)
  (3 4)
  (4 1)
  (2 4)
  (1 5)
  (4 4)
  (5 1)
  (4 2)
  (1 6)
  (4 3)
  (6 1)
  (2 5)
  (1 7)
  (4 5)
  (7 1)
  (5 2)
  (1 8)
  (3 5)
  (8 1)
  (2 6)
  (1 9))
>

その順番は

	1	2	3	4	5	6	7	8	9
1	1	2	6	10	14	18	22	26	30
2	4	3	5	13	21	29
3	8	9	7	11	27
4	12	17	19	15	23
5	16	25
6	20
7	24
8	28

Exercise 3.68

pairs自身はcons-streamを使ってストリームを作らないので、interleaveを呼ぶ前に引数部分のstream-mapとpairsを評価してしまう。そうすると

pairsを呼ぶ
stream-mapを呼ぶ（(1,1)が返る）
pairsを呼ぶ
1. stream-mapを呼ぶ（(1,2)が返る）
2. pairsを呼ぶ
  1. stream-mapを呼ぶ（(1,2)が返る）
  2. pairsを呼ぶ

以下同文
となって無限ループ。

Exercise 3.69

pairsの定義のtのストリームの代わりにペアのストリームを埋め込む事を想定する。

(define (triples s t u)
  (cons-stream
   (list (stream-car s) (stream-car t) (stream-car u))
   (interleave
    (stream-map (lambda (p) (cons (stream-car s) p))
                (stream-cdr (pairs t u)))
   (triples (stream-cdr s) (stream-cdr t) (stream-cdr u)))))

(pairs t u)にstream-cdrを適用する所が不思議だが、これが無いと最初のlistで作った(1 1 1)をstream-mapの所でもう一度作ってしまうので、(pair t u)が最初に返す(1 1)を捨てる為にstream-cdrが必要。
動作確認

> (stream->list (triples integers integers integers) 10)
'((1 1 1) (1 1 2) (2 2 2) (1 2 2) (2 2 3) (1 1 3) (3 3 3) (1 2 3) (2 3 3) (1 1 4))
>

取り敢えずは目論見通り。
ピタゴラス数の集合を表すストリームは

(define Pythagorean-stream (stream-filter (lambda (t) (= (+ (square (car t)) (square (cadr t))) (square (caddr t))))
                                          (triples integers integers integers)))

動作確認

> (stream->list Pythagorean-stream 5)
'((3 4 5) (6 8 10) (5 12 13) (9 12 15) (8 15 17))
>

随分時間を掛けて漸く５つ探して来た。

Exercise 3.70

元の手続きmergeは二つのストリームに同じ値が出現した時にはs1の値のみを取ってs2の方の値は捨てていたが、ペアの場合はウェイトが同じだからといって片方を捨てるわけにはいかないので、とりあえずs1側のペアを優先して以下のコード。

(define (merge-weighted s1 s2 w)
  (cond ((stream-null? s1) s2)
        ((stream-null? s2) s1)
        (else
         (let ((s1car (stream-car s1))
               (s2car (stream-car s2)))
           (if (> (w s1car) (w s2car))
               (cons-stream s2car (merge-weighted s1 (stream-cdr s2) w))
               (cons-stream s1car (merge-weighted (stream-cdr s1) s2 w)))))))

(define (weighted-pairs s t w)
  (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) w)
    w)))

(define (weight-pair-a p)
  (+ (car p) (cadr p)))

超簡単なウェイト関数で、実行結果は

> (stream->list (weighted-pairs integers integers weight-pair-a) 30)
'((1 1)
  (1 2)
  (1 3)
  (2 2)
  (1 4)
  (2 3)
  (1 5)
  (2 4)
  (3 3)
  (1 6)
  (2 5)
  (3 4)
  (1 7)
  (2 6)
  (3 5)
  (4 4)
  (1 8)
  (2 7)
  (3 6)
  (4 5)
  (1 9)
  (2 8)
  (3 7)
  (4 6)
  (5 5)
  (1 10)
  (2 9)
  (3 8)
  (4 7)
  (5 6))
>

b.
要はハミング数ではない数同士のペア。ハミング数を判定する述語を作ってフィルタではnotで反転させる。ウェイトは簡単な式。

(define (hamming-number? n)
  (or (= (remainder n 2) 0)
      (= (remainder n 3) 0)
      (= (remainder n 5) 0)))

(define non-hamming-integers (stream-filter (lambda (n) (not (hamming-number? n))) integers))

(define (weight-pair-b p)
  (let ((i (car p))
        (j (cadr p)))
    (+ (* 2 i) (* 3 j) (* 5 i j))))

> (stream->list (weighted-pairs non-hamming-integers non-hamming-integers weight-pair-b) 20)
'((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))
>

Exercise 3.71

Ramanujan numbersの数字だけを残しても分かりにくいので、該当するペアも含めて集めてみる。

(define (cube x) (* x x x))
  
(define (sum-cubes p)
  (+ (cube (car p)) (cube (cadr p))))

(define (find-duplicated-weights s w)
  (let ((s1 (stream-car s))
        (s2 (stream-car (stream-cdr s))))
    (let ((w1 (w s1))
          (w2 (w s2)))
      (if (= w1 w2)
          (cons-stream (list w1 s1 s2)
                       (find-duplicated-weights (stream-cdr s) w))
          (find-duplicated-weights (stream-cdr s) w)))))

(define ramanujan-numbers (find-duplicated-weights (weighted-pairs integers integers sum-cubes) sum-cubes))

最初の６個を表示してみる。

> (stream->list ramanujan-numbers 6)
'((1729 (1 12) (9 10))
  (4104 (2 16) (9 15))
  (13832 (2 24) (18 20))
  (20683 (10 27) (19 24))
  (32832 (4 32) (18 30))
  (39312 (2 34) (15 33)))
>

Exercise 3.72

Exercise 3.71のプログラムを3つのペアを比較する版に変更すれば動くが、一般化してみる。同じウェイトになるペアをリストにして集める。その数が3になるケースをリストに纏めて行く。

(define (common-weight-pairs s w)
  (define (pairs-with-weight weight s w)
    (if (= weight (w (stream-car s)))
        (cons (stream-car s) (pairs-with-weight weight (stream-cdr s) w))
        '()))
  (let ((w1 (w (stream-car s))))
    (cons (stream-car s) (pairs-with-weight w1 (stream-cdr s) w))))

(define (find-common-weight-pairs n s w)
  (let ((pairs (common-weight-pairs s w)))
    (if (= n (length pairs))
        (cons-stream (cons (w (car pairs)) pairs)
                     (find-common-weight-pairs n (stream-cdr s) w))
        (find-common-weight-pairs n (stream-cdr s) w))))

これで

(define square-triplicated-numbers (find-common-weight-pairs 3 (weighted-pairs integers integers sum-squares) sum-squares))

動かすと

> (stream->list square-triplicated-numbers 6)
'((325 (1 18) (6 17) (10 15))
  (425 (5 20) (8 19) (13 16))
  (650 (5 25) (11 23) (17 19))
  (725 (7 26) (10 25) (14 23))
  (845 (2 29) (13 26) (19 22))
  (850 (3 29) (11 27) (15 25)))
>

Exercise 3.71のramanujan-numbersは以下の様に定義出来る。

(define ramanujan-numbers (find-common-weight-pairs 2 (weighted-pairs integers integers sum-cubes) sum-cubes))

動かすと

> (stream->list ramanujan-numbers 6)
'((1729 (1 12) (9 10))
  (4104 (2 16) (9 15))
  (13832 (2 24) (18 20))
  (20683 (10 27) (19 24))
  (32832 (4 32) (18 30))
  (39312 (2 34) (15 33)))
>

Streams as signals

電気信号の積分器のシミュレート。ここでも常に同じストリームを参照する様にローカル変数intを拘束している。Figure 3.32の点線で描かれたinitial-valueは「最初に１回だけ足す」と言う意味か？

Exercise 3.73

式をそのままプログラムにすると

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

(define RC1 (RC 5 1 0.5))

入力が電流なのでどんな反応が正しいのか良く分からない。

> (stream->list (RC1 ones 10) 10)
'(15 15.5 16.0 16.5 17.0 17.5 18.0 18.5 19.0 19.5)
>

一定の電流を送り込めば当然電圧は上がって行く。

Exercise 3.74

もうちょっと多目のデータでチェック出来る様にsinを使った入力のストリームを作る。

(define sin-stream (stream-map (lambda (i) (sin (* i (/ pi 3)))) integers))

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

(define sense-data sin-stream)

問題の関数はmapに一つズレた信号値が渡れば良いのだが、少しトリッキーなのは後ろのストリームは一つ遡ったデータを供給する事。逆であればstream-cdrを取るだけだが、一つ後ろにずらす必要があるのでダミーのデータを付け加える。

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

動作確認

> (stream->list sin-stream 10)
'(0.8660254037844386
  0.8660254037844388
  1.2246467991473532e-16
  -0.8660254037844384
  -0.866025403784439
  -2.4492935982947064e-16
  0.8660254037844384
  0.8660254037844392
  3.6739403974420594e-16
  -0.8660254037844378)
> (stream->list zero-crossings 10)
'(0 0 0 -1 0 0 1 0 0 -1)
>

Exercise 3.75

再帰の際にavpt（平均値）を次のlast-valueとして渡している。これが必ずしも悪いとは言えないが

to extract the zero crossings from the signal constructed by averaging each value of the sense data with the previous value.

これは各信号値と一つ前の信号値との平均の符号が反転したかを判定する事を意図しているが、Louisの実装では段々重みは小さくなるとは言えそれよりも前の信号値も平均に含まれてしまっているのでAlyssaの意図とは異なる。

平均値を取るには前回の信号値
符号反転の判定には前回の平均値

がそれぞれ必要なので引数を増やす。

(define (make-zero-crossings2 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-crossings2 (stream-cdr input-stream)
                                       (stream-car input-stream)
                                      avpt))))

ノイズを含んだ信号のシミュレートとして二つのsinカーブを組み合わせたストリームを使う。

(define (sin-stream denom)
  (stream-map (lambda (i) (sin (* i (/ pi denom)))) integers))
(define noizy-sin-stream (add-streams (scale-stream (sin-stream 12) 2)
                                      (sin-stream 2)))

noizy-sin-streamの出力は

> (stream->list noizy-sin-stream 20)
'(1.5176380902050415
  1.0
  0.4142135623730949
  1.732050807568877
  2.9318516525781364
  2.0000000000000004
  0.9318516525781366
  1.7320508075688772
  2.414213562373095
  1.0000000000000013
  -0.48236190979495797
  -4.898587196589412e-16
  0.4823619097949593
  -0.9999999999999987
  -2.414213562373094
  -1.7320508075688776
  -0.9318516525781362
  -1.999999999999999
  -2.931851652578137
  -1.7320508075688794)
>

これを修正したmake-zero-crossingsで判定すると

> (stream->list (make-zero-crossings noizy-sin-stream 0 0) 20)
'(0 0 0 0 0 0 0 0 0 0 0 -1 1 -1 0 0 0 0 0 0)
>

ノイズの幅が大き過ぎたか。
ちなみに元の（バグありの）定義では

> (stream->list (make-zero-crossings-org noizy-sin-stream 0) 20)
'(0 0 0 0 0 0 0 0 0 0 0 0 0 -1 0 0 0 0 0 0)
>

なのでこちらの方が実は良い。いくつのデータで平均化するかはノイズの大きさや周期による。

Exercise 3.76

余り凝る事は無く一つ先に進めたストリームとそのままのストリームをstream-mapに渡せば簡単。

(define (average a b) (/ (+ a b)))

(define (smooth stream)
  (stream-map (lambda (a b) (average a b)) (stream-cdr stream) stream))

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

実行結果

> (stream->list (zero-crossings (smooth noizy-sin-stream)) 20)
'(0 0 0 0 0 0 0 0 0 0 -1 1 -1 0 0 0 0 0 0 0)
>

	1	2	3	4	5	6	7	8	9	10	11	12	13	14	15	16
1	1	2	4	6	8	10	12	14	16	18	20	22	24	26	28	30
2		3	5	9	13	17	21	25	29
3			7	11	19	27
4				15	23

	1	2	3	4	5	6	7	8	9
1	1	2	6	10	14	18	22	26	30
2	4	3	5	13	21	29
3	8	9	7	11	27
4	12	17	19	15	23
5	16	25
6	20
7	24
8	28

	1	2	3	4	5	6	7	8	9	10	11	12	13	14	15	16
1	1	2	4	6	8	10	12	14	16	18	20	22	24	26	28	30
2		3	5	9	13	17	21	25	29
3			7	11	19	27
4				15	23

	1	2	3	4	5	6	7	8	9
1	1	2	6	10	14	18	22	26	30
2	4	3	5	13	21	29
3	8	9	7	11	27
4	12	17	19	15	23
5	16	25
6	20
7	24
8	28

	1	2	3	4	5	6	7	8	9	10	11	12	13	14	15	16
1	1	2	4	6	8	10	12	14	16	18	20	22	24	26	28	30
2		3	5	9	13	17	21	25	29
3			7	11	19	27
4				15	23

	1	2	3	4	5	6	7	8	9
1	1	2	6	10	14	18	22	26	30
2	4	3	5	13	21	29
3	8	9	7	11	27
4	12	17	19	15	23
5	16	25
6	20
7	24
8	28