[plt-scheme] Question about delayed evaluation

Noel Welsh wrote:
>   For list-related administrative tasks:
>   http://list.cs.brown.edu/mailman/listinfo/plt-scheme
>
> The short answer is to write a macro.

(require (lib "defmacro.ss"))

; cons-stream : obj stream ->  stream
; (special form) constructs a stream whose first element i obj and whose
tail is stream
(define-macro cons-stream
  (lambda (car cdr)
    `(cons ,car (delay ,cdr))))

More SICP'isms is defined below.

My personal favorite is the mutual recursive definition
of prime? and primes.

PS: This was meant for my eyes only. I think it was one of the
    first things I tried since discovering DrScheme.

;;;
;;; FØLGER
;;;

(require (lib "defmacro.ss"))

;;  Kilde: SICP side 316

;;; STREAM Data Definition

; A STREAM is either
;    the-empty-stream
; or
;    (cons-stream car cdr)   ; where cdr is a stream


;; Utilities

(define ... 'not-implemented)

(define (square x)
  (* x x))


; the empty stream
(define the-empty-stream '())

; empty-stream? object -> boolean
(define empty-stream? null?)
(define stream-null? empty-stream?)
(define empty? empty-stream?)

; CONSTRUCTOR

; cons-stream : obj stream ->  stream
; (special form) constructs a stream whose first element i obj and whose
tail is stream
(define-macro cons-stream
  (lambda (car cdr)
    `(cons ,car (delay ,cdr))))

; SELECTOR

(define (stream-car stream)
  (car stream))

(define (stream-cdr stream)
  (force (cdr stream)))

; CONVENIENCE

; Selector

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

(define (stream->list s n)
  (if (= n 0)
      '()
      (if (not (empty? s))
          (cons (stream-car s)
                (stream->list (stream-cdr s) (- n 1)))
          '())))

; Higher order

(define (stream-map proc . streams)
  (if (stream-null? (car streams))
      the-empty-stream
      (cons-stream
       (apply proc (map stream-car streams))
       (apply stream-map
              (cons proc (map stream-cdr streams))))))

(define (stream-for-each proc s)
  (if (stream-null? s)
      'done
      (begin (proc (stream-car s))
             (stream-for-each proc (stream-cdr s)))))

(define (stream-filter predicate stream)
  (cond
    [(empty? stream)                 the-empty-stream]
    [(predicate (stream-car stream)) (cons-stream (stream-car stream)
                                                  (stream-filter predicate
(stream-cdr stream)))]
    [else                            (stream-filter predicate (stream-cdr
stream))]))

; combining

(define (merge s1 s2)
  (cond
    [(empty? s1) s2]
    [(empty? s2) s1]
    [else (let ([s1car (stream-car s1)]
                [s2car (stream-car s2)])
            (cond
              [(< s1car s2car) (cons-stream s1car (merge (stream-cdr s1)
s2))]
              [else            (cons-stream s2car (merge (stream-cdr s2)
s1))]))]))




;;; Aritmetical

(define (add-streams s1 s2)
  (stream-map + s1 s2))

(define (mul-streams s1 s2)
  (stream-map * s1 s2))

(define (scale-stream k s)
  (stream-map (lambda (x) (* k x))
              s))

(define (constant-stream c)
  (scale-stream c ones))

(define (partial-sums s)
  (cons-stream (stream-car s)
               (add-streams (constant-stream (stream-car s))
                            (partial-sums (stream-cdr s)))))


; Output

(define (display-stream s)
  (stream-for-each display-line s))

(define (display-line x)
  (newline)
  (display x))

;;; Numbers

(define (stream-interval low high)
  (if (> low high)
      the-empty-stream
      (cons-stream low
                   (stream-interval (+ low 1) high))))

(define (integers-starting-from n)
  (cons-stream n (integers-starting-from (+ n 1))))


(define (even? x)
  (= (remainder x 2) 0))


;;; Primes

; Sieve if Eratosthenes
(define (sieve stream)
  (cons-stream (stream-car stream)
               (sieve (stream-filter (lambda (x)
                                       (not (= (remainder x (stream-car
stream)) 0)))
                                     (stream-cdr stream)))))

(define primes (sieve (integers-starting-from 2)))
(define (prime? n)
  (let loop ([s primes])
    (cond
      [(< n (stream-car s)) #f]
      [(= n (stream-car s)) #t]
      [else (loop (stream-cdr s))])))

; fractions

; returns the sequence of digits of num/den expressed in radix
(define (expand num den radix)
  (cons-stream (quotient (* num radix) den)
               (expand (remainder (* num radix) den) den radix)))

; Power Series

; remember to cons an constant term after integration
(define (integrate-series s)
  (stream-map * s inverses))

(define exp-series (cons-stream 1 (integrate-series exp-series)))
(define cos-series (cons-stream 1 (scale-stream -1 (integrate-series
sin-series))))
(define sin-series (cons-stream 0 (integrate-series sin-series)))

(define (mul-series s1 s2)
  (cons-stream (* (stream-car s1) (stream-car s2))
               (add-streams (scale-stream (stream-car s1) s2)
                            (scale-stream (stream-car s2) s1)
                            (mul-series (stream-cdr s1) (stream-cdr s2)))))

; Limits

(define (average x y)
  (/ (+ x y) 2))

(define (sqrt-improve guess x)
  (average guess (/ x guess)))

(define (sqrt-stream x)
  (letrec ([guesses (cons-stream 1.0
                                 (stream-map (lambda (guess)
                                               (sqrt-improve guess x))
                                             guesses))])
    guesses))

(define (pi-summands n)
  (cons-stream (/ 1.0 n)
               (stream-map - (pi-summands (+ n 2)))))

(define pi-stream (scale-stream 4 (partial-sums (pi-summands 1))))


; Euler accelerator

(define (euler-transform s)
  (let ([s0 (stream-ref s 0)]
        [s1 (stream-ref s 1)]
        [s2 (stream-ref s 2)])
    (cons-stream (- s2 (/ (square (- s2 s1))
                          (+ s0 (* -2 s1) s2)))
                 (euler-transform (stream-cdr s)))))

(define (make-tableau transform s)
  (cons-stream s
               (make-tableau transform
                             (transform s))))

(define (accelerated-sequence transform s)
  (stream-map stream-car
              (make-tableau transform s)))



; Sequences

(define ones (cons-stream 1 ones))
(define integers (integers-starting-from 1))
(define integers2 (cons-stream 1 (add-streams ones integers2)))
(define inverses (stream-map (lambda (x) (/ 1 x)) integers))

(define fibonacci (cons-stream 0
                               (cons-stream 1
                                            (add-streams fibonacci
                                                         (stream-cdr
fibonacci)))))
(define factorials (cons-stream 1
                                (mul-streams integers factorials)))



;;; TESTS

(define interval-1000-1100 (stream-interval 1000 1100))
(define i interval-1000-1100)
(define true-predicate (lambda (x) #t))
;(display-stream i)
(define idiot (add-streams (mul-streams cos-series cos-series) (mul-streams
sin-series sin-series)))
;(display (stream->list (sqrt-stream 2) 50))
;(time (stream-ref pi-stream 20000))
;(display (stream->list (euler-transform pi-stream) 100))
(display (stream->list (accelerated-sequence euler-transform pi-stream)
100))


--
Jens Axel Søgaard