(ns Chapter9LambdaTheUltimate)
(def null?
(fn [a]
(or
(nil? a)
(= () a))))
(println "")
(println "defined null? as a utility function")
;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 "")
(println "rember-f")
(println (rember-f = '(pop corn) '(lemonade (pop corn) and (cake))))
;//=>(lemonade and (cake))
(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 "")
(println "rember-f - refactored to remove redundant condition")
(println (rember-f = '(pop corn) '(lemonade (pop corn) and (cake))))
;//=>(lemonade and (cake))
;do a function that returns a function
(def eq?-c
(fn [a]
(fn [x]
(= x a))))
(println "")
(println "eq-c?")
(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 "")
(println "eq-salad?")
(println (eq?-salad 'tuna))
;//=>false
(println (eq?-salad 'salad))
;//=>true
;now we're making a function-maker for our rember-f function
;(def rember-eq? (rember-f test?))
(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 "")
(println "rember-f with function arg")
(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)
(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 "")
(println "insertL with function arg")
(println ((insertL-f =) 'creamy 'latte '(a hot cup of latte)))
(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 "")
(println "insertR with function arg")
(println ((insertR-f =) 'cake 'cheese '(new york cheese)))
(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 "")
(println "insertL with common definition")
(println (insertL 'creamy 'latte '(a hot cup of latte)))
;//=>(a hot cup of creamy latte)
(def insertR (insert-g seqR))
(println "")
(println "insertR with common definition")
(println (insertR 'cake 'cheese '(new york cheese)))
;//=>(new york cheese cake)
(def insertL
(insert-g
(fn [new old l]
(cons new (cons old l)))))
(println "")
(println "insertL with inline common definition")
(println (insertL 'creamy 'latte '(a hot cup of latte)))
;//=>(a hot cup of creamy latte)
(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 "")
(println "subst with inline common definition")
(println (subst 'espresso 'latte '(a hot cup of latte)))
;//=>(a hot cup of espresso)
(def seqS
(fn [new old l]
(cons new l)))
(def subst (insert-g seqS))
(println "")
(println "subst with common definition")
(println (subst 'espresso 'latte '(a hot cup of latte)))
;//>(a hot cup of espresso)
(def seqrem
(fn [new old l]
l))
(def rember
(fn [a l]
((insert-g seqrem) nil a l)))
(println "")
(println "rember with common definition")
(println (rember 'hot '(a hot cup of espresso)))
;//=>(a cup of espresso)
; note tenth commandment - abstract functions with common structures into a single function
(def number_?
(fn [a]
; (println "number_? " a)
(cond
(null? a) false
(number? a) true
true false)))
(println "")
(println "number_?")
(def first-sub-exp
(fn [aexp]
(first (rest aexp))))
(println "")
(println "first-sub-exp")
(def second-sub-exp
(fn [aexp]
; (println "second-sub-exp " aexp)
(first (rest (rest aexp)))))
(println "")
(println "second-sub-exp")
(def operator
(fn [aexp]
(first aexp)))
(println "")
(println "operator")
;(use 'clojure.math.numeric-tower)
(def value
(fn [aexp]
;(println "value " 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 "")
(println "value")
(println (value '(+ 1 1)))
;//=>2
(def atom-to-function
(fn [x]
(cond
(= x '+ ) +
(= x '* ) *
;(= x 'exp ) expt
)))
(println "")
(println "atom-to-function")
(def value
(fn [aexp]
; (println "value " aexp)
(cond
(number_? aexp) aexp
true ((atom-to-function (operator aexp))
(value (first-sub-exp aexp))
(value (second-sub-exp aexp))))))
(println "")
(println "value simplified")
(println (value '(+ 1 1)))
;//=> 2
(def member?
(fn [a lat]
(cond
(null? lat) false
true (or
(= (first lat) a)
(member? a (rest lat)))) ))
(println "")
(println "member?")
(def subset?
(fn [set1 set2]
(cond
(null? set1) true
true (and
(member? (first set1) set2)
(subset? (rest set1) set2)))))
(println "")
(println "subset?")
(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 "")
(println "intersect?")
(println (intersect? '(a b c) '(b c d)))
;//=>true
(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
(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 member?
(fn [a lat]
(cond
(null? lat) false
true (or
(= (first lat) a)
(member? a (rest lat)))) ))
(def set-f?
(fn [logical? const]
(fn [set1 set2]
(cond
(null? set1) const
true (logical?
(member? (first set1) set2)
set1 set2)))))
;rewritten
(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
;refactored to
remove inner 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)
(def mrember-curry
(fn [l]
(multirember 'curry l)))
(println (mrember-curry '(curry chicken with curry rice)))
;//=>(chicken with rice)
; now we've rewritten it to ask three questions
(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 we're rewriting it to return a curried function
(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)
; this could be a spin-out
(def mrember-curry
(curry-maker curry-maker))
(println (mrember-curry '(curry chicken with curry rice)))
;//=>(chicken with rice)
; ie curry-maker is not specific to this function
(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)
;so (future future) is the same as (function-maker function-maker)
;and mrember-curry doesn't actually need a name - it can be anonymous
;no recursive function needs to be given a name with def
;so for add1 - we don't need the (def, we could just start with the (fn
; this implies that (fn [x] (add1 x)) can be replaced by (fn [x] ((fn [x] (add1 x)) x))
(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)
;now we'll add an extra function
(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 it up 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 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))))))
; now we'll 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)
;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
;strangely enough we switch our definition of add1 to the definition from chapter 4
(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 define 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
;----
;exercise 9.8 and 9.10
;-----
;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)
; 9.10
(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)