259 lines
6.5 KiB
Scheme
259 lines
6.5 KiB
Scheme
(load "util.scm")
|
|
|
|
(display "\nex-3.50 - stream-map\n")
|
|
|
|
(define (stream-enumerate-interval low high)
|
|
(if (> low high)
|
|
the-empty-stream
|
|
(cons-stream
|
|
low
|
|
(stream-enumerate-interval (+ low 1) high))))
|
|
|
|
(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))))))
|
|
|
|
(define (stream-to-list xs)
|
|
(if (stream-null? xs)
|
|
'()
|
|
(cons (stream-car xs)
|
|
(stream-to-list (stream-cdr xs)))))
|
|
|
|
(assert (stream-to-list (stream-enumerate-interval 1 3))
|
|
'(1 2 3))
|
|
|
|
(assert (stream-to-list
|
|
(stream-map (lambda (x y) (* x y))
|
|
(stream-enumerate-interval 1 3)
|
|
(stream-enumerate-interval -3 -1)))
|
|
'(-3 -4 -3))
|
|
|
|
(display "\nex-3.51\n")
|
|
|
|
(define x (stream-map show (stream-enumerate-interval 0 10)))
|
|
|
|
(stream-ref x 5)
|
|
; 0
|
|
; 1
|
|
; 2
|
|
; 3
|
|
; 4
|
|
; 5
|
|
|
|
(stream-ref x 7)
|
|
; 6
|
|
; 7
|
|
|
|
(display "\nex-3.52\n")
|
|
|
|
(define sum 0)
|
|
|
|
(define (accum x)
|
|
(set! sum (+ x sum))
|
|
sum)
|
|
|
|
(define seq (stream-map accum (stream-enumerate-interval 1 20)))
|
|
; 1 3 6 10 15 21 28 36 45 55 66 78 91 105 120 136 153 171 190 210
|
|
|
|
(define y (stream-filter even? seq))
|
|
; 6 10 28 36 66 78 120 136 190 210
|
|
|
|
(define z (stream-filter (lambda (x) (= (remainder x 5) 0))
|
|
seq))
|
|
|
|
(assert (stream-ref y 7) 136)
|
|
(assert (stream-to-list z)
|
|
'(10 15 45 55 105 120 190 210))
|
|
|
|
; The responses would differ if we had implemented delay without memo-proc,
|
|
; because the values of the stream would be recomputed for z starting from the
|
|
; last value of sum after defining y.
|
|
|
|
(display "\nexample - sieve of Eratosthenes\n")
|
|
|
|
(define (integers-starting-from n)
|
|
(cons-stream n (integers-starting-from (+ n 1))))
|
|
|
|
(define (divisible? x y) (= (remainder x y) 0))
|
|
|
|
(define (sieve stream)
|
|
(cons-stream
|
|
(stream-car stream)
|
|
(sieve (stream-filter
|
|
(lambda (x)
|
|
(not (divisible? x (stream-car stream))))
|
|
(stream-cdr stream)))))
|
|
|
|
(define primes (sieve (integers-starting-from 2)))
|
|
|
|
(assert (stream-ref primes 5) 13)
|
|
|
|
(display "\nex-3.53\n")
|
|
|
|
(define ones (cons-stream 1 ones))
|
|
|
|
(define integers (cons-stream 1 (add-streams ones integers)))
|
|
|
|
(assert (take 3 integers)
|
|
'(1 2 3))
|
|
|
|
(define fibs
|
|
(cons-stream 0
|
|
(cons-stream 1
|
|
(add-streams (stream-cdr fibs)
|
|
fibs))))
|
|
|
|
(assert (take 7 fibs)
|
|
'(0 1 1 2 3 5 8))
|
|
|
|
(define double (cons-stream 1 (scale-stream double 2)))
|
|
|
|
(assert (take 3 double)
|
|
'(1 2 4))
|
|
|
|
(define s (cons-stream 1 (add-streams s s)))
|
|
(assert (take 5 s)
|
|
'(1 2 4 8 16))
|
|
|
|
(display "\nex-3.54 - factorials\n")
|
|
|
|
(define (mul-streams s1 s2)
|
|
(stream-map * s1 s2))
|
|
|
|
(define factorials (cons-stream 1 (mul-streams (stream-cdr integers) factorials)))
|
|
|
|
(assert (take 5 factorials)
|
|
'(1 2 6 24 120))
|
|
|
|
(display "\nex-3.55 - partial-sums\n")
|
|
|
|
(define (partial-sums xs)
|
|
(cons-stream (stream-car xs)
|
|
(add-streams (partial-sums xs)
|
|
(stream-cdr xs))))
|
|
|
|
(assert (take 5 (partial-sums integers))
|
|
'(1 3 6 10 15))
|
|
|
|
(display "\nex-3.56 - enumerate multiplies of 2, 3, 5\n")
|
|
|
|
(define (merge s1 s2)
|
|
(cond ((stream-null? s1) s2)
|
|
((stream-null? s2) s1)
|
|
(else
|
|
(let ((s1car (stream-car s1))
|
|
(s2car (stream-car s2)))
|
|
(cond ((< s1car s2car)
|
|
(cons-stream s1car (merge (stream-cdr s1) s2)))
|
|
((> s1car s2car)
|
|
(cons-stream s2car (merge s1 (stream-cdr s2))))
|
|
(else
|
|
(cons-stream s1car
|
|
(merge (stream-cdr s1)
|
|
(stream-cdr s2)))))))))
|
|
|
|
(define S (cons-stream 1 (merge (merge (scale-stream S 2) (scale-stream S 3))
|
|
(scale-stream S 5))))
|
|
|
|
(assert (take 10 S)
|
|
'(1 2 3 4 5 6 8 9 10 12))
|
|
|
|
(display "\nex-3.57\n")
|
|
(display "[answered]\n")
|
|
|
|
; With memoizing only one addition is required per number. So the complexity is
|
|
; O(n). With memoizing the previous numbers have to be calculated recursively
|
|
; which leads to exponential growth.
|
|
|
|
(display "\nex-3.58 - expand\n")
|
|
|
|
(define (expand num den radix)
|
|
(cons-stream
|
|
(quotient (* num radix) den)
|
|
(expand (remainder (* num radix) den) den radix)))
|
|
|
|
(assert (take 5 (expand 1 7 10))
|
|
'(1 4 2 8 5))
|
|
|
|
(assert (take 5 (expand 3 8 10))
|
|
'(3 7 5 0 0))
|
|
|
|
; The procedure expands a fraction (num/dem) into the rational value to base
|
|
; radix.
|
|
|
|
(display "\nex-3.59 - sine/cosine series\n")
|
|
|
|
(define (integrate-series xs)
|
|
(define (iter n xs)
|
|
(cons-stream (* (/ 1 n) (stream-car xs))
|
|
(iter (+ n 1) (stream-cdr xs))))
|
|
(iter 1 xs))
|
|
|
|
(define (integrate-series xs)
|
|
(stream-map * (stream-map / ones integers) xs))
|
|
|
|
(assert (take 5 (integrate-series integers))
|
|
'(1 1 1 1 1))
|
|
|
|
(define exp-series
|
|
(cons-stream 1 (integrate-series exp-series)))
|
|
|
|
(define (sum xs)
|
|
(if (null? xs)
|
|
0
|
|
(+ (car xs) (sum (cdr xs)))))
|
|
|
|
(assert (sum (take 5 exp-series))
|
|
(/ 65 24))
|
|
|
|
(define cosine-series
|
|
(cons-stream 1 (stream-map - (integrate-series sine-series))))
|
|
|
|
(define sine-series
|
|
(cons-stream 0 (integrate-series cosine-series)))
|
|
|
|
(assert (sum (take 10 sine-series))
|
|
(/ 305353 362880))
|
|
|
|
(display "\nex-3.60 - mul-series\n")
|
|
|
|
(define add-series add-streams)
|
|
|
|
(define (mul-series s1 s2)
|
|
(cons-stream (* (stream-car s1) (stream-car s2))
|
|
(add-streams (scale-stream (stream-cdr s2) (stream-car s1))
|
|
(mul-series (stream-cdr s1) s2)))))
|
|
|
|
(assert (sum (take 10 (add-series (mul-series cosine-series cosine-series)
|
|
(mul-series sine-series sine-series))))
|
|
1)
|
|
|
|
(display "\nex-3.61 - invert-unit-series\n")
|
|
|
|
(define (invert-unit-series s)
|
|
(cons-stream 1 (mul-series (stream-map - (stream-cdr s))
|
|
(invert-unit-series s))))
|
|
|
|
(define X (invert-unit-series cosine-series))
|
|
|
|
(assert (sum (take 10 (mul-series cosine-series X)))
|
|
1)
|
|
|
|
(display "\nex-3.62 - tan\n")
|
|
|
|
(define (div-series ns ds)
|
|
(if (= (stream-car ds) 0)
|
|
(error "denominator is zero -- DIV-SERIES" ds)
|
|
(mul-series ns (invert-unit-series ds))))
|
|
|
|
(define tan-series (div-series sine-series cosine-series))
|
|
|
|
(assert (< (abs (- (exact->inexact (sum (take 20
|
|
(div-series sine-series cosine-series))))
|
|
1.5574)) 0.001) #t)
|
|
|