From: Ramakrishnan Muthukrishnan <vu3rdd@gmail.com>
Date: Sat, 9 Jul 2011 16:26:48 +0000 (+0530)
Subject: some updates to the stream functions
X-Git-Url: https://git.rkrishnan.org/components/listings/...?a=commitdiff_plain;h=cd4ea180edfd844ace169a561b5a7b41d8baab3e;p=sicp.git

some updates to the stream functions
---

diff --git a/src/sicp/streams.rkt b/src/sicp/streams.rkt
index f7b2717..42bde47 100644
--- a/src/sicp/streams.rkt
+++ b/src/sicp/streams.rkt
@@ -9,11 +9,24 @@
       (stream-ref (stream-cdr s)
                   (- n 1))))
 
+(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 (scale-stream stream factor)
+  (stream-map (lambda (x) (* x factor)) stream))
+
+#|
 (define (stream-map proc s)
   (if (stream-null? s)
       the-empty-stream
       (cons-stream (proc (stream-car s))
                    (stream-map proc (stream-cdr s)))))
+|#
 
 (define (stream-filter pred? s)
   (cond [(stream-null? s) the-empty-stream]
@@ -59,3 +72,36 @@
 (define (prime? n)
   (= (smallest-divisor n) n))
 
+
+;; infinite streams
+(define (integers-starting-from n)
+  (cons-stream n
+               (integers-starting-from (+ n 1))))
+
+(define integers (integers-starting-from 1))
+
+(define (add-streams s1 s2)
+  (stream-map + s1 s2))
+
+;; integers which are not a multiple of 7
+(define (divisible? a b) (= 0 (remainder a b)))
+
+(define no-sevens
+  (stream-filter (lambda (x) (not (divisible? x 7)))
+                 integers))
+
+;; fibonaci
+(define (fib-gen a b)
+  (cons-stream a (fib-gen b (+ a b))))
+
+(define fibs (fib-gen 0 1))
+
+;; sieve
+(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)))