Y-Combinator in Clojure based on Jim Weirich's talk Y-NOT

y-combinator-clojure.clj

;; This gist roughly transribes the demo
;; by Jim Weirich during his talk on Y-Combinator
;; called Y-Not.
;; http://www.infoq.com/presentations/Y-Combinator
;; Jim does a phenomenal job of explaining in the demo.
;; Therefore, this gist only attempts to provide
;; the code example from the poor quality video
;; The examples are simplified at some places
;; based on how I tried to understand it


;; Higher order functions

(do
   (def add1 (fn [n] (+ n 1)))
   (def mul3 (fn [n] (* n 3)))
   (mul3 (add1 10))
   )

;;33

;; introduce a Higher Order functions 'make-adder'
;; 'make-adder' returns a function that adds 1

;; introduce 'compose' as a higher order function
;; 'compose' takes two functions as arguments and returns
;; a composition of those 2 functions
;; 'compose' is a higher order function in its parameters
;; as well as its return value

(do
   (def make-adder
     (fn [x]
       (fn [n] (+ n x))))

   (def compose
     (fn [f, g]
       (fn [n] (f (g n)))))

   (def add1 (make-adder 1))
   (def mul3 (fn [n] (* n )))

   (def mul3add1 (compose mul3 add1))

   (mul3add1 10)
   )
;;11

;; Functional refactorings
;; 1) Tennent Correspondence principle
;; 2) Introduce Binding
;; 3) Wrap a function
;; 4) Inlining

;;let use the simple example and take it through all
;;4 refactoring steps

(do
   (def add
     (fn [n] ( + n 1))   ;; change this using tenent correspondence principle
     )

   (add 1 2)
   )


;; Tennent Correspondence Principle
;; wrap an expression 's-exp' in a lambda expression (fn [] s-exp) and
;; immediately call it ((fn [] s-exp)) [notice the extra braces]

 (do
   (def add
     (fn [n] ((fn [] ( + n 1))))  ;;Tennent
     )

   (add 1)
   )

;;2

;; 2) Introduce Binding
;; Add an argument to a function, that is not bounded already
;; Wrap sexp => (fn [n] (+ n1)) with ((fn [v] sexp) 1).
;; 1 is a dummy variable that is never used, therefore no change in behavior
;;

 (do
   (def add
     ((fn [v] (fn [n] (+ n 1))) 1)  ;;binding v
     )

   (add 1)
   )

;; 3) Wrap function
;; This refactoring just wraps around a function and calls the
;; wrapped function with the value pass to it.
;; sexp' = (fn [x] ...) =>  (fn [y] ((sexp') y))

 (do
   (def add
     ((fn [y]
        ((fn [v] (fn [n] (+ n 1))) 1))  ;;function wrapping
      y)
     )

   (add 1)
   )

;; 4) inlining
;; take defintion of the function and replace any call to that definition
;; with the definition
;; Here we replace the definition of add into (add 1)

(do
  (((fn [y]
        ((fn [v] (fn [n] (+ n 1))) 1)) ;;inlining
      y) 1)
   )

;;the above expression does not have any names function
;;hence forms a nice lambda expression

;; Done with 4 refactoring on the original example

;; Example of arriving at Y-combinator
;; using the example of recursive factorial function

;; Start with the naive implementation
;; of factorial function

(def fact-1 (fn [n] (if (zero? n) 1 (* n (fact-1 (dec n))))))

(fact-1 10)
;;3628800

;; try converting the above expression
;; into a pure lambda expression without any named functions
;; try function inlining

(fact-1 (fn [n] (if (zero? n) 1 (* n (fact-1 (dec n))))))  ;; compiler error

;;but the above expression does not work. Since, the compiler
;;does not find fact-1

;; Try passing function name as parameter
;; Create a higher-order function that takes the definition of
;; fact-1 and return another function

(def make-fact (fn [fact-1]
                    (fn [n] (if (zero? n) 1 (* n (fact-1 (dec n)))))))


(make-fact ???) ;; in catch-22 mode, we still can't get fact-1

;; Get hold off a partial defintion of factorial
;; that is a factorial function works only for smaller domain of inputs.

;;define eror
(def error (fn [n] (throw "This should never get called")))

;;call the function the the factorial function the 'improver'
(def improver
  (fn [partial]
    (fn [n] (if (zero? n) 1 (* n (partial (dec n)))))))

;; factorial works for 0
(def f0 (improver error))
(f0 0)
;;1

(f0 1)  ;; fails

;;but we can use f0 to make g1

(def f1 (improver f0))
(f1 1)
;;1

;;so we can go on with the next factorial..
(def f2 (improver f1))
(f2 2)

(def f3 (improver f2))
(f3 3)

;; So far: introduced a partial function with a placeholder function 'error'
;; which never gets called since we build the first version of the function
;; using the base value of 0.

;; Generalize the improver
;; we can generalize f1, f2, ...fn with fx, fx takes improver
;; as its parameter in the above examples. Therefore,

(def fx
  ((fn [improver] (improver error))
   (fn [partial]
     (fn [n] (if (zero? n) 1 (* n (partial (dec n))))))
   )
  )

;;but version again works for only (fact 0)
(fx 0)
;;0

(fx 1)
;;error

;; replace (improver error) with (improver improver)
(def fx
  ((fn [improver] (improver improver)) ;;change here
   (fn [improver] ;;change here
     (fn [n] (if (zero? n) 1 (* n ((improver improver)(dec n)))))) ;;change here
   )
  )

(fx 5)

;; So, whats happening above is we are setting up a lazy
;; sequence of recursive calls. For a call like
;; each subsequent calls sets up the improver for a smaller value
;; of n. Thefore, the inner most call will be similar to the call
;; ((improver improver) 0), when the recursive part of the function
;; is not evaluated.

;; replace improver with x
((def fx
   ((fn [x] (x x))
    (fn [x]
      (fn [n] (if (zero? n) 1 (* n ((x x) (dec n)))))))
   ) 5)

;;120

;; semantics of factorial and recursion is mixed up here
;; we want to get two pieces of the factorial function out
;; a) the base case and 2) the recursive call

;; In refactoring these 2 pieces out, we will use a bind variable and pass these pieces
;; into the function using the bind variable. To achive this we need to use the functional
;; refactoring techniques. First we will wrap the sexp that needs to be refactored out,
;;  perform Tennent Correspondence Principle on the outer sexp, then we
;; we create a binding and then pass a value to that binding. Here the value will be the
;; piece we are factoring out. Finally, we will do the inlining


;;let refactor out the recursive piece first
;; we want to tease out (x x) =>  (fn [] ((x x)) v)
;; here we see we extracted out (x x) by
(((fn [x] (x x))
  (fn [x]
    ((fn [code]   ;; tennent correspondence and binding
       (fn [n] (if (zero? n) 1 (* n (code (dec n))))))
     (fn [v] ((x x) v)))
    ))
  5)


;; Factor out '(fn [n] (if (zero? n) 1 (* n (code (dec n)))))'.
;; Perform the same number of steps tennent, bind, wrap and pass the argument

;;tennent correspondence principle
(((fn [x] (x x))

  ((fn []
     (fn [x]
            ((fn [code]
               (fn [n] (if (zero? n) 1 (* n (code (dec n)))))
               )
             (fn [v] ((x x) v)))
            )))
  )
  5)
;; 120

;; before we bind, we rename code to partial
(((fn [x] (x x))
  ((fn []
     (fn [x]
            ((fn [partial]
               (fn [n] (if (zero? n) 1 (* n (partial (dec n)))))
               )
             (fn [v] ((x x) v)))
            )))
  )
  5)
;; 120

;; Notice both the base and recursive parts of
;; factorial function was extracted

(((fn [code] ;;exract into y
    ((fn [x] (x x))
     (fn [x]
       (code
        (fn [v] ((x x) v)))
       )))
    (fn [partial] ;;extract into fact-improver
      (fn [n] (if (zero? n) 1 (* n (partial (dec n)))))))
 5)


;;extract two pieces from above expressions
(def y
  (fn [code]
    ((fn [x] (x x))
     (fn [x]
       (code
        (fn [v] ((x x) v)))
       ))))

(def fact-improver
  (fn [partial]
      (fn [n] (if (zero? n) 1 (* n (partial (dec n)))))))

((y fact-improver
  )
 5)


;;or

(def fact (y fact-improver))

(fact 5)
;;120

;;therefore here y is the y-combinator
;;usually called the z-combinator or applicative order y-combinator

;; Start formating y the same way the y-combinator is defined on
;; wikipedia
;; rename code to f
(def y
  (fn [f]
    ((fn [x] (x x))
     (fn [x]
       (f
        (fn [v] ((x x) v)))
       ))))

;; calling f on (x x ) does not change anything
;; since (x x) returns a fixed-point function
(def y
  (fn [f]
    ((fn [x] (f (x x)))
     (fn [x]
       (f
        (fn [v] ((x x) v)))
       ))))

;; tennent principle, binding and wrap on (x x)
(def y
  (fn [f]
    ((fn [x] (f (fn [v] ((x x) v))))
     (fn [x]
       (f
        (fn [v] ((x x) v)))
       ))))

;;rearranging, we have a definition similar to
;;the one available on wikepedia
(def y
  (fn [f]
    ((fn [x] (f (fn [v] ((x x) v))))
     (fn [x] (f (fn [v] ((x x) v)))
       ))))