Crazy stuff

infib.rkt

;;;; lazy streams

(defmacro delay (expression)
  `(lambda () ,expression))

;;; ` (backquote) means construct a list just like ' (quote)
;;; but it allows you to evaluate parts inside it with , (comma)
;;; also, the result of a macro is evaluated, 
;;; so `(lambda () ,3) is evaluated as if it were just (lambda () 3)

;;;; (delay 3)  => (lambda () 3)
;;;; (delay (+ 1 2)) => (lambda () (+ 1 2))


(define (force thunk) (thunk))

;;; force lets you evaluate delayed expressions

;;  (delay (+ 1 2)) => (lambda () (+ 1 2))

;;  (force (delay (+ 1 2))) => (force (lambda () (+ 1 2))  => (+ 1 2) => 3


(defmacro cons-stream (head tail) `(cons ,head (delay ,tail)))

;; delay works on the form passed directly to it, so cons-stream must be a macro

;;;  (cons-stream 2 (+ 1 2))   => '(2 (lambda () (+ 1 2)))


;;;  if we defined cons-stream like as a function, 
;;;     (define (cons-stream head tail)
;;;        (cons head (delay tail)))

;;;  (cons-stream 2 (+ 1 2)) would evaluate to '(2 3),
;;;  because function arguments are always evaluated.


;;;; functions to manipulate 'streams'

(define (stream-car stream)
  (car stream))
;;; the head, or car of streams are not delayed, so car works fine

;;; (stream-car (cons-stream 1 2)) => 1


(define (stream-cdr-1 stream)
  (cdr stream))

;;;  (stream-cdr-1 (cons-stream 1 2))  => #<procedure>

;;; oops, we forgot to force evaluation of the tail

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

;;; (stream-cdr (cons-stream 1 2)) => 2




;;;; at this point, we can already define the infinite fibonacci list

(define (fibgen a b)
  (cons-stream a (fibgen b (+ a b))))

(define fibs (fibgen 0 1))

;;; this function calculates a list that recurses back on itself
;;; thankfully, the tail of our 'streams' are delayed

;;; (fibgen 0 1)  => '(0 . #<procedure ...> )

;;; looking a little deeper, it looks like this 
;;; (ignoring the lambdas that are forced when cdr'ing down the stream)

;;; '(0 . (fibgen 1 (+ 0 1)))
;;; '(0 . (cons-stream 1 (fibgen 1 (+ 1 1))))
;;; '(0 . (1 . (fibgen 1 (+ 1 1))))
;;; '(0 . (1 . (cons-stream 1 (fibgen 2 (+ 1 2)))))
;;; '(0 . (1 . (1 . (fibgen 2 (+ 1 2)))))
;;; '(0 . (1 . (1 . (cons-stream 2 (fibgen 3 (+ 2 3))))))
;;; '(0 . (1 . (1 . (2 . (cons-stream 3 (fibgen 5 (+ 3 5)))))))
;;; '(0 . (1 . (1 . (2 . (3 . (fibgen 5 (+ 3 5)))))))


;;;; how do we get at these fibs?

;;; either by manually car and cdr'ing down the list

;;;; (stream-car (stream-cdr (stream-cdr (stream-cdr fibs))))   =>    2


;; or by writing a function that does it for us

(define (stream-ref strm idx)
  (if (= idx 0)
      (stream-car strm)
      (stream-ref (stream-cdr strm) (- idx 1))))


;; (stream-ref fibs 0) => 0
;; (stream-ref fibs 1) => 1
;; (stream-ref fibs 2) => 1
;; (stream-ref fibs 3) => 2 
;; (stream-ref fibs 4) => 3
;; (stream-ref fibs 12) => 144

;; it's an iterative O(n) fibonacci, so it's pretty quick too
;; (stream-ref fibs 16667) =>  70390661127..........  (about 8000 digits)
;; takes about 9 milliseconds on my machine



;;; this is where it starts getting a little crazy

;;; remember how (delay (+ 1 2)) is equivalent to (lambda () (+ 1 2))?


;;; and (cons-stream 1 (+ 1 2)) is equal to (cons 1 (lambda () (+ 1 2)))


;;; well that means we can write fibs without cons-stream or delay

(define (no-delay-fibgen a b)
  (cons a (lambda () (no-delay-fibgen b (+ a b)))))

(define no-delay-fibs (no-delay-fibgen 0 1))

;; (stream-ref (no-delay-fibs 12)) => 144

;;  ok cool.  can we reduce it further?  
;; sure we can, by removing cons/car/cdr, and replacing them with a few clever functions

(define (fcons hd tl)
  (lambda (a) (a hd tl)))

(define (fcar pair)
 (pair (lambda (hd tl) hd)))

(define (fcdr pair)
  (pair (lambda (hd tl) tl)))


;;; (fcons 1 2) => (lambda (a) (a 1 2))
;;; (fcar (fcons 1 2)) => 1
;;; (fcdr (fcons 1 2)) => 2

;;; a litte counter-intuitive at first, 
;;; but it's a neat way of defining structures with just functions

;; with these we can remove the cons from fibs

;; (define (no-delay-fibgen a b)
;;  (cons a (lambda () (no-delay-fibgen b (+ a b)))))

(define (no-cons-fibgen a b)
  (fcons a (lambda () (no-cons-fibgen b (+ a b)))))


;;; to use our function conses, we need to redefine stream-car/cdr/ref

(define (fstream-car stream)  ;; f for func
  (fcar stream))

(define (fstream-cdr stream)
  (force (fcdr stream)))

(define (fstream-ref stream idx)
  (if (= idx 0)
      (fstream-car stream)
      (fstream-ref (fstream-cdr stream) (- idx 1))))

;;; (fstream-ref (no-cons-fibgen 0 1) 12)  => 144


;;; this is where it starts getting really crazy

;;; how can we simplify this further so we are literally just using functions?
;;; well, our list is defined recursively, and if we just want to use literal functions,
;;; that means we need the Y combinator

(define (Y f) ((lambda (x) (x x))
               (lambda (y) (f (lambda (arg . args)
                                (apply (y y) arg args))))))

;;; this one is really tough for me to explain, because I've never really figured it out myself
;;; just suffice it to say that it computes the fixed points of functions,
;;; i.e. lets you do anonymous recursion

;;; with this we can define our fibonacci list like this


(define y-fibgen-builder
  (lambda (f)
    (lambda (a b)
      (fcons a (lambda () (f b (+ a b)))))))

;;;; first convert y-fibgen to return a function that takes itself,
;;;; and applies itself back onto it's recursive case

(define y-fibgen 
  (Y y-fibgen-builder))
  

;;; and then apply it to Y, returning a y-recursive fib-gen function

(define y-fibs (y-fibgen 0 1))

;; and call it with the starting 0 and 1

;;; (fstream-ref y-fibs 12) => 144
                                
;;; we're getting really close here but a little bit more to go


;;; while we're having fun with the Y combinator,
;;;  we might as well use it in our recursive stream-ref function 

(define y-fstream-ref-builder
  (lambda (f)
    (lambda (stream idx)
      (if (= idx 0) (fstream-car stream)
          (f (fstream-cdr stream) (- idx 1))))))

(define y-fstream-ref (Y y-fstream-ref-builder))

;;;  (y-fstream-ref y-fibs 122)  => 144


;;; now that everything is pure lambdas (and a couple zeros and ones)

;;; we can substitute down to almost nothing :)

(define fibs-integrated-1 (lambda (idx)
                            (y-fstream-ref y-fibs idx)))

(define fibs-integrated-2 (lambda (idx)
                         ((Y y-fstream-ref-builder) y-fibs idx)))

(define fibs-integrated-3 (lambda (idx)
                            ((Y y-fstream-ref-builder) ((Y y-fibgen-builder) 0 1))))





;; substituting in the y combinator

(define fibs-integrated-4 
  (lambda (idx)
    ((;; y combinator
      (lambda (f) ((lambda (x) (x x))
                       (lambda (y) (f (lambda (arg . args)
                                        (apply (y y) arg args)))))) 
        
        
        y-fstream-ref-builder) 
     
     
     ((;; y combinator
       (lambda (f) ((lambda (x) (x x))
                       (lambda (y) (f (lambda (arg . args)
                                        (apply (y y) arg args))))))
       y-fibgen-builder) 0 1) idx)))


;;; substituting in the function builders


(define fibs-integrated-5
  (lambda (idx)
    ((;; y combinator
      (lambda (f) ((lambda (x) (x x))
                       (lambda (y) (f (lambda (arg . args)
                                        (apply (y y) arg args)))))) 
        
        ;; y-stream-ref-builder
      (lambda (f)
        (lambda (stream idx)
          (if (= idx 0) (fstream-car stream)
              (f (fstream-cdr stream) (- idx 1)))))) 
     
     
     ((;; y combinator
       (lambda (f) ((lambda (x) (x x))
                    (lambda (y) (f (lambda (arg . args)
                                     (apply (y y) arg args))))))
       ;; y-fibgen-builder
       (lambda (f)
         (lambda (a b)
           (fcons a (lambda () (f b (+ a b))))))) 0 1) idx)))


;;; substituting in the fstream-car/cdr/cons/force functions



(define fibs-integrated-6
  (lambda (idx)
    ((;; y combinator
      (lambda (f) ((lambda (x) (x x))
                       (lambda (y) (f (lambda (arg . args)
                                        (apply (y y) arg args)))))) 
        
        ;; y-stream-ref-builder
      (lambda (f)
        (lambda (stream idx)
          (if (= idx 0) 
              ;; fcar
              ((lambda (pair) (pair (lambda (hd tl) hd)))
               stream)
              ;; y-recursive case
              (f ( ;; force 
                  (lambda (thunk) (thunk)) 
                  ;; fcdr
                   ((lambda (pair) (pair (lambda (hd tl) tl)))
                     stream)) (- idx 1)))))) 
     
     
     ((;; y combinator
       (lambda (f) ((lambda (x) (x x))
                    (lambda (y) (f (lambda (arg . args)
                                     (apply (y y) arg args))))))
       ;; y-fibgen-builder
       (lambda (f)
         (lambda (a b)
           (;; fcons
            (lambda (hd tl) (lambda (a) (a hd tl)))
            a (lambda () (f b (+ a b))))))) 0 1) idx)))



;;; final destination

(define fibs-final
  (lambda (idx)
    (((lambda (f) ((lambda (x) (x x))
                   (lambda (y) (f (lambda (arg . args)
                                    (apply (y y) arg args))))))        
      (lambda (f)
        (lambda (stream idx)
          (if (= idx 0) 
              ((lambda (pair) (pair (lambda (hd tl) hd))) stream)
              (f ((lambda (thunk) (thunk)) 
                  ((lambda (pair) (pair (lambda (hd tl) tl)))
                   stream)) (- idx 1)))))) 
     (((lambda (f) ((lambda (x) (x x))
                    (lambda (y) (f (lambda (arg . args)
                                     (apply (y y) arg args))))))
       (lambda (f)
         (lambda (a b)
           ((lambda (hd tl) (lambda (a) (a hd tl)))
            a (lambda () (f b (+ a b))))))) 0 1) idx)))


;;;; (fibs-final 12) => 144

;;;; (fibs-final 16667) =>  703906611271...