[jfriends:00465] 第１５回読書会議事録

[Suzuki Hidenao <suzuki@xxxxxxxxxxxxxxxxxxxxxxxxxx>]

こんにちは。
鈴木＠二村研です。

まず一つ目。
話題にのぼった SICM のURLです。

http://www-swiss.ai.mit.edu/~gjs/6946/sicm-html


二つ目。
memo-procの実装に関してです。
R.Kent Dybvig著の”プログラミング言語 Scheme”でも遅延評価に関して
とりあげていて、そこでの memo-procの実装がSICPに書かれているものと
違っていたからです。そこでは memo-proc を以下のように記述していました。

(define (memo-proc2 proc)
  (let ((already-run? nil) (result nil))
    (lambda ()
      (if already-run?
	  result
	  (let ((x (proc)))
	    (if already-run?
		result
		(begin (set! result x)
		       (set! already-run? #t)
		       result)))))))

元の memo-procとの違いは (proc) を評価したあとに
再び already-run? で分岐していることです。
こうすることで違いが出てくる例を示します。

(define count 0)
(define p
  (delay (begin (set! count (+ count 1))
		(if (> count x)
		    count
		    (+ x (force p))))))

(define x 5)
(force p)

これを delayを memo-proc で実装したときの値は 31
memo-proc2 で実装したときの値は 6 となります。
そして scm上で定義されている delayで実行した場合は 6
MIT Schemeで定義されている delayで実行した場合も 6となりました。

なぜ各々がこの値になるかは (+ x (force p)) を
(cons x (force p)) としたほうが分りやすいでしょう。
つまり、最初に pを評価した値を保存しておくと言う原則で
あれば後者のほうも確かに納得のゆく結果ではないかとおもうのですが、
皆さんの意見はいかがでしょうか？

ちなみに、Revised5 Report on the Algorithmic Language Scheme
では上記のようなmemo-proc2 の書き方に関してこう記述されています。

上記最後のサンプル（上の例のこと）にあるように、（＊）契約はそれ自身の
値を参照することができる。こういった契約の実施により、最初の実施の値が
算出される前に二度目の契約が実施される場合がある。このため
make-promise（ここでは memo-proc2のこと）の定義が複雑なものとなっている。


（＊）ここでいう契約とは forceプロシージャにより (delay 式) 中の
の式の評価を実施して結果の値を取得するためのオブジェクトを指す。




最後に議事録です。
delay, force, cons-stream  の実装は

force
(define (force delayed-object) (delayed-object))

メモバージョンの delay
(defmacro delay (exp) `(memo-proc (lambda () ,exp)))

メモなしバージョンの delay
(defmacro delay (exp) `(lambda () ,exp))

cons-stream
(defmacro cons-stream (a b) `(cons ,a (delay ,b)))

として、以降の問題を解いております。

今回はP187 「3.5 ストリーム」 から

問題3.50
(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))))))

問題3.51
(define (display-line x)
  (newline)
  (display x))

(define (show x)
  (display-line x)
  x)

;;実行結果

==> (define x (stream-map show (stream-enumerate-interval 0 10)))

0
x
==> (stream-ref x 5)

1
2
3
4
5
5
==> (stream-ref x 7)

6
7
7
==> (stream-ref x 2)
2
==> (stream-ref x 10)

8
9
10
10

	 
問題3.52
(define result '())
(define sum 0)
(define (accum x)
  (set! sum (+ x sum))
  (set! result (cons x result))
  sum)
(define seq (stream-map accum (stream-enumerate-interval 1 20)))
sum
result
(define y (stream-filter even? seq))
sum
result
(define z (stream-filter (lambda (x) (= (remainder x 5) 0))
                         seq))
sum
result
(stream-ref y 7)
sum
result
(display-stream z)
sum
result

;;実行結果 その１
==> (define sum 0)
sum
==> (define accum ..)
accum
==> (define seq ...)
seq
==> sum
1
==> (define y ...)
y
==> sum
6
==> (define z ...)
z
==> sum
10
==> (stream-ref y 7)
136
==> sum
136
==> (display-stream z)
10
15
45
55
105
120
190
210
done
==> sum
210

;;実行結果 その２（memo なし）
==> (define sum 0)
sum
==> (define accum ...)
accum
==> (define seq ...)
seq
==> sum
1
==> (define y ...)
y
==> sum
6
==> (define z ...)
z
==> sum
15
==> (stream-ref y 7)
162
==> sum
162
==> (display-stream z)
15
180
230
305
done
==> sum
362

加算の演算結果をみるだけじゃ分らないので
別の変数 result に cons したものを保存しておくと、
処理の流れが判り易くなる。

問題3.53

;;実行結果

==> (do ((i 0 (+ i 1))) ((> i 30) nil) (display-line (stream-ref s i)))

1
2
4
8
16
32
64
128
256
512
1024
2048
4096
8192
16384
32768
65536
131072
262144
524288
1048576
2097152
4194304
8388608
16777216
33554432
67108864
134217728
268435456
536870912
1073741824
#f

問題3.54
(define (mul-streams s1 s2)
  (stream-map * s1 s2))

;;実行結果

==> (define factorials (cons-stream  1 (mul-streams factorials integers)))
factorials
==> (do ((i 0 (+ i 1))) ((> i 30) nil) (display-line (stream-ref factorials i)))
1
1
2
6
24
120
720
5040
40320
362880
3628800
39916800
479001600
6227020800
87178291200
1307674368000
20922789888000
355687428096000
6402373705728000
121645100408832000
2432902008176640000
51090942171709440000
1124000727777607680000
25852016738884976640000
620448401733239439360000
15511210043330985984000000
403291461126605635584000000
10888869450418352160768000000
304888344611713860501504000000
8841761993739701954543616000000
265252859812191058636308480000000
#f


問題3.55

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

;;実行結果

==> (define result (partial-sums integers))
result
==> (do ((i 0 (+ i 1))) ((> i 10) nil) (display-line (stream-ref result i)))
1
3
6
10
15
21
28
36
45
55
66
#f


問題3.56

;;実行結果

(define S (cons-stream 1 
		       (merge 
			(merge (scale-stream S 2)
			       (scale-stream S 3))
			(scale-stream S 5))))
(do ((i 0 (+ i 1))) 
    ((> i 30) nil) 
  (display-line (stream-ref S i)))


s
==> 
1
2
3
4
5
6
8
9
10
12
15
16
18
20
24
25
27
30
32
36
40
45
48
50
54
60
64
72
75
80
81
#f


問題3.57

(define (plus-function)
  (let ((count 0))
    (define (plus a b)
      (begin
        (set! count (+ count 1))
        (+ a b)))
    (define (show-count) count)
    (define (reset!) (set! count 0))
    (define (dispatch m)
      (cond ((eq? m 'plus) plus)
            ((eq? m 'show) (show-count))
            ((eq? m 'reset!) (reset!))
            (else "ERROR unknown request -- PLUS-FUNCTION" m)))
  dispatch))

(define plus-ex (plus-function))
(define (plus a b) ((plus-ex 'plus) a b))
(define (show) (plus-ex 'show))
(define (reset!) (plus-ex 'reset!)) 


(define (add-streams-ex s1 s2)
  (stream-map plus s1 s2))

(define fibs
  (cons-stream 0
	       (cons-stream 1
			    (add-streams-ex (stream-cdr fibs)
					    fibs))))

;;実行結果

;;memo version
==> (reset!)
0
==> (stream-ref fibs 10)
55
==> (show)
9

;;non-memo version
==> (reset!)
0
==> (stream-ref fibs 10)
55
==> (show)
221


問題3.58

(define (expand num den radix)
  (cons-stream
   (quotient (* num radix) den)
   (expand (remainder (* num radix) den) den radix)))


;;実行結果
==> (define a1 (expand 1 7 10))
a1
==> (do ((i 0 (+ i 1)))
    ((> i 10) nil)
    (display-line (stream-ref a1 i)))

1
4
2
8
5
7
1
4
2
8
5
#f

(define a2 (expand 3 8 10))
(do ((i 0 (+ i 1)))
    ((> i 10) nil)
    (display-line (stream-ref a2 i)))
==> 
(define a2 (expand 3 8 10))
(do ((i 0 (+ i 1)))
    ((> i 10) nil)
    (display-line (stream-ref a2 i)))
a2
==> 
3
7
5
0
0
0
0
0
0
0
0
#f

問題3.59
(define (integrate-series coeff-stream)
  (let ((integers (integers-starting-from 1)))
    (stream-map (lambda (x y) (/ x y))
                coeff-stream
                integers)))

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

;; 余弦(cosine)の微分は正弦の符号を反転したもの
;; 正弦(sine)の微分は余弦

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

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

;;実行結果
(display-n-stream sine-series 10)
(display-n-stream cosine-series 10)
==> (display-n-stream sine-series 10)
0
1
0
-0.16666666666666665
0
0.008333333333333334
0
-1.984126984126984e-4
0
2.7557319223985894e-6
done
==> (display-n-stream cosine-series 10)
1
0
-0.5
0
0.04166666666666666
0
-0.0013888888888888888
0
2.4801587301587302e-5
0
done


問題3.60

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

;; mul-seriesを展開しつづけるのでこれだと無限ループに陥る
;; ので、やはり頭に cons-stream を付けておく必要がある
;;(define (mul-series s1 s2)
;;  (add-streams (stream-map (lambda (x) (* x (stream-car s1))) s2)
;;	       (mul-series (stream-cdr s1) s2)))

(define sine2-series (mul-series sine-series sine-series))
(define cos2-series (mul-series cosine-series cosine-series))
(define result (add-streams sine2-series cos2-series))

;;; 実行結果
==> (display-n-stream result 10)
1
0
0.0
0.0
5.551115123125783e-17
0.0
-6.938893903907228e-18
0.0
0.0
0.0
done


問題3.61

(define (sub-streams s1 s2)
  (stream-map - s1 s2))

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

;;実行結果

(define s (invert-unit-series cosine-series))
(define t (mul-series s cosine-series))

==> (display-n-stream s 10)
1
0
0.5
0.0
0.20833333333333334
0.0
0.08472222222222223
0.0
0.03435019841269842
0.0
done
==> (display-n-stream t 10)
1
0
0.0
0.0
6.938893903907228e-18
0.0
-1.5178830414797062e-18
0.0
1.0638733817514012e-18
0.0
done



問題3.62

(define (div-series s1 s2)
  (let ((head (stream-car s2)))
    (if (= head 0)
        (error "Bad denominator -- DIV-SERIES" s2)
        (let ((s3 (stream-map (lambda (x) (/ x head)) s2)))
          (let ((s4 (invert-unit-series s3)))
            (stream-map (lambda (x) (* x head))
                        (mul-series s1 s4)))))))

(define tangent-series (div-series sine-series cosine-series))
(define (x-series x)
  (define xs (cons-stream x xs))
  (cons-stream 1 (mul-streams xs (x-series x))))
(define (tan x n)
  (stream-ref (partial-sums (mul-streams tangent-series (x-series x))) n))
(define pi (* 4 (atan 1)))

;;実行結果
==> (tan (/ pi 4) 10)
0.9991710667988496
==> (tan (/ pi 4) 20)
0.9999991904960982
==> (tan (/ pi 4) 30)
0.9999999992094688
==> (tan (/ pi 4) 40)
0.999999999999228


------------------------------------------------------------------------
目指せ!! 商品券20万,旅行券20万,デジカメ,PS2,Xbox…ホームページコンテスト
             http://isweb.infoseek.co.jp/hp_daiou/?svx=971122