Implement till 3.66

main
Felix Martin 2021-01-05 09:44:02 -05:00
parent aab9d1bec3
commit cce800e61c
3 changed files with 130 additions and 25 deletions

View File

@ -34,15 +34,6 @@
(display "\nex-3.51\n")
(define (show x)
(display-line x)
x)
(define (stream-ref s n)
(if (= n 0)
(stream-car s)
(stream-ref (stream-cdr s) (- n 1))))
(define x (stream-map show (stream-enumerate-interval 0 10)))
(stream-ref x 5)
@ -59,9 +50,6 @@
(display "\nex-3.52\n")
(define (display-stream s)
(stream-for-each display-line s))
(define sum 0)
(define (accum x)
@ -106,19 +94,10 @@
(display "\nex-3.53\n")
(define (add-streams s1 s2)
(stream-map + s1 s2))
(define ones (cons-stream 1 ones))
(define integers (cons-stream 1 (add-streams ones integers)))
(define (take n xs)
(if (= n 0)
'()
(cons (stream-car xs)
(take (- n 1) (stream-cdr xs)))))
(assert (take 3 integers)
'(1 2 3))
@ -131,9 +110,6 @@
(assert (take 7 fibs)
'(0 1 1 2 3 5 8))
(define (scale-stream stream factor)
(stream-map (lambda (x) (* x factor)) stream))
(define double (cons-stream 1 (scale-stream double 2)))
(assert (take 3 double)

View File

@ -1,4 +1,104 @@
(load "util.scm")
(display "\nex-3.63\n")
(define (pi-summands n)
(cons-stream (/ 1. n)
(stream-map - (pi-summands (+ n 2)))))
(define pi-stream
(scale-stream (partial-sums (pi-summands 1)) 4))
(define (euler-transform s)
(let ((s0 (stream-ref s 0)) ; Sn-1
(s1 (stream-ref s 1)) ; Sn
(s2 (stream-ref s 2))) ; Sn+1
(cons-stream (- s2 (/ (square (- s2 s1))
(+ s0 (* -2 s1) s2)))
(euler-transform (stream-cdr s)))))
(define (make-tableau transform s)
(cons-stream s
(make-tableau transform
(transform s))))
(define (accelerated-sequence transform s)
(stream-map stream-car
(make-tableau transform s)))
; (display (take 5 pi-stream))
; (newline)
; (display (take 5 (euler-transform pi-stream)))
; (newline)
; (display (take 5 (accelerated-sequence euler-transform pi-stream)))
; (newline)
(display "\nex-3.63 - sqrt-stream\n")
(define (sqrt-improve guess x)
(average guess (/ x guess)))
(define (sqrt-stream x)
(cons-stream 1.0
(stream-map (lambda (guess)
(sqrt-improve guess x))
(sqrt-stream x))))
(define (sqrt-stream x)
(define guesses
(cons-stream 1.0
(stream-map (lambda (guess)
(sqrt-improve guess x))
guesses)))
guesses)
(display (stream-ref (sqrt-stream 2) 1000))
(newline)
; The first implementation of sqrt-stream computes each value of the stream
; only once. Louis' suggestion computes all previous values because of the
; recursive calls to sqrt-stream. If memoization was not used the two solutions
; would behave in the same way.
(display "\nex-3.64 - stream-limit\n")
(define (stream-limit stream tolerance)
(if (< (abs (- (stream-car stream)
(stream-car (stream-cdr stream))))
tolerance)
(stream-car (stream-cdr stream))
(stream-limit (stream-cdr stream) tolerance)))
(define (sqrt-tol x tolerance)
(stream-limit (sqrt-stream x) tolerance))
(assert (< (abs (- 1.4142135623730951 (sqrt-tol 2 0.01)))
0.01) #t)
(assert (< (abs (- 4.795831523312719 (sqrt-tol 23 0.001)))
0.001) #t)
(display "\nex-3.65 - ln2\n")
(define (ln2-summands n)
(cons-stream (/ 1. n)
(stream-map - (ln2-summands (+ n 1)))))
(define ln2-stream
(partial-sums (ln2-summands 1)))
; slow
(define (ln2-tol tolerance)
(stream-limit ln2-stream tolerance))
; fast
(define (ln2-tol tolerance)
(stream-limit (accelerated-sequence euler-transform ln2-stream) tolerance))
(assert (ln2-tol 0.00000000001)
0.6931471805599445)
; The series converges slowly. Only with acceleration we get a good result in
; reasonable time.
(display "\nex-3.66\n")
; (display "\nex-3.67\n")

View File

@ -68,4 +68,33 @@
(display x)
(newline))
(define (take n xs)
(if (= n 0)
'()
(cons (stream-car xs)
(take (- n 1) (stream-cdr xs)))))
(define (display-stream s)
(stream-for-each display-line s))
(define (show x)
(display-line x)
x)
(define (stream-ref s n)
(if (= n 0)
(stream-car s)
(stream-ref (stream-cdr s) (- n 1))))
(define (partial-sums xs)
(cons-stream (stream-car xs)
(add-streams (partial-sums xs)
(stream-cdr xs))))
(define (scale-stream stream factor)
(stream-map (lambda (x) (* x factor)) stream))
(define (add-streams s1 s2)
(stream-map + s1 s2))
'util-loaded