Pasted

#lang racket
(require rackunit) ; for check-equal?
(provide (all-defined-out))
 
;; The book code and examples from sections 3.5.1 and 3.5.2.
 
;; Racket has built-in streams, but this is the book implementation.  Use
;; define-syntax-rule to create the new special forms my-delay and cons-stream.
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 3.5.1 STREAM IMPLEMENTATION AND PROCEDURES ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
(define (memo-proc proc)
  (define already-run? false)
  (define result false)
  (lambda ()
    (cond [(not already-run?)
           (set! result (proc))
           (set! already-run? true)
           result]
          [else result])))
 
(define-syntax-rule (my-delay e) (memo-proc (lambda () e)))
(define (my-force delayed-object) (delayed-object))
 
(define (stream-car s) (car s))
(define (stream-cdr s) (my-force (cdr s)))
 
;; Use this definition of cons-stream for memoized streams.
(define-syntax-rule (cons-stream a b) (cons a (my-delay b)))
 
;; ;; Use this definition of cons-stream for un-memoized streams.
;; (define-syntax-rule (no-memo-delay e) (lambda () e))
;; (define-syntax-rule (cons-stream a b) (cons a (no-memo-delay b)))
 
(define the-empty-stream empty)
(define stream-null? empty?)
 
(define (my-stream-ref s n)
  (if (zero? n)
    (stream-car s)
    (my-stream-ref (stream-cdr s) (sub1 n))))
 
(define (my-stream-map proc . argstreams)
  ; the generalized version from exercise 3.50
  (if (stream-null? (car argstreams))
    the-empty-stream
    (cons-stream (apply proc (map stream-car argstreams))
                 (apply my-stream-map
                        (cons proc (map stream-cdr argstreams))))))
 
(define (my-stream-filter pred s)
  (cond [(stream-null? s) the-empty-stream]
        [(pred (stream-car s))
         (cons-stream (stream-car s)
                      (my-stream-filter pred (stream-cdr s)))]
        [else (my-stream-filter pred (stream-cdr s))]))
 
(define (my-stream-for-each proc s)
  (cond [(stream-null? s) 'done]
        [else (proc (stream-car s))
              (my-stream-for-each proc (stream-cdr s))]))
 
(define (display-stream s) (my-stream-for-each displayln s))
 
(define (stream-enumerate-interval low high)
  (if (> low high)
    the-empty-stream
    (cons-stream low
                 (stream-enumerate-interval (add1 low) high))))
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 3.5.2 EXAMPLES AND MORE STREAM PROCEDURES ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
(define (integers-starting-from n)
  (cons-stream n (integers-starting-from (add1 n))))
(define integers1 (integers-starting-from 1))
 
(define (divisible? x y) (zero? (remainder x y)))
(define no-sevens (my-stream-filter (lambda (x) (not (divisible? x 7)))
                                    integers1))
 
(define (fibgen a b)
  (cons-stream a (fibgen b (+ a b))))
(define fibs1 (fibgen 0 1))
 
(define (sieve s)
  (cons-stream
    (stream-car s)
    (sieve (my-stream-filter
             (lambda (x) 
               (not (divisible? x (stream-car s))))
             (stream-cdr s)))))
(define primes1 (sieve (integers-starting-from 2)))
 
(define ones (cons-stream 1 ones))
 
(define (add-streams s1 s2)
  (my-stream-map + s1 s2))
(define integers (cons-stream 1 (add-streams ones integers)))
 
(define fibs
  (cons-stream 0
               (cons-stream 1
                            (add-streams (stream-cdr fibs)
                                         fibs))))
 
(define (scale-stream s factor)
  (my-stream-map (lambda (x) (* x factor)) s))
 
(define double (cons-stream 1 (scale-stream double 2)))
 
(define primes
  (cons-stream
    2
    (my-stream-filter prime? (integers-starting-from 3))))
 
(define (prime? n)
  (define (iter ps)
    (cond [(> (sqr (stream-car ps)) n) true]
          [(divisible? n (stream-car ps)) false]
          [else (iter (stream-cdr ps))]))
  (iter primes))
 
;; PROCEDURES FROM THE 3.5.2 EXERCISES
 
(define (mul-streams s1 s2)
  (my-stream-map * s1 s2))
 
(define factorials
  (cons-stream 1 
               (mul-streams factorials integers)))
 
(define (partial-sums s)
  (cons-stream (stream-car s)
               (add-streams (stream-cdr s)
                            (partial-sums s))))
 
(define (merge s1 s2)
  (cond [(stream-null? s1) s2]
        [(stream-null? s2) s1]
        [else
          (define s1car (stream-car s1))
          (define 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 hamming
  (cons-stream 1
               (merge (scale-stream hamming 2)
                      (merge (scale-stream hamming 3)
                             (scale-stream hamming 5)))))
 
(define (expand num den radix)
  (cons-stream
    (quotient (* num radix) den)
    (expand (remainder (* num radix) den) den radix)))
 
(define (integrate-series s)
  (my-stream-map / s integers))
 
(define exp-series
  (cons-stream 1 (integrate-series exp-series)))
 
(define cosine-series ; derivative of cosine is -1 * sine
  (cons-stream 1 (scale-stream
                   (integrate-series sine-series)
                   -1)))
 
(define sine-series ; derivative of sine is cosine
  (cons-stream 0 (integrate-series cosine-series)))
 
(define (mul-series s1 s2)
  (cons-stream (* (stream-car s1)
                  (stream-car s2))
               (add-streams (scale-stream (stream-cdr s2) (stream-car s1))
                            (mul-series s2 (stream-cdr s1)))))
 
(define (invert-unit-series s)
  (unless (= (stream-car s) 1)
    (error "Constant term must be 1 -- INVERT-UNIT-SERIES" s))
  (cons-stream 1
               (scale-stream (mul-series (stream-cdr s)
                                         (invert-unit-series s))
                             -1)))
 
(define (div-series s1 s2)
  (when (zero? (stream-car s2))
    (error "Constant term of second series must be non-zero -- DIV-SERIES" s2))
  (scale-stream
    (mul-series s1
                (invert-unit-series (scale-stream s2
                                                  (/ 1 (stream-car s2)))))
    (stream-car s2)))
 
(define tangent-series (div-series sine-series cosine-series))
 
(define (display-this-many n s [direction 'horiz])
  (define (loop i st)
    (cond [(eq? direction 'horiz)
           (printf "~a " (stream-car st))
           (if (= i n)
             (printf "~n")
             (loop (add1 i) (stream-cdr st)))]
          [(eq? direction 'vert)
           (printf "~a ~n" (stream-car st))
           (unless (= i n) (loop (add1 i) (stream-cdr st)))]
          [else (error "Unknown direction -- DISPLAY-THIS-MANY" direction)]))
  (loop 1 s)
  'done)
 
;;;;;;;;;;;
;; TESTS ;;
;;;;;;;;;;;
 
(check-equal? (my-stream-ref integers1 1000) 1001)
(check-equal? (my-stream-ref no-sevens 100) 117)
(check-equal? (my-stream-ref fibs1 25) 75025)
(check-equal? (my-stream-ref primes1 50) 233)
(check-equal? (my-stream-ref integers 1000) 1001)
(check-equal? (my-stream-ref fibs 25) 75025)
(check-equal? (my-stream-ref double 10) 1024)
(check-equal? (my-stream-ref primes 50) 233)
(check-equal? (my-stream-ref factorials 9) 362880)
(check-equal? (my-stream-ref (partial-sums integers) 9) 55)
(check-equal? (my-stream-ref hamming 9) 12)
(check-equal? (my-stream-ref tangent-series 7) (/ 17 315))