DataMuseum.dk

top - download

    Length: 3474 (0xd92)
    Types: TextFile
    Names: »ps7.scm«

└─⟦a0efdde77⟧ Bits:30001252 EUUGD11 Tape, 1987 Spring Conference Helsinki
    └─ ⟦this⟧ »EUUGD11/gnu-31mar87/scheme/psets/ps7.scm« 

TextFile

;;; This is the file PS7-CODE.SCM
;;; Useful stream utility functions

(define the-empty-stream nil)
(define empty-stream? null?)

(define (add-streams s1 s2)
  (cond ((empty-stream? s1) s2)
	((empty-stream? s2) s1)
	(else
	 (cons-stream (+ (head s1) (head s2))
		      (add-streams (tail s1) (tail s2))))))

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

(define (nth-stream n s)
  (cond ((empty-stream? s)
	 (error "empty stream -- nth-stream" n))
	((= n 0) (head s))
	(else (nth-stream (- n 1) (tail s)))))

(define (accumulate combiner initial-value stream)
  (cond ((empty-stream? stream) initial-value)
	(else
	 (combiner (head stream)
	      (accumulate combiner
			  initial-value
			  (tail stream))))))

(define (filter pred stream)
  (cond ((empty-stream? stream) the-empty-stream)
	((pred (head stream))
	 (cons-stream (head stream)
		      (filter pred (tail stream))))
	(else (filter pred (tail stream)))))

(define (map proc stream)
  (cond ((empty-stream? stream) the-empty-stream)
	(else (cons-stream (proc (head stream))
			   (map proc (tail stream))))))

(define (map-2 f s1 s2)
  (cond ((or (empty-stream? s1) (empty-stream? s2))
	 the-empty-stream)
	(else
	 (cons-stream (f (head s1) (head s2))
		      (map-2 f (tail s1) (tail s2))))))

(define (enumerate-fringe tree)
  (cond ((atom? tree)
	 (cons-stream tree the-empty-stream))
	(else
	 (append-streams (enumerate-fringe (car tree))
			 (enumerate-fringe (cdr tree))))))

(define (enumerate-interval n1 n2)
  (cond ((> n1 n2)
	 the-empty-stream)
	(else
	 (cons-stream n1
		      (enumerate-interval (1+ n1) n2)))))


(define (append-streams s1 s2)
  (cond ((empty-stream? s1) s2)
	(else
	 (cons-stream (head s1)
		      (append-streams (tail s1) s2)))))


(define (merge s1 s2)
  (cond ((empty-stream? s1) s2)
        ((empty-stream? s2) s1)
        (else
	 (let ((h1 (head s1))
	       (h2 (head s2)))
	   (cond ((< h1 h2)
		  (cons-stream h1
			       (merge (tail s1)
				      s2)))
		 ((> h1 h2)
		  (cons-stream h2
			       (merge s1
				      (tail s2))))
		 (else
		  (cons-stream h1
			       (merge (tail s1)
				      (tail s2)))))))))

(define print-stream
  (let ()
    (define (iter s)
      (cond ((empty-stream? s)
	     (princ "}"))
	    (else
	     (princ (head s))
             (newline)
	     (princ " ")
	     (iter (tail s)))))
    (lambda (s)
      (princ "{")
      (iter s))))

(define (plot-stream s max-y num-vals)
  (define (sign x) (if (< x 0) -1 1))
  (define hp-screen-width 200)
  (define hp-screen-height 180)
  (define x-scale (* 2 (/ hp-screen-width num-vals)))
  (define y-scale (/ hp-screen-height max-y))
  (define (screen-x-point x)
    (round (- (* x x-scale)
              hp-screen-width)))
  (define (screen-y-point y)
    (let ((intended-y (round (* y-scale y))))
       (if (> (abs intended-y) hp-screen-height)
          (* (sign intended-y) hp-screen-height)
          intended-y)))
  (define (iter s count)
    (if (> count num-vals)
        'done
        (sequence (draw-line-to (screen-x-point count)
                                (screen-y-point (head s)))
                  (iter (tail s) (1+ count)))))
  (clear-graphics)
  (position-pen (screen-x-point 0)
                (screen-y-point (head s)))
  (iter (tail s) 1))


(define (tty-stream) (cons-stream (read) (tty-stream)))

(define (integral integrand initial-value dt)
  (define int
    (cons-stream initial-value
		 (add-streams (scale-stream dt integrand) int)))
  int)