SICP/ex-3_50-xx.scm

(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 (show x)
  (display-line x)
  x)

(define (stream-ref s n)
  (if (= n 0)
      (stream-car s)
      (stream-ref (stream-cdr s) (- n 1))))

(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 (display-stream s)
  (stream-for-each display-line s))

(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 (add-streams s1 s2)
  (stream-map + s1 s2))

(define ones (cons-stream 1 ones))

(define integers (cons-stream 1 (add-streams ones integers)))

(define (take n xs)
  (if (= n 0)
    '()
    (cons (stream-car xs)
          (take (- n 1) (stream-cdr xs)))))

(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 (scale-stream stream factor)
  (stream-map (lambda (x) (* x factor)) stream))

(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")