streams.rkt

#lang racket

(define (assert-equal a b)
  (if (equal? a b)
      (void)
      (error "Assertion failure got" a "expected" b)))

(define-syntax-rule (s-cons a b) (lambda () (cons a b)))
(define (s-car stream) (car (stream)))
(define (s-cdr stream) (cdr (stream)))

(define (s-nth s n)
  (if (<= n 0)
      (s-car s)
      (s-nth (s-cdr s) (- n 1))))

(define (s-first-n s n)
  (define (inner s n acc)
    (if (<= n 0)
        (reverse acc) 
        (inner (s-cdr s)
               (- n 1)
               (cons (s-car s) acc))))
  (inner s n '()))

(define nums
  (letrec [(inner
            (lambda (n)
              (s-cons n (inner (+ n 1)))))]
    (inner 0)))

(assert-equal '(0 1 2 3 4)
              (s-first-n nums 5))
(assert-equal '()
              (s-first-n nums -1))

(define (double s)
  (s-cons (* 2 (s-car s))
          (double (s-cdr s))))

(assert-equal '(0 2 4 6 8)
              (s-first-n (double nums) 5))
(assert-equal '()
              (s-first-n (double nums) -1))

(define fib
  (letrec [(inner
            (lambda (a b)
              (s-cons a (inner b (+ a b)))))]
    (inner 0 1)))

(assert-equal '(0 1 1 2 3 5 8 13 21 34)
              (s-first-n fib 10))
(assert-equal 354224848179261915075
              (s-nth fib 100))

(define (accum s)
  (define (inner s total)
    (let* [(new-total (+ total (s-car s)))]
      (s-cons new-total 
              (inner (s-cdr s) new-total))))
  (inner s 0))

(assert-equal '(0 1 3 6 10 15 21 28 36)
              (s-first-n (accum nums) 9))
(assert-equal '()
              (s-first-n (accum nums) -1))

(define (s-map s f)
  (s-cons (f (s-car s))
          (s-map (s-cdr s) f)))

(assert-equal '(0 2 4 6 8)
              (s-first-n
               (s-map nums (lambda (n) (* n 2)))
               5))
(assert-equal '(0 1 4 9 16 25)
              (s-first-n
               (s-map nums (lambda (n) (* n n)))
               6))

(define (s-filter s f)
  (if (f (s-car s))
      (s-cons (s-car s)
              (s-filter (s-cdr s) f))
      (s-filter (s-cdr s) f)))

(assert-equal '(1 3 5 7 9)
              (s-first-n
               (s-filter nums
                         (lambda (n) (= 1 (modulo n 2))))
               5))

(assert-equal '(0 1 2 3 5)
              (s-first-n
               (s-filter nums
                         (lambda (n) (not (= n 4))))
               5)) 

(define (interleave first second)
  (s-cons (s-car first)
          (s-cons (s-car second)
                  (interleave (s-cdr first)
                              (s-cdr second)))))

(assert-equal '(0 0 1 1 2 4 3 9 4 16)
              (s-first-n
               (interleave nums
                           (s-map nums (lambda (n) (* n n))))
               10))

(define (cycle ls)
  (define (inner items)
    (if (empty? items)
        (inner ls)
        (s-cons (car items)
                (inner (cdr items)))))
  (if (empty? ls)
      (error "cycle -- cannot pass in an empty list")
      (inner ls)))

(assert-equal '(1 2 3 1 2 3 1 2 3 1)
              (s-first-n (cycle '(1 2 3)) 10))
(assert-equal '(1 1 1 1 1)
              (s-first-n (cycle '(1)) 5))
(assert-equal '(7 8 7 8)
              (s-first-n (cycle '(7 8)) 4))

(define (repeat n) (cycle (list n)))

(assert-equal '(1 1 1 1 1)
              (s-first-n (repeat 1) 5))
(assert-equal '((0 1) (0 1) (0 1) (0 1) (0 1))
              (s-first-n (repeat '(0 1)) 5))