blob: 457efb8ded5b6e6cf2c2297e1c88573a7e0cacdc (
plain)
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
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
|
(use-modules (srfi srfi-41))
(define base (stream-from 1))
(define (curry f)
(lambda (x)
(lambda (y)
(f x y))))
(define-stream (stream-ordered-diff xstrm ystrm)
(stream-match xstrm (() '()) ((x . xs)
(stream-match ystrm (() xstrm) ((y . ys)
(if (eq? x y)
(stream-ordered-diff xs ys)
(stream-cons x (stream-ordered-diff xs ystrm))))))))
(define-stream (stream-merge xstrm ystrm)
(stream-match xstrm (() ystrm) ((x . xs)
(stream-match ystrm (() xstrm) ((y . ys)
(cond ((< x y) (stream-cons x (stream-merge xs ystrm)))
((> x y) (stream-cons y (stream-merge xstrm ys)))
((eq? x y) (stream-cons x (stream-merge xs ys)))))))))
(define (f i j)
(+ i j (* 2 i j)))
(define-stream (i-stream i)
(stream-map
((curry f) i)
(stream-from i)))
(define ij-stream
(stream-let loop ((n 1) (strm (i-stream 1)))
(let* ((cutoff ((curry >) (stream-car (i-stream n))))
(next (+ n 1))
(available (stream-take-while cutoff strm))
(remainder (stream-drop-while cutoff strm)))
(stream-append available (loop next (stream-merge remainder (i-stream next)))))))
(define-stream (sieve input)
(stream-map
(lambda (x) (+ 1 (* 2 x)))
(stream-ordered-diff input ij-stream)))
(define sundaram (stream-cons 2 (sieve base)))
|
