May 3rd, 2011
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
| (define (merge-weighted s1 s2 weight)
(cond ((stream-null? s1) s2)
((stream-null? s2) s1)
(else
(let ((s1car (stream-car s1))
(s2car (stream-car s2))
(weight-s1car (weight (stream-car s1)))
(weight-s2car (weight (stream-car s2))))
(cond ((< = weight-s1car weight-s2car)
(cons-stream s1car (merge-weighted (stream-cdr s1) s2 weight)))
(else
(cons-stream s2car (merge-weighted s1 (stream-cdr s2) weight))))))))
(define (weighted-pairs s t weight)
(cons-stream
(list (stream-car s) (stream-car t))
(merge-weighted
(stream-map (lambda (x) (list (stream-car s) x))
(stream-cdr t))
(weighted-pairs (stream-cdr s) (stream-cdr t) weight)
weight)))
(define (stream-ref s n)
(if (= n 0)
(stream-car s)
(stream-ref (stream-cdr s) (- n 1))))
(define (stream-for-each proc s n)
(cond ((stream-null? s) (newline))
((= n 0) (newline))
(else (begin (proc (stream-car s))
(stream-for-each proc (stream-cdr s) (- n 1))))))
(define (display-stream s n)
(stream-for-each display-line s n))
(define (display-line x)
(newline)
(display x)) |
a.
1
2
3
4
5
6
7
| (define (accumulated pair)
(let ((i (car pair))
(j (cadr pair)))
(+ i j)))
(define accumulated-pairs
(weighted-pairs integers integers accumulated)) |
Test:
1
2
3
4
5
6
7
8
9
10
11
| (display-stream accumulated-pairs 10)
(1 1)
(1 2)
(1 3)
(2 2)
(1 4)
(2 3)
(1 5)
(2 4)
(3 3)
(1 6) |
b.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
| (define (stream-filter pred stream)
(cond ((stream-null? stream) the-empty-stream)
((pred (stream-car stream))
(cons-stream (stream-car stream)
(stream-filter pred
(stream-cdr stream))))
(else (stream-filter pred (stream-cdr stream)))))
(define (divisible? n)
(or (= 0 (remainder n 2))
(= 0 (remainder n 3))
(= 0 (remainder n 5))))
(define (weight-non-divisible pair)
(let ((i (car pair))
(j (cadr pair)))
(+ (* 2 i) (* 3 j) (* 5 i j))))
(define non-divisible
(stream-filter (lambda (x) (not (divisible? x))) integers))
(define non-divisible-pairs
(weighted-pairs non-divisible non-divisible weight-non-divisible)) |
Test:
1
2
3
4
5
6
7
8
9
10
11
| (display-stream non-divisible-pairs 10)
(1 1)
(1 7)
(1 11)
(1 13)
(1 17)
(1 19)
(1 23)
(1 29)
(1 31)
(7 7) |
Tags: scheme, sicp
Posted in Computer Science | No Comments »
May 3rd, 2011
1
2
3
4
5
6
7
8
9
10
11
12
13
14
| (define (triples s t u)
(cons-stream
(list (stream-car s) (stream-car t) (stream-car u))
(interleave
(stream-map (lambda (x) (append (list (stream-car s)) x))
(stream-cdr (pairs t u)))
(triples (stream-cdr s) (stream-cdr t) (stream-cdr u)))))
(define pythagorean
(stream-filter
(lambda (x)
(= (+ (square (car x)) (square (cadr x)))
(square (caddr x))))
(triples integer integer integer))) |
Tags: scheme, sicp
Posted in Computer Science | No Comments »
May 3rd, 2011
Louis’s version causes an infinite loop because there is no delayed evaluation of the recursive call (using the cons-stream left out).
Tags: scheme, sicp
Posted in Computer Science | No Comments »
May 3rd, 2011
1
2
3
4
5
6
7
8
9
10
| (define (pairs s t)
(cons-stream
(list (stream-car s) (stream-car t))
(interleave
(stream-map (lambda (x) (list (stream-car s) x))
(stream-cdr t))
(interleave
(stream-map (lambda (x) (list x (stream-car t)))
(stream-cdr s))
(pairs (stream-cdr s) (stream-cdr t)))))) |
Tags: scheme, sicp
Posted in Computer Science | No Comments »
May 2nd, 2011
1
2
| (pairs integers integers)
=> (0,0), (0,1), (1,1), (0,2), (1,2), (2,2) ... |
| Pair |
Pos |
n |
| (1,1) |
1 |
1 |
| (1,2) |
2 |
2 |
| (2,2) |
3 |
|
| (1,3) |
4 |
3 |
| (2,3) |
5 |
|
| (1,4) |
6 |
4 |
| (3,3) |
7 |
|
| (1,5) |
8 |
5 |
| (2,4) |
9 |
|
| … |
… |
… |
(1,n) appears in position 2n-2. For n=100, 2·100-2=198 positions for (1,100).
Tags: scheme, sicp
Posted in Computer Science | No Comments »
May 2nd, 2011
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
| (define (ln2-summands n)
(cons-stream (/ 1.0 n)
(stream-map - (ln2-summands (+ n 1)))))
(define ln2-stream
(partial-sums (ln2-summands 1)))
(define (euler-transform s)
(let ((s0 (stream-ref s 0)) ; S[n-1]
(s1 (stream-ref s 1)) ; S[n]
(s2 (stream-ref s 2))) ; S[n+1]
(cons-stream (- s2 (/ (square (- s2 s1))
(+ s0 (* -2 s1) s2)))
(euler-transform (stream-cdr s)))))
(define (square n) (* n n))
(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)))
(define acc-ln2 (accelerated-sequence euler-transform
ln2-stream)) |
Convergence test:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
| (stream-ref acc-ln2 0)
=> 1.0
(stream-ref acc-ln2 1)
=> 0.7
(stream-ref acc-ln2 2)
=> 0.6932773109243697
(stream-ref acc-ln2 3)
=> 0.6931488693329254
(stream-ref acc-ln2 4)
=> 0.6931471960735491
(stream-ref acc-ln2 5)
=> 0.6931471806635636 |
Tags: scheme, sicp
Posted in Computer Science | No Comments »
May 2nd, 2011
1
2
3
4
5
6
| (define (stream-limit s t)
(let ((first (stream-car s))
(second (stream-car (stream-cdr s))))
(if (< (abs (- second first)) t)
second
(stream-limit (stream-cdr s) t)))) |
Tags: scheme, sicp
Posted in Computer Science | No Comments »