Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- #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))
Add Comment
Please, Sign In to add comment