Streams and such

change_name_later_ch_3.scm

#lang racket

; 3.22

(define (make-queue)
  (let ((front-ptr '())
        (rear-ptr '()))
    
    (define (empty?)
      (null? front-ptr))
    
    (define (insert! item)
      (let ((new-pair (mcons item '())))
        (cond ((empty?)
               (set! front-ptr new-pair)
               (set! rear-ptr new-pair)
               )
              (else
               (set-mcdr! rear-ptr new-pair)
               (set! rear-ptr new-pair)))))
    
    (define (front)
      (cond ((empty?) (error "Empty queue"))
            (else (mcar front-ptr))))
    
    (define (rear)
      (cond ((empty?) (error "Empty queue"))
            (else (mcar rear-ptr))))
    
    (define (delete!)
      (cond ((empty?) (error "Empty queue"))
            (else (set! front-ptr (mcar front-ptr)))))
    
    (define (dispatch msg)
      (cond ((eq? msg 'insert!) insert!)
            ((eq? msg 'delete!) (delete!))
            ((eq? msg 'empty?) (empty?))
            ((eq? msg 'front) (front))
            ((eq? msg 'rear) (rear))
            (else (error "Bad message"))))
    dispatch
    ))
        
(define q (make-queue))

; 3.23

(define (make-dequeue)
  (let ((front-ptr '())
        (rear-ptr '()))
    
    (define (empty?)
      (and (null? front-ptr) (null? rear-ptr)))
    
    (define (insert-rear! item)
      (let ((new-pair (mcons item '())))
        (cond ((empty?)
               (set! front-ptr new-pair)
               (set! rear-ptr new-pair)
               )
              (else
               (set-mcdr! rear-ptr new-pair)
               (set! rear-ptr new-pair)))))
    
    (define (insert-front! item)
      (let ((new-pair (mcons item '()))
            (temp (mcdr front-ptr)))
        (cond ((empty?)
               (set! front-ptr new-pair)
               (set! rear-ptr new-pair)
               )
              (else
               (set-mcar! front-ptr new-pair)
               (set-mcdr! new-pair temp)
               (set! rear-ptr new-pair)))))
    
    (define (front)
      (cond ((empty?) (error "Empty queue"))
            (else (mcar front-ptr))))
    
    (define (rear)
      (cond ((empty?) (error "Empty queue"))
            (else (mcar rear-ptr))))
    
    (define (delete-front!)
      (cond ((empty?) (error "Empty queue"))
            (else (set! front-ptr (mcar front-ptr)))))

    (define (delete-rear!)
      (cond ((empty?) (error "Empty queue"))
            (else (set! rear-ptr (mcdr front-ptr)))))
    
    (define (dispatch msg)
      (cond ((eq? msg 'insert-front!) insert-front!)
            ((eq? msg 'insert-rear!) insert-rear!)
            ((eq? msg 'delete-front!) (delete-front!))
            ((eq? msg 'delete-rear!) (delete-rear!))
            ((eq? msg 'empty?) (empty?))
            ((eq? msg 'front) (front))
            ((eq? msg 'rear) (rear))
            (else (error "Bad message"))))
    dispatch
    ))
        
(define dq (make-dequeue))
;((dq 'insert-front!) 'a)
;((dq 'insert-rear!) 'z)

; Example

(define ready-to-call (make-queue))

(define (call-soon proc)
  ((ready-to-call 'insert!) proc))

(define (run)
  (cond ((ready-to-call 'empty?) 'done)
        (else
         (let ((proc (ready-to-call 'front)))
           (proc) ; execute the 0-argument lambda
           (ready-to-call 'delete!)))))

(define (countdown n)
  (cond ((= n 0) 'countdown-done)
        (else
         (display "Down ")
         (displayln n)
         (call-soon (lambda () (countdown (- n 1)))))))

(define (up stop)
  (define (iter x)
    (cond ((> x stop) 'up-done)
          (else
           (display "Up ")
           (displayln x)
           (call-soon (lambda () (iter (+ x 1)))))))
  (iter 0))

(call-soon (lambda () (countdown 3)))
(call-soon (lambda () (up 3)))

; pg. 321

(define (stream-enumerate-interval low high)
  (if (> low high)
      empty-stream
      (stream-cons
       low
       (stream-enumerate-interval (+ low 1) high))))
  
; pg. 319

(define (stream-ref s n)
  (if (= n 0)
      (stream-first s)
      (stream-ref (stream-rest s) (- n 1))))

; pg. 320

(define (stream-map proc s)
  (if (stream-empty? s)
      empty-stream
      (stream-cons (proc (stream-first s)) (stream-map proc (stream-rest s)))))

(define (stream-for-each proc s)
  (if (stream-empty? s)
      'done
      (begin (proc (stream-first s))
             (stream-for-each proc (stream-rest s)))))

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

; 3.50

(define (3.5-stream-map proc . argstreams)
  (if (null? (car argstreams))
      empty-stream
      (stream-cons
        (apply proc (map stream-first argstreams))
        (apply stream-map
               (stream-cons proc (map stream-rest argstreams))))))


(define (add-streams s1 s2)
  (if (stream-empty? s1)
      empty-stream
      (stream-cons (+ (stream-first s1) (stream-first s2))
                   (add-streams (stream-rest s1) (stream-rest s2)))))

(define nums (stream-enumerate-interval 1 5))
(define evens (add-streams nums nums))

;Infinite Stream

(define ones (stream-cons 1 ones)) ;<---has not evalutated ones yet, as ones is a stream
(stream-ref ones 1)  ;-->1
(stream-ref ones 10) ;-->1
(stream-ref ones 37) ;-->1 (an infinite stream of ones)

(define integers (stream-cons 1 (add-streams ones integers))); <--counts up from 1

(define fibonacci (stream-cons 0 (stream-cons 1 (add-streams (stream-rest fibonacci) fibonacci)))) ; <--Displays fibonacci numbers