{"id":427,"date":"2012-09-15T00:14:51","date_gmt":"2012-09-14T14:14:51","guid":{"rendered":"http:\/\/juliangamble.com\/blog\/?p=427"},"modified":"2013-12-27T10:56:23","modified_gmt":"2013-12-26T23:56:23","slug":"the-little-schemer-in-clojure-chapter-9-lambda-the-ultimate-deriving-the-y-combinator","status":"publish","type":"post","link":"https:\/\/juliangamble.com\/blog\/2012\/09\/15\/the-little-schemer-in-clojure-chapter-9-lambda-the-ultimate-deriving-the-y-combinator\/","title":{"rendered":"The Little Schemer in Clojure – Chapter 9 – Lambda The Ultimate (Deriving the Y-Combinator)"},"content":{"rendered":"

This is the ninth chapter of a series of posts about porting\u00a0The Little Schemer<\/a>\u00a0to Clojure. You may wish to\u00a0read the intro<\/a>.<\/em><\/p>\n

So far we’ve covered\u00a0flat data structures<\/a>,\u00a0reading flat data structures<\/a>,\u00a0creating data structures<\/a>,\u00a0creating a numeric tower<\/a>, working with\u00a0multiple occurrences of a match in the list<\/a>, \u00a0changing our functions to work with nested lists<\/a>,\u00a0building a numerical expression evaluator<\/a>\u00a0and performing analysis on sets and numeric functions<\/a>.<\/p>\n

This chapter is one of the high points of the whole book. You may have heard of Paul Graham’s VC fund, YCombinator<\/a> – in this session we’ll not only explain the programming concept of the YCombinator<\/a> – we’ll derive it in Clojure.<\/p>\n

Ok – so before we get started – what is it? What is this YCombinator concept everyone is so excited about? Here goes. The YCombinator is a way to do recursion in a language that doesn’t support recursion<\/em>. Instead recursion is defined as a set of rewrite rules.<\/p>\n

“What?” I hear you saying. “All the languages I use have recursion, is this just some old hack that people used in the 60’s before they had real languages? Why should I get excited about that?” Fair enough. On it’s own its utility is limited, but it becomes a conceptual building block for lazy functional data structures – which are one of the things that people get excited about in Clojure – and something we don’t see in curly brace languages.<\/p>\n

So anyway – let’s get started.<\/p>\n

We’ll start with the rember-f<\/code> function. This takes a list of items, an addition atom and a comparison function. The point is to demonstrate passing functions around.<\/p>\n

\r\n;demonstrating passing functions around\r\n(def rember-f\r\n  (fn [test? a l]\r\n    (cond\r\n      (null? l) '()\r\n      true (cond\r\n             (test? (first l) a) (rest l)\r\n             true (cons (first l) (rember-f test? a (rest l)))))))\r\n\r\n(println (rember-f = '(pop corn) '(lemonade (pop corn) and (cake))))\r\n;\/\/=>(lemonade and (cake))\r\n<\/pre>\n
So we passed in the equals function (=<\/code>) and it was used to test equality with the other item passed in.<\/p>\n
Now we’ll rewrite the rember-f<\/code> function to remove the second conditional:<\/p>\n
\r\n(def rember-f\r\n  (fn [test? a l]\r\n    (cond\r\n      (null? l) '()\r\n      (test? (first l) a) (rest l)\r\n      true (cons (first l) (rember-f test? a (rest l))))))\r\n\r\n(println (rember-f = '(pop corn) '(lemonade (pop corn) and (cake))))\r\n;\/\/=>(lemonade and (cake))\r\n<\/pre>\n
Now we’re going to start looking at writing functions to be curried. By currying we’re referring to the Mathematician Haskell Curry<\/a> – for whom this is named. The idea of currying a function is that you can pass in fewer than all the functions required for the function to execute, and still pass the result around as a function (now with fewer arguments).<\/p>\n
\r\n(def eq?-c\r\n  (fn [a]\r\n    (fn [x]\r\n      (= x a))))\r\n\r\n(println (eq?-c 'lemonade))\r\n=> (println (eq?-c 'lemonade))\r\n#<Chapter9LambdaTheUltimate$eq_QMARK__c$fn__974 Chapter9LambdaTheUltimate$eq_QMARK__c$fn__974@2a2a2ae9>\r\n(println ((eq?-c 'lemonade) 'coke))\r\n;\/\/=> false\r\n(println ((eq?-c 'lemonade) 'lemonade))\r\n;\/\/=> true\r\n\r\n(def eq?-salad (eq?-c 'salad))\r\n\r\n(println (eq?-salad 'tuna))\r\n;\/\/=>false\r\n(println (eq?-salad 'salad))\r\n;\/\/=>true\r\n\r\n<\/pre>\n
Ok – taking that principle to the next level – can we curry our rember-f<\/code> function? Here goes:<\/p>\n
\r\n(def rember-f\r\n  (fn [test?]\r\n    (fn [a l]\r\n      (cond\r\n        (null? l) '()\r\n        (test? (first l) a) (rest l)\r\n        true (cons (first l) ((rember-f test?) a (rest l)))))))\r\n\r\n(println ((rember-f =) 'tuna '(tuna salad is good)))\r\n;\/\/=>(salad is good)\r\n\r\n(def rember-eq? (rember-f =))\r\n(println (rember-eq? 'tuna '(tuna salad is good)))\r\n;\/\/=>(salad is good)\r\n<\/pre>\n
That was so much fun, we’ll do it again with something similar, the insertL-f<\/code> function.<\/p>\n
\r\n(def insertL-f\r\n  (fn [test?]\r\n    (fn [new old l]\r\n      (cond\r\n        (null? l) '()\r\n        (test? (first l) old) (cons new (cons old (rest l)))\r\n        true (cons (first l) ((insertL-f test?) new old (rest l)))))))\r\n\r\n(println ((insertL-f =) 'creamy 'latte '(a hot cup of latte)))\r\n<\/pre>\n
One more time! Let’s look at insertR-f<\/code>:<\/p>\n
\r\n(def insertR-f\r\n  (fn [test?]\r\n    (fn [new old l]\r\n      (cond\r\n        (null? l) '()\r\n        (test? (first l) old) (cons old (cons new (rest l)))\r\n        true (cons (first l) ((insertR-f test?) new old (rest l)))))))\r\n\r\n(println ((insertR-f =) 'cake 'cheese '(new york cheese)))\r\n<\/pre>\n
Ok – so you’ve probably noticed that insertR<\/code> and insertL<\/code> are quite similar except for a piece of code in the middle. Now we’re going to try and replace these two functions with a single function insert-g<\/code>, that gets another function argument passed in for the difference. We’ll call the functions we insert seqL<\/code> and seqR<\/code>. Here goes:<\/p>\n
\r\n(def seqL\r\n  (fn [new old l]\r\n    (cons new (cons old l))))\r\n\r\n(def seqR\r\n  (fn [new old l]\r\n    (cons old (cons new l))))\r\n\r\n(def insert-g\r\n  (fn [seqarg]\r\n    (fn [new old l]\r\n      (cond\r\n        (null? l) '()\r\n        (= (first l) old) (seqarg new old (rest l))\r\n        true (cons (first l) ((insert-g seqarg) new old (rest l)))))))\r\n\r\n(def insertL (insert-g seqL))\r\n(println (insertL 'creamy 'latte '(a hot cup of latte)))\r\n;\/\/=>(a hot cup of creamy latte)\r\n(def insertR (insert-g seqR))\r\n(println (insertR 'cake 'cheese '(new york cheese)))\r\n;\/\/=>(new york cheese cake)\r\n<\/pre>\n
Ok – what if we do that again – but don’t pass in seqL<\/code> as a named function – just implement it in the definition of insertL<\/code>?<\/p>\n
\r\n(def insertL\r\n  (insert-g\r\n    (fn [new old l]\r\n      (cons new (cons old l)))))\r\n(println (insertL 'creamy 'latte '(a hot cup of latte)))\r\n;\/\/=>(a hot cup of creamy latte)\r\n<\/pre>\n
You can argue that this is better as we don’t have to remember as many function names.<\/p>\n
Now we’ll look at the subst<\/code> function from Chapter 3<\/a>.<\/p>\n
\r\n(def subst\r\n  (fn [new old l]\r\n    (cond\r\n      (null? l) '()\r\n      (= (first l) old) (cons new (rest l))\r\n      true (cons (first l) (subst new old (rest l))))))\r\n\r\n(println (subst 'espresso 'latte '(a hot cup of latte)))\r\n;\/\/=>(a hot cup of espresso)\r\n<\/pre>\n
So what we notice is that subst<\/code> is quite close to insertL<\/code> and insertR<\/code>. So now we can write a new seq function for insert-g<\/code>. Then we can plug it into a new definition of subst<\/code>:<\/p>\n
\r\n(def seqS\r\n  (fn [new old l]\r\n    (cons new l)))\r\n\r\n(def subst (insert-g seqS))\r\n\r\n(println (subst 'espresso 'latte '(a hot cup of latte)))\r\n;\/\/>(a hot cup of espresso)\r\n<\/pre>\n
Cool – now we can use this technique on the rember<\/code> function:<\/p>\n
\r\n(def seqrem\r\n  (fn [new old l]\r\n    l))\r\n\r\n(def rember\r\n  (fn [a l]\r\n    ((insert-g seqrem) nil a l)))\r\n\r\n(println (rember 'hot '(a hot cup of espresso)))\r\n;\/\/=>(a cup of espresso)\r\n<\/pre>\n
It’s time for another Commandment<\/em>. The Tenth Commandment states that you should “Abstract functions with common structures into a single function<\/strong>“. This is kind of like extract method – except that you pass the method in as a closure.<\/p>\n
Now we’ll go back to the value function from Chapter 7.<\/p>\n
\r\n(def number_?\r\n  (fn [a]\r\n    (cond\r\n      (null? a) false\r\n      (number? a) true\r\n      true false)))\r\n\r\n(def first-sub-exp\r\n  (fn [aexp]\r\n    (first (rest aexp))))\r\n\r\n(def second-sub-exp\r\n  (fn [aexp]\r\n    (first (rest (rest aexp)))))\r\n\r\n(def operator\r\n  (fn [aexp]\r\n    (first aexp)))\r\n\r\n(use 'clojure.math.numeric-tower)\r\n\r\n(def value\r\n  (fn [aexp]\r\n    (cond\r\n      (number_? aexp) aexp\r\n      (= (operator aexp) '+) (+ (value (first-sub-exp aexp)) (value  (second-sub-exp aexp)))\r\n      (= (operator aexp) '*) (* (value (first-sub-exp aexp)) (value (second-sub-exp aexp)))\r\n      (= (operator aexp) 'exp) (expt (value (first-sub-exp aexp)) (value (second-sub-exp aexp))))))\r\n\r\n(println (value '(+ 1 1)))\r\n;\/\/=>2\r\n<\/pre>\n
Now we’ll simplify this down by using a function to take a symbol and return a function:<\/p>\n
\r\n(def atom-to-function\r\n  (fn [x]\r\n    (cond\r\n      (= x '+ ) +\r\n      (= x '* ) *\r\n      (= x 'exp ) expt )))\r\n\r\n(def value\r\n  (fn [aexp]\r\n    (cond\r\n      (number_? aexp) aexp\r\n      true ((atom-to-function (operator aexp))\r\n             (value (first-sub-exp aexp))\r\n             (value (second-sub-exp aexp))))))\r\n\r\n(println (value '(+ 1 1)))\r\n;\/\/=> 2\r\n<\/pre>\n
So that was a bit shorter.<\/p>\n
Now we’ll look at subset?<\/code> and intersect?<\/code> from Chapter 8<\/a>.<\/p>\n
\r\n(def member?\r\n  (fn [a lat]\r\n    (cond\r\n      (null? lat) false\r\n      true (or\r\n        (= (first lat) a)\r\n        (member? a (rest lat)))) ))\r\n\r\n(def subset?\r\n  (fn [set1 set2]\r\n    (cond\r\n      (null? set1) true\r\n      true (and\r\n             (member? (first set1) set2)\r\n             (subset? (rest set1) set2)))))\r\n(println (subset? '(a b c) '(b c d)))\r\n;\/\/=>false\r\n(println (subset? '(b c) '(b c d)))\r\n;\/\/=>true\r\n\r\n(def intersect?\r\n  (fn [set1 set2]\r\n    (cond\r\n      (null? set1) false\r\n      true (or\r\n             (member? (first set1) set2)\r\n             (intersect? (rest set1) set2)))))\r\n\r\n(println (intersect? '(a b c) '(b c d)))\r\n;\/\/=>true\r\n<\/pre>\n
What we notice is that these two functions only differ in their use of and true and or nil. We can try and abstract them as we’ve done before.<\/p>\n
\r\n(def set-f?\r\n  (fn [logical? const]\r\n    (fn [set1 set2]\r\n      (cond\r\n        (null? set1) const\r\n        true (logical?\r\n               (member? (first set1) set2)\r\n               ((set-f? logical? const) (rest set1) set2))))))\r\n\r\n;(def subset? (set-f? and true))\r\n;(def intersect? (set-f? or nil))\r\n; note - doesn't work yet\r\n<\/pre>\n
But this doesn’t work. (This is where a light bulb comes on and we start learning). We need to redefine the and and or functions for the functions we’re using:<\/p>\n
\r\n(def and-prime\r\n  (fn [x y]\r\n    (and x y)))\r\n\r\n(def or-prime\r\n  (fn [x y]\r\n    (or x y)))\r\n; still doesn't work\r\n\r\n(def or-prime\r\n  (fn [x set1 set2]\r\n    (or x (intersect? (rest set1) set2))))\r\n\r\n(def and-prime\r\n  (fn [x set1 set2]\r\n    (and x (subset? (rest set1) set2))))\r\n\r\n(def set-f?\r\n  (fn [logical? const]\r\n    (fn [set1 set2]\r\n      (cond\r\n        (null? set1) const\r\n        true (logical?\r\n               (member? (first set1) set2)\r\n               set1 set2)))))\r\n\r\n(def intersect? (set-f? or-prime false))\r\n(def subset? (set-f? and-prime true))\r\n\r\n(println (intersect?  '(toasted banana bread) '(breakfast toasted banana bread with butter for breakfast)))\r\n;\/\/=>true\r\n(println (subset? '(banana butter) '(breakfast toasted banana bread with butter for breakfast)))\r\n;\/\/=>true\r\n<\/pre>\n
The tricky thing there was the recursive use and definition of intersect?<\/code> ie assuming we could use a function before we had defined it in one function, and then using that function to define insersect?<\/code> – somewhat brain bending!<\/p>\n
You can see we wrote set-f<\/code> to accept and-prime<\/code> and or-prime<\/code> as functions passed in as arguments.<\/p>\n
Ok – so we’re all warmed up with passing functions around as arguments. Let’s get on with this Y Combinator derivation. We’ll start with multirember from Chapter 5<\/a>. We’ll simplify it to remove the redundant cond<\/code>:<\/p>\n
\r\n(def multirember\r\n  (fn [a lat]\r\n    (cond\r\n      (null? lat) '()\r\n      (= (first lat) a) (multirember a (rest lat))\r\n      true (cons (first lat) (multirember a (rest lat))))))\r\n\r\n(println (multirember 'breakfast '(breakfast toasted banana bread with butter for breakfast)))\r\n;\/\/=>(toasted banana bread with butter for)\r\n<\/pre>\n
Too easy. Now we’ll curry this function to return a function that removes a particular list member:<\/p>\n
\r\n(def mrember-curry\r\n  (fn [l]\r\n    (multirember 'curry l)))\r\n\r\n(println (mrember-curry '(curry chicken with curry rice)))\r\n;\/\/=>(chicken with rice)\r\n<\/pre>\n
Again we’ve done this before – not too hard. Now we’ll rewrite mrember-curry in full without currying it:<\/p>\n
\r\n(def mrember-curry\r\n  (fn [l]\r\n    (cond\r\n      (null? l) '()\r\n      (= (first l) 'curry) (mrember-curry (rest l))\r\n      true (cons (first l) (mrember-curry (rest l))))))\r\n\r\n(println (mrember-curry '(curry chicken with curry rice)))\r\n;\/\/=>(chicken with rice)\r\n<\/pre>\n
Now let’s curry the function above again<\/em> with an argument that the curried function can be applied to:<\/p>\n
\r\n(def curry-maker\r\n  (fn [future]\r\n    (fn [l]\r\n      (cond\r\n        (null? l) '()\r\n        (= (first l) 'curry) ((curry-maker future) (rest l))\r\n        true (cons (first l) ((curry-maker future) (rest l)))))))\r\n\r\n(def mrember-curry (curry-maker 0))\r\n;\/\/=>(chicken with rice)\r\n<\/pre>\n
Ok so why did we bother with that one? We’ll its like how we replaced insertL<\/code> with insert-g<\/code> – except we applied it to a function that already returns functions.<\/p>\n
Let’s look at how we use it. We can use curry-maker<\/code> to define mrember-curry<\/code> with curry-maker<\/code>.<\/p>\n
\r\n(def mrember-curry\r\n  (curry-maker curry-maker))\r\n\r\n(println (mrember-curry '(curry chicken with curry rice)))\r\n;\/\/=>(chicken with rice)\r\n<\/pre>\n
Ok – that wasn’t a big deal – we replaced a zero value with another function. Let’s apply it further. We’ll use this zero replacement in curry-maker<\/code> to write a function function-maker<\/code>:<\/p>\n
\r\n(def function-maker\r\n  (fn [future]\r\n    (fn [l]\r\n      (cond\r\n        (null? l) '()\r\n        (= (first l) 'curry) ((future future) (rest l))\r\n        true (cons (first l) ((future future) (rest l)))))))\r\n\r\n;for yielding mrember-curry when applied to a fcuntion\r\n\r\n;\r\n(def mrember-curry\r\n  (function-maker function-maker))\r\n(println (mrember-curry '(curry chicken with curry rice)))\r\n;\/\/=>(chicken with rice)\r\n<\/pre>\n
Ok – we’re about half way there. Now for any internal expression inside a function, we can wrap it in an applied lamdba<\/code> (fn<\/code> in clojure) and still have it return the same result. We’ll do that for our function-maker function.<\/p>\n
\r\n(def function-maker\r\n  (fn [future]\r\n    (fn [l]\r\n      (cond\r\n        (null? l) '()\r\n        (= (first l) 'curry) ((fn [arg] ((future future) arg)) (rest l))\r\n        true (cons (first l) ((fn [arg] ((future future) arg)) (rest l)))))))\r\n\r\n(def mrember-curry\r\n  (function-maker function-maker))\r\n(println (mrember-curry '(curry chicken with curry rice)))\r\n;\/\/=>(chicken with rice)\r\n<\/pre>\n
Ok – that all still works ok.<\/p>\n
Now – our function-maker<\/code> is in a way double-curried. What if we curry it again?<\/p>\n
\r\n(def function-maker\r\n  (fn [future]\r\n    ((fn [recfun]\r\n      (fn [l]\r\n        (cond\r\n          (null? l) '()\r\n          (= (first l) 'curry) (recfun (rest l))\r\n        true (cons (first l) ((future future))))))\r\n    (fn [arg] ((future future) arg)))))\r\n;abstraction above to remove l\r\n; just take my word on this for now\r\n<\/pre>\n
Now we’ll split our triple-curried function into two functions:<\/p>\n
\r\n(def M\r\n  (fn [recfun]\r\n    (fn [l]\r\n      (cond\r\n        (null? l) '()\r\n        (= (first l) 'curry) (recfun (rest l))\r\n        true (cons (first l) (recfun (rest l)))))))\r\n\r\n(def function-maker\r\n  (fn [future]\r\n    (M (fn [arg]\r\n         ((future future) arg)))))\r\n<\/pre>\n
Now we’ll refactor mrember-curry<\/code> without an explicit reference to function-maker<\/code>:<\/p>\n
\r\n;Now we'll change this\r\n(def mrember-curry\r\n  (function-maker function-maker))\r\n;to this\r\n(def mrember-curry\r\n  ((fn [future]\r\n     (M (fn [arg]\r\n          ((future future) arg))))\r\n    (fn [future]\r\n      (M (fn [arg]\r\n           ((future future) arg))))))\r\n\r\n<\/pre>\n
This is where the book recommends you take a rest. We’ll push on.<\/p>\n
Now we’ll refactor this definition by allowing you to pass in M as a function:<\/p>\n
\r\n(def Y\r\n  (fn [M]\r\n    ((fn [future]\r\n       (M (fn [arg]\r\n            ((future future) arg))))\r\n      (fn [future]\r\n        (M (fn [arg]\r\n             ((future future) arg)))))))\r\n\r\n(def mrember-curry (Y M))\r\n\r\n(println (mrember-curry '(curry chicken with curry rice)))\r\n;\/\/=>(chicken with rice)\r\n<\/pre>\n
That wasn’t too bad. We just used the y-combinator on the mrember<\/code> function. Now we’ll do it for length<\/code>:<\/p>\n
\r\n;using add1 from chapter 7 not chapter 4\r\n(def add1\r\n  (fn [n]\r\n    (cons '() n)))\r\n\r\n; now we'll look at using the y-combinator to look at the length of a list\r\n(def L\r\n  (fn [recfun]\r\n    (fn [l]\r\n      (cond\r\n        (null? l) '()\r\n        true (add1 (recfun (rest l)))))))\r\n\r\n(def length (Y L))\r\n\r\n(println (length '(curry chicken with curry rice)))\r\n;\/\/=>(() () () () ()) ie 5\r\n<\/pre>\n
Now we’ll do it again, but won’t pass in a definition for L<\/code> – but just use the definition inline:<\/p>\n
\r\n(def add1\r\n  (fn [n]\r\n    (+ 1 n)))\r\n\r\n;just for the sake of it - we'll rewrite length without the L function\r\n(def length\r\n  (Y\r\n    (fn [recfun]\r\n      (fn [l]\r\n        (cond\r\n          (null? l) 0\r\n          true (add1 (recfun (rest l))))))))\r\n\r\n(println (length '(curry chicken with curry rice)))\r\n;\/\/=>5\r\n<\/pre>\n
Now we’ll rewrite length<\/code> without Y<\/code> or L<\/code>:<\/p>\n
\r\n(def length\r\n  ((fn [M]\r\n     ((fn [future]\r\n        (M (fn [arg]\r\n             ((future future) arg))))\r\n     (fn [future]\r\n       (M (fn [arg]\r\n            ((future future) arg))))))\r\n    (fn [recfun]\r\n      (fn [l]\r\n        (cond\r\n          (null? l) 0\r\n          true (add1 (recfun (rest l))))))))\r\n\r\n(println (length '(curry chicken with curry rice)))\r\n;\/\/=>5\r\n<\/pre>\n
Ok that ends the Chapter – but we want to take this thing to the next level. Let’s use the ycombinator to start defining a lazy function:<\/p>\n
\r\n;building a pair with an S-expression and a thunk leads to a stream\r\n(def first$ first)\r\n\r\n(def second$\r\n  (fn [str]\r\n    ((second str))))\r\n\r\n; careful re use of first and second here - as yet undefined!\r\n\r\n(def build\r\n  (fn [a b]\r\n    (cond\r\n      true (cons a (cons b '())))))\r\n\r\n(def str-maker\r\n  (fn [next n]\r\n    (build n (fn [] (str-maker next (next n))))))\r\n\r\n(def int_ (str-maker add1 0))\r\n\r\n(def even (str-maker (fn [n] (+ 2 n)) 0))\r\n\r\n;sub1 from chapter 4\r\n(def sub1\r\n  (fn [n]\r\n    (- n 1)))\r\n\r\n(def frontier\r\n  (fn [str n]\r\n    (cond\r\n      (zero? n) '()\r\n      true (cons (first$ str) (frontier (second$ str) (sub1 n))))))\r\n\r\n(frontier int_ 10)\r\n;\/\/=>(0 1 2 3 4 5 6 7 8 9)\r\n<\/pre>\n
So that got us the creation of a lazy data structure for a basic example. Now let’s try a more interesting one:<\/p>\n
\r\n(def Q\r\n  (fn [str n]\r\n    (cond\r\n      (zero? (rem (first$ str) n)) (Q (second$ str) n)\r\n      true (build (first$ str) (fn [] (Q (second$ str) n))))))\r\n; note new function call rem - re new primitve\r\n\r\n(def P\r\n  (fn [str]\r\n    (build (first$ str) (fn [] (P (Q str (first$ str)))))))\r\n\r\n(frontier (P (second$ (second$ int_))) 10)\r\n;\/\/=>(2 3 5 7 11 13 17 19 23 29)\r\n<\/pre>\n
What an interesting stream of numbers!<\/p>\n
That’s enough for today.<\/p>\n
You can see it working here<\/a>.<\/p>\n
References<\/strong><\/p>\n
Here are some additional references on deriving the Y-Combinator<\/p>\n