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