Add implementation of exercise 3-82

Author: ramsayleung

README.org

@@ -25,7 +25,7 @@
   习题完成情况:
   - 章节一: 43/46
   - 章节二: 88/97
-  - 章节三: 71/82
+  - 章节三: 72/82
   - 章节四: TODO
   - 章节五: TODO
 * 运行
@@ -144,6 +144,22 @@
      #+end_src
 
      这里的蒙特卡罗实现真的是优雅
+
+     而基于流的实现更是优美:
+
+     #+begin_src scheme
+       (define (monte-carlo experiment-stream passed failed)
+         (define (next passed failed)
+           (cons-stream
+            (/ passed (+ passed failed))
+            (monte-carlo
+             (stream-cdr experiment-stream)
+             passed
+             failed)))
+         (if (stream-car experiment-stream)
+             (next (+ passed 1) failed)
+             (next passed (+ failed 1))))
+     #+end_src
 ** 翻译错误
    第2版，238页，模块化，对象和状态，中文翻译是
    #+begin_quote

chapter3/exercise3-5.rkt

@@ -20,19 +20,20 @@
                            (abs (- y1 y2)))))
     (* (exact->inexact rectangle-area) (monte-carlo trials experiment))))
 
+;; 以(5,7)为圆心，半径为3的圆，以(2,4)和(8,10)作为对角点的矩形包围着
+;; 这个圆, 计算这个圆的面积（假设 π未知），结果应该接近 28.274
+(define (square x)
+  (* x x))
+
+(define (in-circle? x y)
+  (<= (+ (square (- x 5)) (square (- y 7)))
+      (square 3)))
+(provide square in-circle?)
+
 (module+ test
   (require rackunit)
   (require rackunit/text-ui)
 
-  ;; 以(5,7)为圆心，半径为3的圆，以(2,4)和(8,10)作为对角点的矩形包围着
-  ;; 这个圆, 计算这个圆的面积（假设 π未知），结果应该接近 28.274
-  (define (square x)
-    (* x x))
-
-  (define (in-circle? x y)
-    (<= (+ (square (- x 5)) (square (- y 7)))
-        (square 3)))
-
   (define (estimate-area-close? trials tolerance)
     (let ((area-estimate (estimate-integral in-circle? 2 8 4 10 trials)))
       (< (abs (- area-estimate 28.27431)) tolerance)))

chapter3/exercise3-82.rkt

@@ -0,0 +1,44 @@
+#lang racket
+(require "stream.rkt")
+(require "infinite-stream.rkt")
+(require "exercise3-50.rkt")
+(require "exercise3-5.rkt")
+
+(define (map-successive-pairs f s)
+  (if (stream-null? s)
+      the-empty-stream
+      (let ((head (stream-car s)))
+        (if (pair? head)
+            (cons-stream
+             (f (car head) (cadr head))
+             (map-successive-pairs f (stream-cdr s)))
+            (error "uknown parameter type " head)))))
+
+(define (integral-experience-stream predicate x1 x2 y1 y2)
+  (map-successive-pairs predicate
+                        (map-stream list
+                                    (random-range-stream x1 x2)
+                                    (random-range-stream y1 y2))))
+
+(define (estimate-integral-stream predicate x1 x2 y1 y2)
+  (let ((rectangle-area (* (abs (- x1 x2))
+                           (abs (- y1 y2)))))
+    (stream-map (lambda (p) (* (exact->inexact rectangle-area) p))
+                (monte-carlo (integral-experience-stream predicate x1 x2 y1 y2) 0 0)))
+  )
+
+(module+ test
+  (require rackunit)
+  ;; 以(5,7)为圆心，半径为3的圆，以(2,4)和(8,10)作为对角点的矩形包围着
+  ;; 这个圆, 计算这个圆的面积（假设 π未知），结果应该接近 28.274
+  (define circle-area 28.27431)
+  (define (estimate-area-close? area-estimate tolerance)
+    (< (abs (- area-estimate circle-area)) tolerance))
+
+  (test-case "Test for estimate-integral-stream"
+             (define estimated-area-stream (estimate-integral-stream in-circle? 2 8 4 10))
+             (check-true (estimate-area-close? (stream-ref estimated-area-stream 10000) 2.0))
+             (check-true (estimate-area-close? (stream-ref estimated-area-stream 100000) 1.5))
+             (check-true (estimate-area-close? (stream-ref estimated-area-stream 1000000) 1.4))
+             )
+  )

chapter3/infinite-stream.rkt

@@ -57,6 +57,11 @@
   (cons-stream random-init
                (stream-map rand-update random-number-stream)))
 
+(define (random-range-stream low high)
+  (cons-stream (random-in-range low high)
+               (random-range-stream low high))
+  )
+
 (define (map-successive-pairs f s)
   (cons-stream
    (f (stream-car s) (stream-car (stream-cdr s)))
@@ -84,7 +89,7 @@
               (stream-filter (lambda (p) (not (= p 0)))
                              (monte-carlo cesaro-stream 0 0))))
 
-(provide add-streams scale-stream ones integers fibs interleave pairs integral monte-carlo)
+(provide add-streams scale-stream ones integers fibs interleave pairs integral monte-carlo random-range-stream map-successive-pairs)
 
 (module+ test
   (require rackunit)