計算機プログラムの構造と解釈 第二版 P204 問題3.75

問題3.74で作ったmake-zero-crossingを変更し、
前の信号と今の信号の平均をとって平滑化し、比較するようにする。
その問題はLouis Reasonerが手を加えてくれているのだけれども、バグがあってそれを直す。ヒントは引数を増やせとある。
そういう問題。


Louis Reasonerは以下のような手続きを作ってくれた。以下は引用。

(define (make-zero-crossings input-stream last-value)
(let ((avpt (/ (+ (stream-car input-stream) last-value) 2)))
(cons-stream (sign-change-detector avpt last-value)
(make-zero-crossings (stream-cdr input-stream)
avpt))))

よく見るとちょっと変な感じ。
4, 5行目で平均を取った値avptを、last-valueとして与えている。
これだと次の値の比較の時に、再度平均を取る値がおかしな感じになってしまう。
比較を行うのは平均値同士で行った方が良さそうなので、それを引数として追加。
さらにlast-valueの値は、次の値の平均値を求めるために必要なのでやっぱり利用する。
という感じで実装してみる。

#!/usr/local/bin/gosh
;; -*- coding: utf-8 -*-

(load "./modules/stream.scm")


(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-viewer stream start count)

  (define (stream-initializer stream init-num)
    (if (= init-num 0) stream
      (stream-initializer (stream-cdr stream) (- init-num 1))))

  (define (show-stream stream count)
    (if (= count 0) (print "end")
      (begin
        (print (stream-car stream))
        (show-stream (stream-cdr stream) (- count 1)))))

  (begin
    (print "start")
    (show-stream (stream-initializer stream start) count)))


(define (sign-change-detector new-value old-value)
  (cond ((and (>= new-value 0) (< old-value 0)) 1)
        ((and (< new-value 0) (>= old-value 0)) -1)
        (else 0)))



(define sense-data
  (stream-map (lambda (x) (sin x)) integers))




;; Alyssa
(define (make-zero-crossings-alyssa input-stream last-value)
  (cons-stream
    (sign-change-detector (stream-car input-stream) last-value)
    (make-zero-crossings-alyssa (stream-cdr input-stream)
                         (stream-car input-stream))))

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


;; Louis reasoner with bug
(define (make-zero-crossings-bug input-stream last-value)
  (let ((avpt (/ (+ (stream-car input-stream) last-value) 2)))
    (cons-stream (sign-change-detector avpt last-value)
                 (make-zero-crossings-bug (stream-cdr input-stream)
                                      avpt))))


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


;; make-zerocrossing-bugを修正
;; 多分変更しなければいけないのは、last-valueのところにavptが入ってしまう事。
;; これだと平均同士を比較してないし、平均の作り方もおかしくなる。
(define (make-zero-crossings input-stream last-value last-avpt)
  (let ((avpt (/ (+ (stream-car input-stream) last-value) 2)))
    (cons-stream (sign-change-detector avpt last-avpt)
                 (make-zero-crossings (stream-cdr input-stream)
                                      (stream-car input-stream)
                                      avpt))))


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

;; main
(define (main args)

  (print "sense-data")
  (stream-viewer sense-data 0 10)
  (newline)

  (print "zero-crossings-alyssa")
  (stream-viewer zero-crossings-alyssa 0 10)
  (newline)

  (print "zero-crossings-bug")
  (stream-viewer zero-crossings-bug 0 10)
  (newline)

  (print "zero-crossings")
  (stream-viewer zero-crossings 0 10)
  (newline)

  0)


実行してみる

sense-data
start
0.8414709848078965
0.9092974268256817
0.1411200080598672
-0.7568024953079282
-0.9589242746631385
-0.27941549819892586
0.6569865987187891
0.9893582466233818
0.4121184852417566
-0.5440211108893699
end

zero-crossings-alyssa
start
0
0
0
-1
0
0
1
0
0
-1
end

zero-crossings-bug
start
0
0
0
-1
0
0
1
0
0
-1
end

zero-crossings
start
0
0
0
-1
0
0
1
0
0
-1
end

多分できていると思うんだけど、3つとも同じ出力になってしまった。
平滑化しないと答えが変わっちゃうような例が欲しいなぁ。