223 lines
6.8 KiB
Scheme
223 lines
6.8 KiB
Scheme
(load "shared/util.scm")
|
|
|
|
(define (integral integrand initial-value dt)
|
|
(define int
|
|
(cons-stream initial-value
|
|
(add-streams (scale-stream integrand dt)
|
|
int)))
|
|
int)
|
|
|
|
(display "\nex-3.73 - RC\n")
|
|
|
|
(define (RC R C dt)
|
|
(define (rc-proc i v0)
|
|
(add-streams
|
|
(scale-stream i R)
|
|
(integral (scale-stream i (/ 1 C)) v0 dt)))
|
|
rc-proc)
|
|
|
|
(define RC1 (RC 5 1 0.5))
|
|
|
|
(assert (take 5 (RC1 ones 4.2))
|
|
'(9.2 9.7 10.2 10.7 11.2))
|
|
|
|
(display "\nex-3.74 - zero-crossings\n")
|
|
|
|
(define sense-data
|
|
(list->stream
|
|
'(1 2 1.5 1 0.5 -0.1 -2 -3 -2 -0.5 0.2 3 4)))
|
|
(define response '(0 0 0 0 0 -1 0 0 0 0 1 0))
|
|
|
|
(define (sign-change-detector s2 s1)
|
|
(cond
|
|
((and (< s1 0) (>= s2 0)) 1)
|
|
((and (>= s1 0) (< s2 0)) -1)
|
|
(else 0)))
|
|
|
|
(define (make-zero-crossings input-stream last-value)
|
|
(cons-stream
|
|
(sign-change-detector (stream-car input-stream) last-value)
|
|
(make-zero-crossings (stream-cdr input-stream)
|
|
(stream-car input-stream))))
|
|
|
|
(define zero-crossings (make-zero-crossings sense-data 0))
|
|
|
|
(assert (take 12 zero-crossings) response)
|
|
|
|
(define zero-crossings
|
|
(stream-map sign-change-detector
|
|
sense-data
|
|
(cons-stream 0 sense-data)))
|
|
|
|
(assert (take 12 zero-crossings) response)
|
|
|
|
(display "\nex-3.75 - averaged zero-crossings\n")
|
|
|
|
; Louis' solution uses the average value as last-value which means that the new
|
|
; value and the previous average are used for averaging and not simply two
|
|
; consecutive values as proposed by Alyssa.
|
|
|
|
(define (make-zero-crossings-avg 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-avg (stream-cdr input-stream)
|
|
(stream-car input-stream)
|
|
avpt))))
|
|
|
|
(display (take 12 (make-zero-crossings-avg sense-data 0 0))) (newline)
|
|
|
|
(display "\nex-3.76 - smooth zero-crossings\n")
|
|
|
|
(define (smooth xs)
|
|
(stream-map average xs (stream-cdr xs)))
|
|
|
|
(define (make-zero-crossings-smoothed input-stream last-value)
|
|
(make-zero-crossings (smooth input-stream) last-value))
|
|
|
|
(assert (take 11 (make-zero-crossings-smoothed sense-data 0))
|
|
'(0 0 0 0 0 -1 0 0 0 0 1))
|
|
|
|
(display "\nex-3.77 - lazy-integral\n")
|
|
|
|
(define (integral delayed-integrand initial-value dt)
|
|
(define int
|
|
(cons-stream initial-value
|
|
(let ((integrand (force delayed-integrand)))
|
|
(add-streams (scale-stream integrand dt)
|
|
int))))
|
|
int)
|
|
|
|
(define (solve f y0 dt)
|
|
(define y (integral (delay dy) y0 dt))
|
|
(define dy (stream-map f y))
|
|
y)
|
|
|
|
(assert (stream-ref (solve (lambda (y) y) 1 0.001) 1000) 2.716923932235896)
|
|
|
|
(define (integral delayed-integrand initial-value dt)
|
|
(cons-stream
|
|
initial-value
|
|
(let ((integrand (force delayed-integrand)))
|
|
(if (stream-null? integrand)
|
|
the-empty-stream
|
|
(integral (delay (stream-cdr integrand))
|
|
(+ (* dt (stream-car integrand)) initial-value)
|
|
dt)))))
|
|
|
|
(assert (stream-ref (solve (lambda (y) y) 1 0.001) 1000) 2.716923932235896)
|
|
|
|
(display "\nex-3.78 - solve-2nd\n")
|
|
|
|
(define (solve-2nd a b dt y0 dy0)
|
|
(define y (integral (delay dy) y0 dt))
|
|
(define dy (integral (delay ddy) dy0 dt))
|
|
(define ddy (add-streams (scale-stream dy a)
|
|
(scale-stream y b)))
|
|
y)
|
|
|
|
(assert (stream-ref (solve-2nd 1 0 0.0001 1 1) 10000)
|
|
2.7181459268252266) ; e
|
|
(assert (stream-ref (solve-2nd 0 -1 0.0001 1 0) 10472)
|
|
0.5000240628699462) ; cos pi/3 = 0.5
|
|
(assert (stream-ref (solve-2nd 0 -1 0.0001 0 1) 5236)
|
|
0.5000141490501059) ; sin pi/6 = 0.5
|
|
|
|
(display "\nex-3.79 - solve-2nd-general\n")
|
|
(display "[ok]\n")
|
|
|
|
(define (solve-2nd-general f y0 dy0 dt)
|
|
(define y (integral (delay dy) y0 dt))
|
|
(define dy (integral (delay ddy) dy0 dt))
|
|
(define ddy (stream-map f dy y))
|
|
y)
|
|
|
|
(display "\nex-3.80 - RLC\n")
|
|
|
|
(define (RLC R L C dt)
|
|
(define (rlc-proc vC0 iL0)
|
|
(define vC (integral (delay dvC) vC0 dt))
|
|
(define iL (integral (delay diL) iL0 dt))
|
|
(define dvC (scale-stream il (/ -1 C)))
|
|
(define diL
|
|
(add-streams
|
|
(scale-stream iL (/ (- R) L))
|
|
(scale-stream vC (/ 1 L))))
|
|
(cons vC iL))
|
|
rlc-proc)
|
|
|
|
(define RLC1 (RLC 1 1 0.2 0.1))
|
|
(display "[ok]\n")
|
|
|
|
(display "\nex-3.81 - random-stream\n")
|
|
|
|
(define (make-random-stream request-stream)
|
|
(define a 1664525)
|
|
(define c 1013904223)
|
|
(define m (expt 2 32))
|
|
(define new-random-stream
|
|
(cons-stream
|
|
0
|
|
(stream-map (lambda (x) (modulo (+ (* a x) c) m))
|
|
new-random-stream)))
|
|
(define (result-stream request-stream random-stream)
|
|
(cond
|
|
((eq? (stream-car request-stream) 'gen)
|
|
(cons-stream (stream-car random-stream)
|
|
(result-stream (stream-cdr request-stream)
|
|
(stream-cdr random-stream))))
|
|
((eq? (stream-car request-stream) 'reset)
|
|
(result-stream (stream-cdr request-stream) new-random-stream))
|
|
(else (error "Unsupported request"))))
|
|
(result-stream request-stream new-random-stream))
|
|
|
|
(define requests
|
|
(cons-stream
|
|
'gen (cons-stream 'gen (cons-stream 'gen (cons-stream 'reset (cons-stream 'gen
|
|
(cons-stream 'gen (cons-stream 'gen requests))))))))
|
|
|
|
(define rs (make-random-stream requests))
|
|
|
|
(assert (take 10 rs)
|
|
(take 10 rs))
|
|
|
|
(display "\nex-3.82 - estimate-integral-stream\n")
|
|
|
|
(define (rand) (random 65536))
|
|
|
|
(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))))
|
|
|
|
(define radius-circle 5000.)
|
|
|
|
(define (estimate-integral-stream P x1 x2 y1 y2)
|
|
; Probably this stream should be based on a random stream,
|
|
; but it does not really matter for the exercise.
|
|
(define (area-test-stream)
|
|
(cons-stream
|
|
(P (random-in-range x1 (inc x2))
|
|
(random-in-range y1 (inc y2)))
|
|
(area-test-stream)))
|
|
(let ((area-rectangle (* (abs (- x2 x1)) (abs (- y2 y1)))))
|
|
(stream-map (lambda (x) (* x area-rectangle))
|
|
(monte-carlo (area-test-stream) 0 0))))
|
|
|
|
(define (p x y) (<= (+ (square (- x radius-circle))
|
|
(square (- y radius-circle)))
|
|
(square radius-circle)))
|
|
|
|
(let ((area-circle-stream
|
|
(estimate-integral-stream p 0 (* 2 radius-circle)
|
|
0 (* 2 radius-circle))))
|
|
(let ((pi (/ (stream-ref area-circle-stream 10000)
|
|
(square radius-circle))))
|
|
(assert (< pi 3.4) #t)
|
|
(assert (> pi 3.0) #t)))
|
|
|