;;;; Stream Implementation
(define (head s) (car s))
(define (tail s) ((cdr s)))
(define-syntax s-cons
(syntax-rules () ((s-cons h t) (cons h (lambda () t)))))
;;;; Stream Utility Functions
(define (from-By x s)
(s-cons x (from-By (+ x s) s)))
(define (take n s)
(cond ((> n 1) (cons (head s) (take (- n 1) (tail s))))
((= n 1) (list (head s))) ;; don't force it too soon
(else ())))
(define (drop n s)
(cond ((> n 0) (drop (- n 1) (tail s)))
(else s)))
(define (s-map f s)
(s-cons (f (head s)) (s-map f (tail s))))
(define (s-diff s1 s2)
(let ((h1 (head s1)) (h2 (head s2)))
(cond
((< h1 h2) (s-cons h1 (s-diff (tail s1) s2 )))
((< h2 h1) (s-diff s1 (tail s2)))
(else (s-diff (tail s1) (tail s2))))))
(define (s-union s1 s2)
(let ((h1 (head s1)) (h2 (head s2)))
(cond
((< h1 h2) (s-cons h1 (s-union (tail s1) s2 )))
((< h2 h1) (s-cons h2 (s-union s1 (tail s2))))
(else (s-cons h1 (s-union (tail s1) (tail s2)))))))
;;;; odd multiples of an odd prime
(define (mults p) (from-By (* p p) (* 2 p)))
;;;; The Sieve itself, bounded, ~ O(n^1.4) in n primes produced
;;;; (unbounded version runs at ~ O(n^2.2), and growing worse)
;;;; **only valid up to m**, includes composites above it
(define (primes-To m)
(define (sieve s)
(let ((p (head s)))
(cond ((> (* p p) m) s)
(else (s-cons p
(sieve (s-diff (tail s) (mults p))))))))
(s-cons 2 (sieve (from-By 3 2))))
;;;; all the primes' multiples, tree-merged, removed;
;;;; ~O(n^1.17..1.15) time in producing 100K .. 1M primes
;;;; ~O(1) space (O(pi(sqrt(m))) probably)
(define (primes-TM)
(define (no-mults-From from)
(s-diff (from-By from 2) (s-tree-join (s-map mults odd-primes))))
(define odd-primes
(s-cons 3 (no-mults-From 5)))
(s-cons 2 (no-mults-From 3)))
;;;; join an ordered stream of streams (here, of primes' multiples)
;;;; into one ordered stream, via an infinite right-deepening tree
(define (s-tree-join sts) ;; sts -> s
(define (join-With of-Tail sts) ;; sts -> s
(s-cons (head (head sts))
(s-union (tail (head sts)) (of-Tail (tail sts)))))
(define (pairs sts) ;; sts -> sts
(s-cons (join-With head sts) (pairs (tail (tail sts)))))
(join-With (lambda (t) (s-tree-join (pairs t))) sts))
;;;; Print 10 last primes from the first thousand primes
(begin
(display (take 10 (drop 990 (primes-To 7919)))) (newline)
(display (take 10 (drop 9990 (primes-TM)))) (newline)
(display (take 4 (s-map / (from-By 4 -1)))) (newline) ; SRFI-41's premise disproved
)