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

いままで作ってきたいろいろの手続きを、smoothをつくって部品化するという話。
smoothを作ったら、あとは、問題3.74のスタイルで。


smooth手続きはかなり手こずって、テキトウにつくったら、
初項の答えが一個ずれた。ウーム。
という事で工夫して作ったのがこの答えです。

#!/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))




;; 3.75の答え
(define (make-zero-crossings-375 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-375 (stream-cdr input-stream)
                                      (stream-car input-stream)
                                      avpt))))


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



(define (smooth s)
  (define (avg a b)
    (/ (+ a b) 2.0))
  (stream-map avg (cons-stream 0 s) s))


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

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


;; main
(define (main args)

  (print "test for smooth")
  (stream-viewer (smooth integers) 0 10)
  (newline)

  (print "zero-crossings-375")
  (stream-viewer zero-crossings-375 0 11)
  (newline)

  (print "zero-crossings")
  (stream-viewer (zero-crossings sense-data) 0 11)
  (newline)

  0)


実行してみる。

test for smooth
start
0.5
1.5
2.5
3.5
4.5
5.5
6.5
7.5
8.5
9.5
end

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

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

多分できていると思います。