;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; If streams are not built into DrScheme, can we add them? How?

;; cons-stream should not evaluate second argument - special form?

;; so we need to add a clause to the cond in the evaluator...

;; how about some syntactic transformation?

;; macros are one answer...

;; use "define-macro" to define them. Examples:

(define-macro (unless test alternative)
  (list 'if test 'false alternative)) 
 
(define-macro (when test consequent)
  (list 'if test consequent 'false))

;; example

; (unless (> 5 3) (/ 1 0))

;; macros are "expanded" before evaluation -- (arguments not evaluated)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; Streams using macros:

;; First, without memoization

(define-macro cons-stream
  (lambda (x y)
    (list 'cons x (list 'lambda () y))))

(define-macro (cons-stream x y)
  (list 'cons x (list 'lambda () y)))

;; car is just x ; cdr is a procedure ; y is not evaluated

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

(define (stream-cdr s) ((cdr s))) ; note extra layer of parens!

(define the-empty-stream '())

(define (stream-null? s) (eq? s the-empty-stream))

;; Streams with memoization

(define-macro (cons-stream x y)
  (list 'cons x (list 'memo-proc  (list 'lambda '() y))))

(define (memo-proc proc)
  (let ((already-run? #f)
        (result '()))
    (lambda ()
       (if already-run?
           result
	   (begin  (set! result (proc))
	           (set! already-run? #t)
		   result))))) 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; Some stream utilities

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

(define (stream-map proc s)
  (if (stream-null? s)
    the-empty-stream
    (cons-stream (proc (stream-car s))
                 (stream-map proc (stream-cdr s)))))

(define (stream-filter pred s)
  (cond ((stream-null? s) the-empty-stream)
        ((pred (stream-car s))
         (cons-stream (stream-car s) 
               (stream-filter pred (stream-cdr s))))
        (else (stream-filter pred (stream-cdr s)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; An infinite stream

(define ones (cons-stream 1 ones))

; (stream-car ones)

; (stream-car (stream-cdr ones))

;; tedious!

(define (show-start str n)
  (cond ((> n 0) (display (stream-car str)) (display " ")
                 (show-start (stream-cdr str) (- n 1)))))

; (show-start ones 10)

(define (add-streams s1 s2)
  (cond ((null? s1) '())
	((null? s2) '())
	(else (cons-stream (+ (stream-car s1) (stream-car s2))
			   (add-streams (stream-cdr s1)
                                        (stream-cdr s2))))))

(define twos (add-streams ones ones))

; (show-start twos 10)

(define ints (cons-stream 1 (add-streams ones ints)))

; (stream-car ints)

; (stream-car (stream-cdr ints))

; (show-start ints 20)

; (define integers (add-streams ones integers))  ;; why not ?

;; Another way...

(define (integers-from i)
  (cons-stream i (integers-from (+ i 1))))

(define integers (integers-from 1))

(define (stream-enumerate-interval lo hi)
  (if (> lo hi)
    the-empty-stream
    (cons-stream lo (stream-enumerate-interval (+ lo 1) hi))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; Fibonacci  (1 1 2 3 5 8 13 21 34 55 89 ... )

(define fibs 
  (cons-stream 1 
               (cons-stream 1 
                            (add-streams fibs (stream-cdr fibs)))))

; (stream-car fibs)

; (stream-car (stream-cdr fibs))

; (show-start fibs 20)

(define fibonaccis 
  (cons-stream 1 
               (add-streams fibonaccis 
                            (stream-cdr fibonaccis)))) ;; why not ?

; (stream-car fibonaccis)

; (stream-car (stream-cdr fibonaccis)) ?

; (show-stream-start fibonaccis 20) ?

(define (multiply-streams s1 s2)
  (cond ((null? s1) '())
	((null? s2) '())
	(else (cons-stream (* (stream-car s1) (stream-car s2))
			   (multiply-streams (stream-cdr s1) 
                                             (stream-cdr s2))))))

(define squares (multiply-streams ints ints))

; (show-start squares 20)

;;

(define mystery (cons-stream 1 (multiply-streams twos mystery)))

;;

(define mystery (cons-stream 1 (multiply-streams (add-streams ones ones) mystery)))

; (show-start mystery 20)

;; Factorial  (1 2 6 24 120 720 ... )

(define facts (cons-stream 1 (multiply-streams facts (stream-cdr ints))))

; (show-start facts 20)

;; Primes (2 3 5 7 11 13 17 ... )

(define (divisible? n m) (= n (* (floor (/ n m)) m)))

; (divisible? 12 4) (divisible? 12 5)

(define (sieve str)
  (cons-stream 
   (stream-car str)
   (sieve (stream-filter (lambda (x) (not (divisible? x (stream-car str))))
			 (stream-cdr str)))))

(define primes (sieve (stream-cdr ints)))

; (stream-car primes)

; (stream-car (stream-cdr primes))

; (show-start primes 100)

;;

;; get the n-th prime ...

; (list-ref (filter (lambda (x) (prime? x)) (enumerate-interval 1 1000000000)) 100)

(define (enumerate-interval a b) ; normal scheme version
  (if (> a b)
      '()
      (cons a (enumerate-interval (+ a 1) b))))

; (enumerate-interval 1 100)

(define (enumerate-interval a b) ; stream version
  (if (> a b)
      '()
      (cons-stream a (enumerate-interval (+ a 1) b))))

; (enumerate-interval 1 100)

(define (stream-interval a b)
  (if (> a b)
      the-empty-stream
      (cons-stream a (stream-interval (+ a 1) b))))

;; 

(define (stream-filter pred str)
  (if (pred (stream-car str))
      (cons-stream (stream-car str)
		   (stream-filter pred (stream-cdr str)))
      (stream-filter pred (stream-cdr str))))

(define (stream-ref str n)
  (if (= n 0)
      (stream-car str)
      (stream-ref (stream-cdr str) (- n 1))))
	
; (stream-ref primes 100)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (divide-streams s1 s2)
  (cond ((null? s1) '())
	((null? s2) '())
	(else (cons-stream (/ (stream-car s1) (stream-car s2))
			   (divide-streams (stream-cdr s1) (stream-cdr s2))))))

; (show-start (divide-streams ones ints) 20)

; (show-start (divide-streams ones (stream-cdr facts)) 20)

; (show-start facts 20)

(define magic 
  (cons-stream 1 
               (add-streams magic 
                            (divide-streams ones facts))))

; (show-start magic 20)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; rational number approximations to reals

(define make-rat list)

(define numer car)

(define denom cadr)

(define resid caddr)

(define approx cadddr)

(define PI (* 4 (atan 1 1)))

(define (continued str)
  (let* ((rat0 (stream-car str))
         (rat1 (stream-car (stream-cdr str)))
         (p0 (numer rat0))
         (q0 (denom rat0))
         (p1 (numer rat1))
         (q1 (denom rat1))
         (s (resid rat1))
         (is (floor s))
         (p2 (+ p0 (* is p1)))
         (q2 (+ q0 (* is q1)))
         (ds (- s is))
         (newrat (make-rat p2 q2 (/ 1.0 ds) (/ p2 q2))))
    (if (zero? ds) 
	(cons-stream newrat '())
	(cons-stream newrat (continued (stream-cdr str))))))

(define pi-stream (cons-stream (make-rat 0 1 0 0) 
			       (cons-stream (make-rat 1 0 PI 0)
					    (continued pi-stream))))

; (show-start pi-stream 16)

; (show-start pi-stream 17)

; (/ 22 7)
; (/ 333 106)
; (/ 355 113)
; (/ 103993 33102)
; (/ 104348 33215)
; (/ 208341 66317)
; (/ 312689 99532)
; (/ 833719 265381)
; (/ 1146408 364913)
; (/ 4272943 1360120)
; (/ 5419351 1725033) 
; (/ 80143857 25510582)
; (/ 245850922 78256779)

;; beyond that, the rational approximation is more accurate than floating point ...

(define E (exp 1))

(define e-stream (cons-stream (make-rat 0 1 0) 
			(cons-stream (make-rat 1 0 E)
				     (continued e-stream))))

; (show-start e-stream 24)

; (/ 8 3)
; (/ 11 4)
; (/ 19 7)
; (/ 87 32)
; (/ 106 39)
; (/ 193 71)
; (/ 1264 465)
; (/ 1457 536)
; (/ 2721 1001)
; (/ 23225 8544)
; (/ 25946 9545)
; (/ 49171 18089)
; (/ 517656 190435)
; (/ 566827 208524)
; (/ 1084483 398959)
; (/ 13580623 4996032)
; (/ 14665106 5394991)
; (/ 28245729 10391023)

;; beyond that, the rational approximation is more accurate than floating point ...

(define third-stream (cons-stream (make-rat 0 1 0) 
				  (cons-stream (make-rat 1 0 (/ 1 3))
					       (continued third-stream))))

; (show-start third-stream 20)

(define sqrttwo-stream (cons-stream (make-rat 0 1 0) 
				    (cons-stream (make-rat 1 0 (sqrt 2.0))
						 (continued sqrttwo-stream))))

; (show-start sqrttwo-stream 26)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (accumulate op ini lst)
  (if (null? lst)
      ini 
      (op (car lst) (accumulate op ini (cdr lst)))))

; (accumulate + 0 '(1 2 3 4 5 6 7 8 9 10))

;; perfect numbers

(define (perfect? n) (= n (accumulate + 0 (factors n))))

(define (factors n)
  (filter (lambda (factor) (divisible? n factor))
	  (enumerate-interval 1 (/ n 2))))

; (define perfect-numbers (stream-filter perfect? ints))

(define (enumerate-interval a b)
  (if (> a b)
      '()
      (cons a (enumerate-interval (+ a 1) b))))

(define (filter pred lst)
  (if (null? lst)
      '()
      (if (pred (car lst)) 
	  (cons (car lst) (filter pred (cdr lst)))
	  (filter pred (cdr lst)))))

(define (divisible? x y) (= (* (floor (/ x y)) y) x))

; (divisible? 1024 17)

; (stream-car perfect-numbers)

; (stream-car (stream-cdr perfect-numbers))

; (stream-car (stream-cdr (stream-cdr perfect-numbers))) 

; (stream-car (stream-cdr (stream-cdr (stream-cdr perfect-numbers))))

; (perfect? 6) (perfect? 28) (perfect? 496) (perfect? 8128)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; Yet another way to do integers:

; (define (inc n) (+ n 1))

; (define ints (cons-stream 1 (stream-map inc ints)))

; (show-start ints 10);

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;