#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))