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

• Deriving the Y Combinator in Scheme.
• A second approach to deriving the Y Combinator in Scheme
• Deriving the Y Combinator in Javascript
• Another approach to deriving the Y Combinator in Javascript
• Deriving the Y Combinator in Clojure

This is the eighth 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 and building a numerical expression evaluator.

This chapter we’ll look at sets, relations and functions (in the mathematical sense).  So starting with set? let’s see if a list contains a set of unique items.

(def set_?
  (fn [lat]
    (cond
      (null? lat) true
      true (cond
             (member? (first lat) (rest lat)) false
             true (set_? (rest lat))))))

(println (set_? '(toasted banana bread with butter for breakfast)))
;//=>true
(println (set_? '(breakfast toasted banana bread with butter for breakfast)))
;//=>false

Note that this assumes the implementation of member? from Chapter 5.

Now let’s simplify our definition of set?:

(def member
  (fn [lat]
    (cond
      (null? lat) true
      (member? (first lat) (rest lat)) false
      true (set? (rest lat)))))

(println (set_? '(toasted banana bread with butter for breakfast)))
;//=>true
(println (set_? '(breakfast toasted banana bread with butter for breakfast)))
;//=>false

Now given a non-unique list of items, let’s return a set of unique items based on the original list with makeset:

(def makeset
  (fn [lat]
    (cond
      (null? lat) '()
      (member? (first lat) (rest lat)) (makeset (rest lat))
      true (cons (first lat) (makeset (rest lat))))))

(println (makeset '(breakfast toasted banana bread with butter for breakfast)))
;//=> (toasted banana bread with butter for breakfast)
(println (set_? (makeset '(breakfast toasted banana bread with butter for breakfast))))
;//=>true

Now we’ll refactor makeset using our definition of multirember from Chapter 5:

(def makeset
  (fn [lat]
    (cond
      (null? lat) '()
      true (cons (first lat) (makeset (multirember (first lat) (rest lat)))))))

(println "")
(println "makeset - refactored with multirember")
(println (makeset '(breakfast toasted banana bread with butter for breakfast)))
;//=> (breakfast toasted banana bread with butter for)
; note other way around
(println (set_? (makeset '(breakfast toasted banana bread with butter for breakfast))))
;//=>true

While we’re looking at sets, let’s write a function to work out if one set is a subset of another:

(def subset?
  (fn [set1 set2]
    (cond
      (null? set1) true
      true (cond
             (member? (first set1) set2) (subset? (rest set1) set2)
             true false))))

(println (subset? '(banana butter) '(breakfast toasted banana bread with butter for breakfast)))
;//=>true
(println (subset? '(banana butter) '(toasted banana bread with butter for breakfast)))
;//=>true
(println (subset? '(peanut butter) '(toasted banana bread with butter for breakfast)))
;//=>false

Now we’ll refactor subset to remove the second conditional:

(def subset?
  (fn [set1 set2]
    (cond
      (null? set1) true
      (member? (first set1) set2) (subset? (rest set1) set2)
      true false)))

(println (subset? '(banana butter) '(breakfast toasted banana bread with butter for breakfast)))
;//=>true
(println (subset? '(banana butter) '(toasted banana bread with butter for breakfast)))
;//=>true
(println (subset? '(peanut butter) '(toasted banana bread with butter for breakfast)))
;//=>false

Now we’ll refactor subset again to make better use of the trailing final condition:

(def subset?
  (fn [set1 set2]
    (cond
      (null? set1) true
      true (and
             (member? (first set1) set2)
             (subset? (rest set1) set2)))))

(println (subset? '(banana butter) '(breakfast toasted banana bread with butter for breakfast)))
;//=>true
(println (subset? '(banana butter) '(toasted banana bread with butter for breakfast)))
;//=>true
(println (subset? '(peanut butter) '(toasted banana bread with butter for breakfast)))
;//=>false

Now we’ll write eqset to see if two sets are equal (regardless of order):

(def eqset?
  (fn [set1 set2]
    (cond
      (subset? set1 set2) (subset? set2 set1)
      true false)))

(println (eqset? '(toasted banana bread) '(breakfast toasted banana bread with butter for breakfast)))
;//=>false
(println (eqset? '(toasted banana bread) '(toasted banana bread)))
;//=>true
(println (subset? '(toasted peanut butter for breakfast) '(toasted banana bread )))
;//=>false

Now we’ll refactor eqset to have only one condition line:

(def eqset?
  (fn [set1 set2]
    (cond
      true (and
             (subset? set1 set2)
             (subset? set2 set1)))))

(println (eqset? '(toasted banana bread) '(breakfast toasted banana bread with butter for breakfast)))
;//=>false
(println (eqset? '(toasted banana bread) '(toasted banana bread)))
;//=>true
(println (subset? '(toasted peanut butter for breakfast) '(toasted banana bread )))
;//=>false

Now we’ll refactor eqset to remove the condition line altogether:

(def eqset?
  (fn [set1 set2]
      (and
        (subset? set1 set2)
        (subset? set2 set1))))

(println (eqset? '(toasted banana bread) '(breakfast toasted banana bread with butter for breakfast)))
;//=>false
(println (eqset? '(toasted banana bread) '(toasted banana bread)))
;//=>true
(println (subset? '(toasted peanut butter for breakfast) '(toasted banana bread )))
;//=>false

Now we’ll write a test to see if two sets intersect?:

(def intersect?
  (fn [set1 set2]
    (cond
      (null? set1) false
      true (cond
             (member? (first set1) set2) true
             true (intersect? (rest set1) set2)))))

(println (intersect? '(toasted banana bread) '(breakfast toasted banana bread with butter for breakfast)))
;//=>true
(println (intersect? '(toasted banana bread) '(toasted banana bread)))
;//=>true
(println (intersect? '(toasted peanut butter for breakfast) '(toasted banana bread )))
;//=>true
(println (intersect? '(strawberry yoghurt) '(toasted banana bread )))
;//=>false

Now we’ll refactor intersect? to remove the redundant second conditional:

(def intersect?
  (fn [set1 set2]
    (cond
      (null? set1) false
      (member? (first set1) set2) true
      true (intersect? (rest set1) set2))))

(println (intersect? '(toasted banana bread) '(breakfast toasted banana bread with butter for breakfast)))
;//=>true
(println (intersect? '(toasted banana bread) '(toasted banana bread)))
;//=>true
(println (intersect? '(toasted peanut butter for breakfast) '(toasted banana bread )))
;//=>true
(println (intersect? '(strawberry yoghurt) '(toasted banana bread )))
;//=>false

Now we’ll refactor intersect? to make better use of the trailing conditional:

(def intersect?
  (fn [set1 set2]
    (cond
      (null? set1) false
      true (or
             (member? (first set1) set2)
             (intersect? (rest set1) set2)))))

(println (intersect? '(toasted banana bread) '(breakfast toasted banana bread with butter for breakfast)))
;//=>true
(println (intersect? '(toasted banana bread) '(toasted banana bread)))
;//=>true
(println (intersect? '(toasted peanut butter for breakfast) '(toasted banana bread )))
;//=>true
(println (intersect? '(strawberry yoghurt) '(toasted banana bread )))
;//=>false

Now we’ll actually get the values at the intersection:

(def intersect
  (fn [set1 set2]
    (cond
      (null? set1) '()
      (member? (first set1) set2) (cons (first set1) (intersect (rest set1) set2))
      true (intersect (rest set1) set2))))

(println (intersect '(toasted banana bread) '(breakfast toasted banana bread with butter for breakfast)))
;//=>(toasted banana bread)
(println (intersect '(toasted peanut butter for breakfast) '(toasted banana bread )))
;//=>(toasted)
(println (intersect '(strawberry yoghurt) '(toasted banana bread )))
;//=>()

Now we’ll refactor intersect to filter out non-members first:

(def intersect
  (fn [set1 set2]
    (cond
      (null? set1) '()
      (not (member? (first set1) set2)) (intersect (rest set1) set2)
      true (cons (first set1) (intersect (rest set1) set2)))))

(println (intersect '(toasted banana bread) '(breakfast toasted banana bread with butter for breakfast)))
;//=>(toasted banana bread)
(println (intersect '(toasted peanut butter for breakfast) '(toasted banana bread )))
;//=>(toasted)
(println (intersect '(strawberry yoghurt) '(toasted banana bread )))
;//=>()

The opposite of getting the intersection of two sets is to get the union – we’ll do that now:

(def union
  (fn [set1 set2]
    (cond
      (null? set1) set2
      (member? (first set1) set2) (union (rest set1) set2)
      true (cons (first set1) (union (rest set1) set2)))))

(println (union '(toasted banana bread) '(breakfast toasted banana bread with butter for breakfast)))
;//=>(breakfast toasted banana bread with butter for breakfast)
;// note not a set since not given a set
(println (union '(toasted peanut butter for breakfast) '(toasted banana bread )))
;//=>(peanut butter for breakfast toasted banana bread)
(println (union '(strawberry yoghurt) '(toasted banana bread )))
;//=>(strawberry yoghurt toasted banana bread)

The function next in the line is the complement of two sets:

(def complement_
  (fn [set1 set2]
    (cond
      (null? set1) '()
      (member? (first set1) set2) (complement_ (rest set1) set2)
      true (cons (first set1) (complement_ (rest set1) set2)))))

(println (complement_ '(toasted banana bread) '(breakfast toasted banana bread with butter for breakfast)))
;//=>()
(println (complement_ '(toasted peanut butter for breakfast) '(toasted banana bread )))
;//=>(peanut butter for breakfast)
(println (complement_ '(strawberry yoghurt) '(toasted banana bread )))
;//=>(strawberry yoghurt)

Now we’ll look at the intersection of more than two sets with intersect-all:

(def intersect-all
  (fn [l-set]
    (cond
      (null? (rest l-set)) (first l-set)
      true (intersect (first l-set) (intersect-all (rest l-set))))))

(println "")
(println "intersect-all")
(println (intersect-all
           '(
              (toasted banana bread)
              (breakfast toasted banana bread with butter for breakfast)
              (toasted peanut butter for breakfast)
              (toasted banana bread ))))
;//=>(toasted)

Here the book changes direction – our work on sets has been a building block for looking at functions and relations. Assuming that we can express a function as a set of value pairs – we need to be able to have the building blocks to work with pairs. We’ll start by getting the first and second value out of a pair:

(def first_
  (fn [p]
    (cond
      true (first p))))

(println (first_ '(a b)))
;//=>a

(def second_
  (fn [p]
    (cond
      true (first (rest p)))))

(println (second_ '(a b)))
;//=>b

Next we’ll add the ability to build a pair:

(def build
  (fn [a b]
    (cond
      true (cons a (cons b '())))))

(println (build 'a 'b))
;//=>(a b)

For the sake of keeping our brain going – we’ll get the third item of a pair just to keep you wondering:

(def third_
  (fn [p]
    (cond
      true (first (rest (rest p))))))

(println (third_ '(a b c)))
;//=>c

Now we’ll look closer at functions. You’ll remember that for a set of pairs to be a function, there must be only one domain value – ie the first values from a set of pairs must themselves be a set. We’ll borrow our definition of member* from Chapter 6.

(def firsts
  (fn [l]
    (cond
      (empty? l) '()
      true (cons (first (first l))
        (firsts (rest l))))))

(println "")
(println "firsts")
(println (firsts '((8 3)(4 2)(7 6)(6 2)(3 4))))
;//=>(8 4 7 6 3)

(def fun?
  (fn [rel]
    (set? (firsts rel))))

(println "")
(println "fun? - refactored to use set? and firsts")
(println (fun? '((4 3)(4 2)(7 6)(6 2)(3 4))))
;//=>false
(println (fun? '((8 3)(4 2)(7 6)(6 2)(3 4))))
;//=>true
(println (fun? '((8 3)(4 2)(7 1)(6 0)(9 5))))
;//=>true

Now just in case you ever wanted to reverse the elements in their pairs and order in the list – we bring you revrel. (It is actually a building block for other functions to come).

(def revrel
  (fn [rel]
    (cond
      (null? rel) '()
      true (cons
             (build
               (second_ (first rel))
               (first_ (first rel)))
             (revrel (rest rel))))))

(println (revrel '((4 3)(4 2)(7 6)(6 2)(3 4))))
;//=>((3 4) (2 4) (6 7) (2 6) (4 3))
(println (revrel '((8 3)(4 2)(7 6)(6 2)(3 4))))
;//=>((3 8) (2 4) (6 7) (2 6) (4 3))
(println (revrel '((8 3)(4 2)(7 1)(6 0)(9 5))))
;//=>((3 8) (2 4) (1 7) (0 6) (5 9))

So applying what we’ve just learned – a full function is one in which both the values of the domain are unique, and the values of the range are unique. We can test this with fullfun?:

(def fullfun?
  (fn [fun]
    (set_? (seconds_ fun))))

(println (fullfun? '((4 3)(4 2)(7 6)(6 2)(3 4))))
;//=>false
(println (fullfun? '((8 3)(4 2)(7 6)(6 2)(3 4))))
;//=>false
(println (fullfun? '((8 3)(4 2)(7 1)(6 0)(9 5))))
;//=>true

A simpler way to express this idea is that the domain of the function is unique – even if the range values are swapped with the domain values – we call this one-to-one:

(def one-to-one?
  (fn [fun]
    (fun? (revrel fun))))

(println (one-to-one? '((4 3)(4 2)(7 6)(6 2)(3 4))))
;//=>false
(println (one-to-one? '((8 3)(4 2)(7 6)(6 2)(3 4))))
;//=>false
(println (one-to-one? '((8 3)(4 2)(7 1)(6 0)(9 5))))

You can see this running here.

Conclusion:
This chapter we’ve looked at sets, relations and functions (in the mathematical sense). We haven’t really added any new primitives this chapter (thank goodness!).

In total our primitives so far are: atom?, null?, first, rest, cond, fn, def, empty?,=, cons, add1,, sub1, one? and expt. These are all the functions (and those in the chapters to come) that we’ll need to implement to get our metacircular interpreter working.

This is the seventh 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, and changing our functions to work with nested lists.

In this chapter we’re driving towards our metacircular interpreter by starting to look at evaluating numerical values. So we’ll look at building an expression, breaking it down into operators and operands, and then handling it and returning a result. So let’s get started!

First we’re going to test with a test function to see if the S-expression passed in is a valid numeric expression that we can evaluate. We’re going to call this function numbered. But first we’ll expand Clojure’s definition of number? – so it can return a null for an invalid expression as we expect

;we need to define number_? to handle true/false
(def number_?
  (fn [a]
    (cond
      (null? a) false
      (number? a) true
      true false)))

(println (number_? 3))
;//=> true
(println (number_? 'a))
;//=> false

So now let’s do numbered to test for S-expressions that we can evaluate as a numeric expression.

(def numbered?
  (fn [aexp]
    (cond
      (atom? aexp) (number_? aexp)
      (= (first (rest aexp)) '+)
         (and
           (numbered? (first aexp))
           (numbered? (first (rest (rest aexp)))))
      (= (first (rest aexp)) '*)
         (and
           (numbered? (first aexp))
           (numbered? (first (rest (rest aexp)))))
      (= (first (rest aexp)) 'exp)
         (and
           (numbered? (first aexp))
           (numbered? (first (rest (rest aexp)))))
      true false)))

(println (numbered? '(a b c)))
;//=> false
(println (numbered? '(3 + (4 * 5))))
;//=> true
(println (numbered? '(3 a (4 * 5))))
;//=> false

Ok – so can we simplify numbered? Yes:

(def numbered?
  (fn [aexp]
    (cond
      (atom? aexp) (number_? aexp)
      true (and
             (numbered? (first aexp))
             (numbered? (first (rest (rest aexp))))))))

(println (numbered? '(a b c)))
;//=> false
(println (numbered? '(3 + (4 * 5))))
;//=> true
(println (numbered? '(3 a (4 * 5))))
;//=> true

Hmm – notice that the final expression became true in this version, but was false in the previous? That’s an assumption we’re making with this new version – that we know already this is an arithmetic expression. One might think this defeats the purpose of this function. I digress.

Now we’ll look at the Eight Commandment. This states that you recur on all subparts that are of the same nature including:
– On all sublists of a list
– On all the subexpressions of a representation of an arithmetic expression.
The big idea is that we’re starting to make a distinction between code and data. We’re saying that data functions recur on data, and code functions recur on code.

Now you’ll remember the infamous function eval from many languages – especially LISP. We’ll start writing the first version of eval for our metacircular interpreter starting with a basic version that just looks at arithmetic expressions. We’ll call it value:

(use 'clojure.math.numeric-tower)
; note use of new primitive expt

(def value
  (fn [aexp]
    (cond
      (number_? aexp) aexp
      (= (first (rest aexp)) '+) (+ (value (first aexp)) (value (first (rest (rest aexp)))))
      (= (first (rest aexp)) '*) (* (value (first aexp)) (value (first (rest (rest aexp)))))
      (= (first (rest aexp)) 'exp) (expt (value (first aexp)) (value (first (rest (rest aexp))))))))

(println (value '(1 + 1)))
;//=> 2
(println (value '(2 + 2)))
;//=> 4
(println (value '(3 exp 3)))
;//=> 27
(println (value '(4 b 4)))
;//=> nil

Now we’re going to take the function above and move from prefix to infix – just to illustrate how trivial the distinction is from an implementation point of view

(def value
  (fn [aexp]
    (cond
      (number_? aexp) aexp
      (= (first  aexp) '+) (+ (value (rest aexp)) (value  (rest (rest aexp))))
      (= (first (rest aexp)) '*) (* (value (first aexp)) (value (first (rest (rest aexp)))))
      (= (first (rest aexp)) 'exp) (expt (value (first aexp)) (value (first (rest (rest aexp))))))))

Now in my view that was a little silly. The book included a non-working version of value just to illustrate a violation of the Eighth Commandment. Let’s get on with it.

Now we’ll extract out helper functions to get the subexpressions and the operator

(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)))

(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
(println (value '(* 2 2)))
;//=> 4
(println (value '(exp 3 3)))
;//=> 27
(println (value '(b 4 4)))
;//=> nil

Cool – now – just to illustrate the power of abstraction by functions – we’ll switch back from prefix to infix functions.

(def first-sub-exp
  (fn [aexp]
    (first  aexp)))

(def operator
  (fn [aexp]
    (first (rest aexp))))

(println (value '(1 + 1)))
;//=> 2
(println (value '(2 * 2)))
;//=> 4
(println (value '(3 exp 3)))
;//=> 27
(println (value '(4 b 4)))

Time for another Commandment – The Ninth Commandment States Use helper functions to abstract from representations. Part of this is the java concept of eclipse’s extract method. Part of it is the power this gives you to change the function across the whole application and have it impact many parts of the system – ie a wide-ranging refactor.

Now we’re testing for null?. Although we had to write our own helper method for this in Chapter 1 – now as part of implementing the metacircular interpreter – we’re re-implementing it in terms of other functions so keep our api minimal.

;This is what we had
(def null?
  (fn [a]
    (or
      (nil? a)
      (= () a))))

;This is what they're proposing
(def null?
  (fn [s]
    (and
      (atom? s)
      (= s '()))))

Now it turns out this fails the conversion from Scheme to Clojure. We get the big idea. We’ll just move on.

Now we’re going to build our own numeric system out of parenthesis – again, just to make the implementation of our metacircular interpreter more pure and easier to implement. This is significant because we’re going to build up our own number representation out of parentheses – admittedly a strange exercise – but going to prove that we can do maths in a lisp implemented in itself.

We’ll start with zero?:

(def zero_?
  (fn [n]
    (null? n)))

(println (zero_? '()))
;//=>true
(println (zero_? 0))
;=>false

Ok – maybe that didn’t make sense – let’s give a few examples. So now zero is (), one is (()), and two is (()()).
Let’s do some operations on our new numeric representation – we’ll start with a new definition of add1.

(def add1
  (fn [n]
    (cons '() n)))

(println (add1 '()))
;//=>(()) ie 1
(println (add1 '(())))
;//=> (() ()) ie 2

Now let’s do sub1:

(def sub1
  (fn [n]
    (rest n)))

(println (sub1 '(()())))
;//=>(()) ie 1
(println (sub1 '(())))
;//=>() ie 0
(println (sub1 '()))
;//=> () unfortunately with our implementation sub1 of zero returns zero

Now we’ll reimplement our plus function:

(def +_
  (fn [n m]
    (cond
      (zero_? m) n
      true (add1 (+_ n (sub1 m))))))

(println (+_ '() '()))
;//=> ()
;//  zero plus zero is zero
(println (+_ '(()) '(())))
;//=> (()()) ie 1 plus 1 is 2

Now we’ll test for valid numbers in our new scheme by rewriting our function number?:

(def number_?
  (fn [n]
    (cond
      (null? n) true
      true (and
             (null? (first n))
             (number_? (rest n))))))

(println (number_? '() ))
;//=>true
(println (number_? '(()) ))
;//=>true
(println (number_? '((())) ))
;//=>false
(println (number_? '(()()) ))
;//=>true

You can see it running here.

Conclusion:
Why is this chapter called shadows? I haven’t figured that out. Perhaps it is a shadow of things to come.

Here we’ve started on the journey of the metacircular interpreter by writing an evaluator for arithmetic expressions. The only primitive we added was expt.

In total our primitives so far are: atom?, null?, first, rest, cond, fn, def, empty?,=, cons, add1,, sub1, one? and expt. These are all the functions (and those in the chapters to come) that we’ll need to implement to get our metacircular interpreter working.

This is the sixth 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, and working with multiple occurrences of a match in the list.

What about nested lists? Would our functions work for those? Not yet. This chapter we’ll fix that.

First we’ll look at leftmost (which also involves defining non-atom? and not). The point of this function is to find the leftmost S-expression, even if it is an empty list ().

(def not_
  (fn [b]
    (cond
      b false
      true true)))

(println (not_ (= 'a 'b)))

(def non-atom?
  (fn [s]
    (not_ (atom? s))))

(println (non-atom? (quote thai)))

(def leftmost
  (fn [l]
    (println "(leftmost " l)
    (println (non-atom? l))
    (cond
      (null? l) '()
      (non-atom? (first l)) (leftmost (first l))
      true (first l))))

(println (leftmost (quote ((((pad))thai))chicken())))

Now we’ll write rember*. What we’re doing here is to remove all matching list members from within the nested list.

(def rember*
  (fn [a l]
    (cond
      (null? l) '()
      (non-atom? (first l)) (cons (rember* a (first l)) (rember* a (rest l)))
      true (cond
             (= (first l) a) (rember* a (rest l))
             true (cons (first l) (rember* a (rest l)))))))

(println (rember* 'bacon '(((bbq sauce)) (with (egg and (bacon))))))

Now we’ll do insertR*. The point of this one is to insert a new element to the right of the matching element, no matter where is occurs in the nested list.

(def insertR*
  (fn [new old l]
    (cond
      (null? l) '()
      (non-atom? (first l)) (cons (insertR* new old (first l)) (insertR* new old (rest l)))
      true (cond
             (= (first l) old) (cons old (cons new (insertR* new old (rest l))))
             true (cons (first l) (insertR* new old (rest l)))))))

(println (insertR* 'chicken 'baked '(((baked)) (with roast) vegetables)))

Well it is time for another Commandment. Well it would be, but instead we’re going to revise an existing one. Here goes:

When recurring on a list of atoms, lat, or a vec, vec, ask two questions about them, and use (rest lat) or (rest vec) for the natural recursion.

When recurring on a list of S-expressions, l, ask three questions: (null? l), (atom? (first l)), and (non-atom? (first l)); and use (first l) and (rest l) for the natural recursion.

When recurring on a number, n, ask two questions, and use (sub1 n) for the natural recursion.

So what happened there? We extended our recursion checks to be able to handle nested lists.

Now let’s do occur*. The point of this one is to count the occurrences of a matching list member inside a nested list.

(def occur*
  (fn [a l]
    (cond
      (null? l) 0
      (non-atom? (first l)) (+_ (occur* a (first l)) (occur* a (rest l)))
      true (cond
             (= (first l) a) (add1 (occur* a (rest l)))
             true (occur* a (rest l))))))

(println (occur* 'creamy '(((creamy)) new (york (cheesecake)) with a ((creamy) latte))))

Now we’ll do subst*. What we want to achieve is a find and replace inside a nested list.

(def subst*
  (fn [new old l]
    (cond
      (null? l) '()
      (non-atom? (first l)) (cons (subst* new old (first l)) (subst* new old (rest l)))
      true (cond
             (= (first l) old) (cons new (subst* new old (rest l)))
             true (cons (first l) (subst* new old (rest l)))))))

(println (subst* 'baked 'creamy '(((creamy) cheesecake) (with (hot (espresso))))))

Now let’s look at insertL. This is quite similar to insertR above – but now we insert the new value to the left of the matching value.

(def insertL*
  (fn [new old l]
    (cond
      (null? l) '()
      (non-atom? (first l))
        (cons
          (insertL* new old (first l))
          (insertL* new old (rest l)))
      true (cond
        (= (first l) old)
          (cons new
            (cons old
              (insertL*
                new old (rest l))))
        true (cons (first l)
          (insertL*
            new old (rest l)))))))

(println (insertL* 'fresh 'creamy '(((creamy) cheesecake) (with (hot (espresso))))))

Now we’ll rewrite member* without using the non-atom? function:

(def member*
  (fn [a l]
    (cond
      (null? l) '()
      (atom? (first l))
        (or
          (= (first l) a)
          (member* a (rest l)))
      true (or
        (member* a (first l))
        (member* a (rest l))))))

(println (member* 'creamy '(((creamy) cheesecake) (with (hot (espresso))))))

Now we’ll look at testing list equality using eqlist?

(def eqlist?
  (fn [l1 l2]
    (cond
      (and (null? l1) (null? l2)) true
      (or (null? l1) (null? l2)) false
      (and (non-atom? (first l1)) (non-atom? (first l2)))
        (and (eqlist? (first l1) (first l2))
             (eqlist? (rest l1) (rest l2)))
      (or (non-atom? (first l1)) (non-atom? (first l2))) false
      true (and
        (eqan? (first l1) (first l2))
        (eqlist? (rest l1) (rest l2))))))

(println (eqlist? '(with (hot (espresso))) '(with (hot (espresso)))));//=>true
(println (eqlist? '(with (hot (espresso))) '((creamy) cheesecake)));//=>false

Now we’ll take a look at rember. At this point the Chapter takes a brief digression from modifying algorithms handle nested lists to focus on the art of refactoring itself. This version of rember differs from the one before by removing a matching S-expression rather than the first matching atom.

(def rember
  (fn [s l]
    (cond
      (null? l) '()
      (non-atom? (first l))
        (cond
          (equal? (first l) s) (rest l)
          true (cons (first l) (rember s (rest l))))
      true (cond
        (equal? (first l) s) (rest l)
        true (cons (first l) (rember s (rest l)))))))

(println (rember 'fresh '(((fresh creamy) cheesecake) (with (hot (espresso))))))
;//=> (((fresh creamy) cheesecake) (with (hot (espresso))))

(println (rember 'fresh '(fresh creamy cheesecake with hot espresso)))
;//=> (creamy cheesecake with hot espresso)

Now we’ll do a refactor of rember. The point here is just to illustrate simplification by removing redundant code.

(def rember
  (fn [s l]
    (cond
      (null? l) '()
      true (cond
        (equal? (first l) s) (rest l)
        true (cons (first l) (rember s (rest l)))))))

(println (rember 'fresh '(((fresh creamy) cheesecake) (with (hot (espresso))))))
;//=> (((fresh creamy) cheesecake) (with (hot (espresso))))

(println (rember 'fresh '(fresh creamy cheesecake with hot espresso)))
;//=> (creamy cheesecake with hot espresso)

Now we’ll do a another refactor of rember. Now we’re making it similar by pushing out the tests from the outer cond to the inner.

(def rember
  (fn [s l]
    (cond
      (null? l) '()
      (= (first l) s) (rest l)
      true (cons (first l) (rember s (rest l)))))))

(println (rember 'fresh '(((fresh creamy) cheesecake) (with (hot (espresso))))))
;//=> (((fresh creamy) cheesecake) (with (hot (espresso))))

(println (rember 'fresh '(fresh creamy cheesecake with hot espresso)))
;//=> (creamy cheesecake with hot espresso)

Now we’ll take one more crack at refactoring insertL*. This time by removing redundant code.

(def insertL*
  (fn [new old l]
    (cond
      (null? l) '()
      (non-atom? (first l))
        (cons
          (insertL* new old (first l))
          (insertL* new old (rest l)))
      (= (first l) old)
        (cons new
          (cons old
            (insertL*
              new old (rest l))))
      true (cons (first l)
        (insertL*
          new old (rest l))))))

(println (insertL* 'fresh 'creamy '(((creamy) cheesecake) (with (hot (espresso))))))

Now we’ll look at another commandment:

Simplify only after the function is correct

In some ways obvious – in other ways so profound that Martin Fowler wrote a whole book about it. The point is that optimisations of your code size are great – but get it working first.

You can see it running here.

Conclusion:
Here we’ve adapted our existing functions to be able to work for multiple occurrences of the search result. This chapter we didn’t add any true primitives, not_ and non-atom are entirely composed of existing primtives.

In total our primitives so far are: atom?, null?, first, rest, cond, fn, def, empty?,=, cons, add1, sub1 and one?. These are all the functions (and those in the chapters to come) that we’ll need to implement to get our metacircular interpreter working.

This is the fifth Chapter of a series of posts about porting The Little Schemer to Clojure. You may wish to read the intro.

Ok – so far we’ve introduced lists [Ch1], we’ve pulled things out of lists [Ch2], we’ve built lists [Ch3] and we’ve assembled a minimal numeric tower[Ch4]. The assumption behind all of these was that we were only reading or making one change at a time. This time we’ll extend our capabilities to handle multiple items. To put it another way – this chapter is all about the ‘find all’ and the ‘replace all’.

We’ll start with some revision – we’ll go back to our old friend member.

(def member?
  (fn [a lat]
    (cond
      (null? lat) false
      true (or
        (= (first lat) a)
        (member? a (rest lat)))) ))

(println (member? 'sweet '(potato wedges with sweet chilli sauce))) ; //=> true
(println (member? 'sweet '(potato wedges with sweet sweet chilli sauce))) ; //=> true

Now the particular point we’re looking at now is that this function will stop at the first occurrence of a in lat. Now we’ll go back to another old friend rember.

(def rember
  (fn [ a lat]
    (cond
      (null? lat) '()
      true (cond
        (= (first lat) a) (rest lat)
        true (cons (first lat)
          (rember
            a (rest lat)))))))

(println (rember 'banana '(apple banana orange))) ; //=> (apple orange)
(println (rember 'banana '(apple banana banana orange))); //=> (apple banana orange)

Again – the point was that only the first occurrence is dealt with – this chapter is about how we will to address that. So let’s start with multirember:

(def multirember
  (fn [a lat]
    (cond
      (null? lat) '()
      true (cond
             (= (first lat) a) (multirember a (rest lat))
             true (cons (first lat) (multirember a (rest lat)))))))

(println (multirember 'sweet '(potato wedges with sweet sweet chilli sauce))); //=> (potato wedges with chilli sauce)

The main difference is that we keep calling the function until the end of the lat, even if the result is found.

Now let’s do multiinsertR:

(def multiinsertR
  (fn [new old lat]
    (cond
      (null? lat) '()
      true (cond
             (= (first lat) old) (cons (first lat) (cons new (multiinsertR new old (rest lat))))
             true (cons (first lat) (multiinsertR new old (rest lat)))))))

(println (multiinsertR 'hot 'with '(with potato wedges with chilli sauce))); //=> (with hot potato wedges with hot chilli sauce)

Too easy! Now let’s do multiinsertL:

(def multiinsertL
  (fn [new old lat]
    (cond
      (null? lat) '()
      true (cond
             (= (first lat) old) (cons new (cons old (multiinsertL new old (rest lat))))
             true (cons (first lat) (multiinsertL new old (rest lat)))))))

(println (multiinsertL 'with 'hot '(hot potato wedges hot chilli sauce))); //=> (with hot potato wedges with hot chilli sauce)

So a pattern is developing here – which means it’s time for another Commandment. Here Goes. The Sixth commandment states that you Always change at least one argument while recurring. The changing argument(s) should be tested in the termination condition(s) and it should be changed to be closer to termination. For example:
when using rest, test termination with empty?
when using sub1, test termination with zero?

Ok – so apart from knowing the principles to have confidence in writing recursive code in the future – why else is this relevant? It’s important for building more complex data structures. One of Clojure’s key strengths is that it has lazy functional data structures. Clojure’s data structures are built around this idea of hash-trie. It’s the idea that you can modify a tree structure that is still immutable and performant. The point being – you need to start building blocks for how you think about data structures.

Now we’re going to look at multisubst:

(def multisubst
  (fn [new old lat]
    (cond
      (null? lat) '()
      true (cond
             (= (first lat) old) (cons new (multisubst new old (rest lat)))
             true (cons (first lat) (multisubst new old (rest lat)))))))

(println (multisubst 'hot 'sweet '(sweet potato wedges with sweet chilli sauce))); //=> (hot potato wedges with hot chilli sauce)

Now we’re going to do occur which is a bit like the aggregate count function in sql.

(def occur
  (fn [a lat]
    (cond
      (null? lat) 0
      true (cond
             (= (first lat) a) (add1 (occur a (rest lat)))
             true (occur a (rest lat))))))

(println (occur 'hot '(potato wedges with hot hot hot chilli sauce))); //=> 3

This chapter ends strangely – we digress into an optimisation of the rempick function by adding a new primitive one?:

(def one?
  (fn [n]
    (= n 1)))

(def rempick
  (fn [n lat]
    (cond
      (null? lat) '()
      (one? n) (rest lat)
      true (cons (first lat) (rempick (sub1 n) (rest lat))))))

(println (rempick 4 '(potato wedges with hot chilli sauce))); //=> (potato wedges with chilli sauce)

You can see it running here.

Conclusion
Here we’ve adapted our existing functions to be able to work for multiple occurrences of the search result. We’ve added one new primitive function: one? 

In total our primitives so far are: atom?, null?, first, rest, cond, fn, def, empty?,=, cons, add1, sub1 and one?. These are all the functions (and those in the chapters to come) that we’ll need to implement to get our metacircular interpreter working.

Bringing it Back to Clojure

So how do we do a multirember in Clojure normally? Here is an online example:

(remove #{:foo} #{:foo :bar})      ;// => (:bar)
(remove #{:foo} [:foo :bar])       ;// => (:bar)
(remove #{:foo} (list :foo :bar))  ;// => (:bar)

Other functions that apply to other data structures to consider:

(disj #{:foo :bar} :foo)       ;// => #{:bar}
(dissoc {:foo 1 :bar 2} :foo)  ;// => {:bar 2}
(pop [:bar :foo])              ;// => [:bar]
(pop (list :foo :bar))         ;// => (:bar)

So how is remove implemented in Clojure?

(defn remove
  [pred coll]
  (filter (complement pred) coll))

This is more concise – but requires knowledge of the filter and complement functions – which we’ve chosen to exclude to keep a simple set of primitives.

This is the fourth Chapter of a series of posts about porting The Little Schemer to Clojure. You may wish to read the intro.

You’ll notice that in the first three chapters, we introduced lists [Ch1], then we pulled things out of lists [Ch2], and then we built lists [Ch3]. The bigger principle of the book is to be able to operate on data structures with a minimal set of primitives using the power of recursion and lambdas.

Now we’re driving at the meta-circular interpreter with these principles. We also want to be able to do mathematical operations, and yet still keep a minimal number of primitives. Interestingly enough, we’ll just use equals, add1 and sub1 and build up to multiplication, division and exponents. So let’s get started!

Our first function is +_ (plus) – we’re going to define it terms of add1 and sub1. (We’ll rename the functions with an _ suffix so they don’t clash with the existing clojure definitions of + and zero?

(def zero_?
  (fn [n]
    (= 0 n)))

(def add1
  (fn [n]
    (+ 1 n)))

(def sub1
  (fn [n]
    (- n 1)))

(def +_
  (fn [n m]
    (cond
      (zero_? m) n
      true (add1 (+ n (sub1 m))))))

(println (+_ 1 2))

Now this is kind of frustrating. Why bother doing all this recursion for an operation that is already built into the CPU? Especially when you limit yourself to integers anyway?

This is about making you think about numeric implementations. Part of it is that LISPs generally implement their own ‘numeric tower’ – you can see what fresh thinking has done for Clojure’s ability to handle numbers – particularly irrational fractions.

The other reason is the purity of the metacircular interpreter that you’ll build – you’ll literally be able to count the number of primitives required to build it and have no holes. (There is an assumption that recursion is cheap.)

Our next function is – (minus) which is quite similar to the above:

(def -_
  (fn [n m]
    (cond
      (zero_? m) n
      true (sub1 (- n (sub1 m))))))

(println (-_ 2 1))

From here we extend our concept of the lat (a List-ATom) – being a non-nested list of atoms. We extend it to what the book calls a vec, which is a non-nested list of integers.

From here we arrive at [The Fourth Commandment]. This states When recurring on a list of atoms, lat, or a vec, ask two questions about them, and use (cdr lat) or (cdr vec) for the natural recursion.

It then goes on to apply this to lists of numbers as well. It goes on: When recurring on a number, n, ask two questions, and use (sub1 n) for the natural recursion.

Now we get to the addvec function. This is really like a sum function from sql land:

(def addvec
  (fn [vec]
    (cond
      (empty? vec) 0
      true (+_ (first vec) (addvec (rest vec))))))

(println (addvec '(1 2 3)))

Next we look at the multiply function *_.

(def *_
  (fn [n m]
    (cond
      (zero_? m) 0
      true (+_ n (*_ n (sub1 m))))))

(println (*_ 4 5))

Again – we’ve built this in terms of our existing primitives.

Now we get onto The Fifth Commandment. I know these could come across as boring and self-righteous. On the other hand, if you write recursive code from scratch (and don’t rely on a library to do it for you) you want to have absolute confidence that it will run and terminate as you expect. These Commandments give you that confidence.

The Fifth Commandment states: When building a value with +_ (plus), always use 0 for the value of the terminating line, for adding 0 does not change the value of an addition.

It goes on to say: when building a value with *_(multiply), always use 1 for the value of the terminating line, for multiplying by 1 does not change the value of a multiplication.

It then finishes with: when building a value with cons, always consider () for the value of the terminating line.

Now we’ll look at vec+. The big idea is to be able to add two lists of numbers matching each corresponding element in the sum operation. This has uses in matrix operations:

(def vec+
  (fn [vec1 vec2]
    (cond
      (empty? vec1) vec2
      (empty? vec2) vec1
      true (cons (+_ (first vec1) (first vec2))
             (vec+
               (rest vec1) (rest vec2))))))

(println (vec+ '(1 2 3) '(4 5 6)))

Now we’ll look at >_(greater than). We’ll define it in terms of our primitives.

(def >_
  (fn [n m]
    (cond
      (zero_? n) false
      (zero_? m) true
      true (>_ (sub1 n) (sub1 m)))))

(println (>_ 10 1))
(println (>_ 1 10))

We’ll reuse this for less-than. It actually turns out remarkably similar:

(def <_
  (fn [n m]
    (cond
      (zero_? m) false
      (zero_? n) true
      true (<_ (sub1 n) (sub1 m)))))

(println (>_ 10 1))
(println (>_ 1 10))

Next we’ll define equals:

 
(def =_   
  (fn [n m]     
    (cond       
      (>_ n m) false
      (<_ n m) false      
      true true)))

(println "=_")
(println (=_ 1 10))
(println (=_ 10 1))
(println (=_ 10 10))

Next we’ll look at exponents:

(def exp
  (fn [n m]
    (cond
      (zero_? m) 1
      true (*_ n (exp n (sub1 m))))))

(println (exp 2 3))

Now we’ll start using our numbers functions on atoms and lats – this gets used in our metacircular evaluator later. First we’ll start with length:

(def length
  (fn [lat]
    (cond
      (empty? lat) 0
      true (add1 (length (rest lat))))))

(println (length '(pasta with pesto and mushrooms)))

Now we’re going to write a function pick to get an item out of a list using an index.

(def pick
  (fn [n lat]
    (cond
      (empty? lat) '()
      (zero_? (sub1 n)) (first lat)
      true (pick (sub1 n) (rest lat)))))

(println (pick  3 '(pasta with pesto and mushrooms)))

Now we’re going to extend this to remove an indexed item from a list using rempick:

(def rempick
  (fn [n lat]
    (cond
      (empty? lat) '()
      (zero_? (sub1 n)) (rest lat)
      true (cons (first lat)
             (rempick
               (sub1 n) (rest lat))))))

(println (rempick  2 '(pasta with pesto and mushrooms)))

Now we’re going to write a function to strip all the numbers out of a list. We’ll cheat a little bit, as we’ll introduce a new primitive function number?. We’ll call our strip function no-nums.

(def no-nums
  (fn [lat]
    (cond
      (empty? lat) '()
      true (cond
             (number? (first lat)) (no-nums (rest lat))
             true (cons (first lat)
                    (no-nums (rest lat)))))))

(println (no-nums  '(1 potato 2 potato 3 potato 4)))

This time we’ll flip it over – and write a function to strip out all the non-numbers from the list:

(def all-nums
  (fn [lat]
    (cond
      (empty? lat) '()
      true (cond
             (number? (first lat)) (cons (first lat) (all-nums (rest lat)))
             true (all-nums (rest lat))))))

(println (all-nums  '(1 potato 2 potato 3 potato 4)))

Our final function eqan? is our first building block towards rewriting the equals function in terms of our own primitives. This function will get us about half way there:

(def eqan?
  (fn [a1 a2]
    (cond
      (number? a1)
        (cond
          (number? a2) (=_ a1 a2)
          true false)
      (number? a2) false
      true (= a1 a2))))

(println (eqan?  1 10))
(println (eqan?  10 1))
(println (eqan?  10 10))
(println (eqan?  'a 'b))
(println (eqan?  'a 'a))

Conclusion
This chapter we’ve introduced two new primtives add1 and sub1 – and used them along with all our existing primitives to build all the functions above.

In total our primitives so far are: atom?, null?, first, rest, cond, fn, def, empty?, =, cons, add1 and sub1. These are all the functions (and those in the chapters to come) that we’ll need to implement to get our metacircular interpreter working.

This is the third Chapter of a series of posts about porting The Little Schemer to Clojure. You may wish to read the intro.

The first function we look at is rember.

(def rember
  (fn [ a lat]
    (cond
      (null? lat) '()
      true (cond
        (= (first lat) a) (rest lat)
        true (cons (first lat)
          (rember
            a (rest lat)))))))

(println (rember 'banana '(apple banana orange)))

The big idea here is list construction. We’re applying the second commandment of the Little Lisper – use cons to build lists [sequences].

The next function we look at is firsts.

(def firsts
  (fn [l]
    (cond
      (null? l) '()
      true (cons (first (first l))
        (firsts (rest l))))))

(println (firsts '((large burger)(fries coke)(chocolate sundae))))

Here we also meet the Third Commandment of TLS. This states when building a list, describe the typical element, and then cons it onto the natural recursion. This goes back to the discussion on lat? we were having in the previous chapter.  You have to identify the base case, and then build on it.

You can see it working here. 

This is the second Chapter of a series of posts about porting The Little Schemer to Clojure. You may wish to read the intro.

This chapter introduces functions – and the idea of the list of atoms and the member function.

When looking at list atoms, known as a 'lat' we are introduced to writing functions in Scheme. We write the lat? function in Clojure to test for a non-nested list of atoms.

(def lat?
  (fn [l]
    (cond
      (null? l) true
      (and (seq? l)
           (atom? (first l)))
             (lat? (rest l))
      true false)))

There are a couple of things we’ve transposed here. The key one to raise is the usage of def... fn[] rather than defn. This is a convention in the book, and glues in the readers minds that functions are by default anonymous, and we give them labels after the fact. This enables the reader to get into the feel of passing anonymous functions around later.

The other thing that is introduced here is the application of the Ten Commandments (of The Little Schemer). The big ideas of the 10 Commandments is to help you solve problems recursively. The first one states that you should always ask null?  as the first question in expressing any function. In idiomatic Clojure we would use the empty? function for this – but for the sake of being closer to the book, we will not apply it in this function, but use null?.

The question behind this is what is a non-nested list of atoms and why do we care?  One of the big themes in this book is solving problems using recursion rather than iteration. The point is that before you can solve a problem using recursion (where you’ve got a nested list) you need to learn to solve it for the base case where there is no nested list. To validate the base case – we use the lat? function.

The next function we look at is the member? function.

(def member?
  (fn [a lat]
    (cond
      (null? lat) false
      true (or
        (= (first lat) a)
        (member? a (rest lat)))) ))

Why do we have this function? It’s the first useful function in the book. We also keep building our recursion skills, and it is a key building block for later functions.

You can see it working here.