fork(15) download
  1. (ns Chapter9LambdaTheUltimate)
  2.  
  3. (def null?
  4. (fn [a]
  5. (or
  6. (nil? a)
  7. (= () a))))
  8. (println "")
  9. (println "defined null? as a utility function")
  10.  
  11. ;demonstrating passing functions around
  12. (def rember-f
  13. (fn [test? a l]
  14. (cond
  15. (null? l) '()
  16. true (cond
  17. (test? (first l) a) (rest l)
  18. true (cons (first l) (rember-f test? a (rest l)))))))
  19.  
  20. (println "")
  21. (println "rember-f")
  22. (println (rember-f = '(pop corn) '(lemonade (pop corn) and (cake))))
  23. ;//=>(lemonade and (cake))
  24.  
  25.  
  26. (def rember-f
  27. (fn [test? a l]
  28. (cond
  29. (null? l) '()
  30. (test? (first l) a) (rest l)
  31. true (cons (first l) (rember-f test? a (rest l))))))
  32.  
  33. (println "")
  34. (println "rember-f - refactored to remove redundant condition")
  35. (println (rember-f = '(pop corn) '(lemonade (pop corn) and (cake))))
  36. ;//=>(lemonade and (cake))
  37.  
  38.  
  39. ;do a function that returns a function
  40. (def eq?-c
  41. (fn [a]
  42. (fn [x]
  43. (= x a))))
  44.  
  45. (println "")
  46. (println "eq-c?")
  47. (println (eq?-c 'lemonade))
  48. ;//=> #<Chapter9LambdaTheUltimate$eq_QMARK__c$fn__974 Chapter9LambdaTheUltimate$eq_QMARK__c$fn__974@2a2a2ae9>
  49. (println ((eq?-c 'lemonade) 'coke))
  50. ;//=> false
  51. (println ((eq?-c 'lemonade) 'lemonade))
  52. ;//=> true
  53.  
  54.  
  55. (def eq?-salad (eq?-c 'salad))
  56.  
  57. (println "")
  58. (println "eq-salad?")
  59. (println (eq?-salad 'tuna))
  60. ;//=>false
  61. (println (eq?-salad 'salad))
  62. ;//=>true
  63.  
  64. ;now we're making a function-maker for our rember-f function
  65. ;(def rember-eq? (rember-f test?))
  66.  
  67. (def rember-f
  68. (fn [test?]
  69. (fn [a l]
  70. (cond
  71. (null? l) '()
  72. (test? (first l) a) (rest l)
  73. true (cons (first l) ((rember-f test?) a (rest l)))))))
  74.  
  75. (println "")
  76. (println "rember-f with function arg")
  77. (println ((rember-f =) 'tuna '(tuna salad is good)))
  78. ;//=>(salad is good)
  79.  
  80. (def rember-eq? (rember-f =))
  81. (println (rember-eq? 'tuna '(tuna salad is good)))
  82. ;//=>(salad is good)
  83.  
  84. (def insertL-f
  85. (fn [test?]
  86. (fn [new old l]
  87. (cond
  88. (null? l) '()
  89. (test? (first l) old) (cons new (cons old (rest l)))
  90. true (cons (first l) ((insertL-f test?) new old (rest l)))))))
  91.  
  92. (println "")
  93. (println "insertL with function arg")
  94. (println ((insertL-f =) 'creamy 'latte '(a hot cup of latte)))
  95.  
  96. (def insertR-f
  97. (fn [test?]
  98. (fn [new old l]
  99. (cond
  100. (null? l) '()
  101. (test? (first l) old) (cons old (cons new (rest l)))
  102. true (cons (first l) ((insertR-f test?) new old (rest l)))))))
  103.  
  104. (println "")
  105. (println "insertR with function arg")
  106. (println ((insertR-f =) 'cake 'cheese '(new york cheese)))
  107.  
  108.  
  109. (def seqL
  110. (fn [new old l]
  111. (cons new (cons old l))))
  112.  
  113. (def seqR
  114. (fn [new old l]
  115. (cons old (cons new l))))
  116.  
  117. (def insert-g
  118. (fn [seqarg]
  119. (fn [new old l]
  120. (cond
  121. (null? l) '()
  122. (= (first l) old) (seqarg new old (rest l))
  123. true (cons (first l) ((insert-g seqarg) new old (rest l)))))))
  124.  
  125.  
  126. (def insertL (insert-g seqL))
  127. (println "")
  128. (println "insertL with common definition")
  129. (println (insertL 'creamy 'latte '(a hot cup of latte)))
  130. ;//=>(a hot cup of creamy latte)
  131. (def insertR (insert-g seqR))
  132. (println "")
  133. (println "insertR with common definition")
  134. (println (insertR 'cake 'cheese '(new york cheese)))
  135. ;//=>(new york cheese cake)
  136.  
  137. (def insertL
  138. (insert-g
  139. (fn [new old l]
  140. (cons new (cons old l)))))
  141. (println "")
  142. (println "insertL with inline common definition")
  143. (println (insertL 'creamy 'latte '(a hot cup of latte)))
  144. ;//=>(a hot cup of creamy latte)
  145.  
  146. (def subst
  147. (fn [new old l]
  148. (cond
  149. (null? l) '()
  150. (= (first l) old) (cons new (rest l))
  151. true (cons (first l) (subst new old (rest l))))))
  152.  
  153. (println "")
  154. (println "subst with inline common definition")
  155. (println (subst 'espresso 'latte '(a hot cup of latte)))
  156. ;//=>(a hot cup of espresso)
  157.  
  158. (def seqS
  159. (fn [new old l]
  160. (cons new l)))
  161.  
  162. (def subst (insert-g seqS))
  163.  
  164. (println "")
  165. (println "subst with common definition")
  166. (println (subst 'espresso 'latte '(a hot cup of latte)))
  167. ;//>(a hot cup of espresso)
  168.  
  169. (def seqrem
  170. (fn [new old l]
  171. l))
  172.  
  173. (def rember
  174. (fn [a l]
  175. ((insert-g seqrem) nil a l)))
  176.  
  177. (println "")
  178. (println "rember with common definition")
  179. (println (rember 'hot '(a hot cup of espresso)))
  180. ;//=>(a cup of espresso)
  181.  
  182. ; note tenth commandment - abstract functions with common structures into a single function
  183.  
  184. (def number_?
  185. (fn [a]
  186. ; (println "number_? " a)
  187. (cond
  188. (null? a) false
  189. (number? a) true
  190. true false)))
  191.  
  192. (println "")
  193. (println "number_?")
  194.  
  195. (def first-sub-exp
  196. (fn [aexp]
  197. (first (rest aexp))))
  198.  
  199. (println "")
  200. (println "first-sub-exp")
  201.  
  202.  
  203. (def second-sub-exp
  204. (fn [aexp]
  205. ; (println "second-sub-exp " aexp)
  206. (first (rest (rest aexp)))))
  207.  
  208. (println "")
  209. (println "second-sub-exp")
  210.  
  211. (def operator
  212. (fn [aexp]
  213. (first aexp)))
  214.  
  215. (println "")
  216. (println "operator")
  217.  
  218. ;(use 'clojure.math.numeric-tower)
  219.  
  220. (def value
  221. (fn [aexp]
  222. ;(println "value " aexp)
  223. (cond
  224. (number_? aexp) aexp
  225. (= (operator aexp) '+ ) (+ (value (first-sub-exp aexp)) (value (second-sub-exp aexp)))
  226. (= (operator aexp) '* ) (* (value (first-sub-exp aexp)) (value (second-sub-exp aexp)))
  227. ; (= (operator aexp) 'exp ) (expt (value (first-sub-exp aexp)) (value (second-sub-exp aexp)))
  228. )))
  229.  
  230. (println "")
  231. (println "value")
  232. (println (value '(+ 1 1)))
  233. ;//=>2
  234.  
  235. (def atom-to-function
  236. (fn [x]
  237. (cond
  238. (= x '+ ) +
  239. (= x '* ) *
  240. ;(= x 'exp ) expt
  241. )))
  242.  
  243. (println "")
  244. (println "atom-to-function")
  245.  
  246.  
  247. (def value
  248. (fn [aexp]
  249. ; (println "value " aexp)
  250. (cond
  251. (number_? aexp) aexp
  252. true ((atom-to-function (operator aexp))
  253. (value (first-sub-exp aexp))
  254. (value (second-sub-exp aexp))))))
  255.  
  256. (println "")
  257. (println "value simplified")
  258.  
  259. (println (value '(+ 1 1)))
  260. ;//=> 2
  261.  
  262. (def member?
  263. (fn [a lat]
  264. (cond
  265. (null? lat) false
  266. true (or
  267. (= (first lat) a)
  268. (member? a (rest lat)))) ))
  269.  
  270. (println "")
  271. (println "member?")
  272.  
  273.  
  274. (def subset?
  275. (fn [set1 set2]
  276. (cond
  277. (null? set1) true
  278. true (and
  279. (member? (first set1) set2)
  280. (subset? (rest set1) set2)))))
  281.  
  282. (println "")
  283. (println "subset?")
  284.  
  285. (println (subset? '(a b c) '(b c d)))
  286. ;//=>false
  287. (println (subset? '(b c) '(b c d)))
  288. ;//=>true
  289.  
  290.  
  291. (def intersect?
  292. (fn [set1 set2]
  293. (cond
  294. (null? set1) false
  295. true (or
  296. (member? (first set1) set2)
  297. (intersect? (rest set1) set2)))))
  298.  
  299. (println "")
  300. (println "intersect?")
  301.  
  302. (println (intersect? '(a b c) '(b c d)))
  303. ;//=>true
  304.  
  305. (def set-f?
  306. (fn [logical? const]
  307. (fn [set1 set2]
  308. (cond
  309. (null? set1) const
  310. true (logical?
  311. (member? (first set1) set2)
  312. ((set-f? logical? const) (rest set1) set2))))))
  313.  
  314. ;(def subset? (set-f? and true))
  315. ;(def intersect? (set-f? or nil))
  316. ; note - doesn't work yet
  317.  
  318. (def and-prime
  319. (fn [x y]
  320. (and x y)))
  321.  
  322. (def or-prime
  323. (fn [x y]
  324. (or x y)))
  325. ; still doesn't work
  326.  
  327. (def or-prime
  328. (fn [x set1 set2]
  329. (or x (intersect? (rest set1) set2))))
  330.  
  331. (def and-prime
  332. (fn [x set1 set2]
  333. (and x (subset? (rest set1) set2))))
  334.  
  335. (def member?
  336. (fn [a lat]
  337. (cond
  338. (null? lat) false
  339. true (or
  340. (= (first lat) a)
  341. (member? a (rest lat)))) ))
  342.  
  343. (def set-f?
  344. (fn [logical? const]
  345. (fn [set1 set2]
  346. (cond
  347. (null? set1) const
  348. true (logical?
  349. (member? (first set1) set2)
  350. set1 set2)))))
  351. ;rewritten
  352.  
  353. (def intersect? (set-f? or-prime false))
  354. (def subset? (set-f? and-prime true))
  355.  
  356. (println (intersect? '(toasted banana bread) '(breakfast toasted banana bread with butter for breakfast)))
  357. ;//=>true
  358. (println (subset? '(banana butter) '(breakfast toasted banana bread with butter for breakfast)))
  359. ;//=>true
  360.  
  361. ;refactored to remove inner cond
  362. (def multirember
  363. (fn [a lat]
  364. (cond
  365. (null? lat) '()
  366. (= (first lat) a) (multirember a (rest lat))
  367. true (cons (first lat) (multirember a (rest lat))))))
  368.  
  369. (println (multirember 'breakfast '(breakfast toasted banana bread with butter for breakfast)))
  370. ;//=>(toasted banana bread with butter for)
  371.  
  372. (def mrember-curry
  373. (fn [l]
  374. (multirember 'curry l)))
  375.  
  376. (println (mrember-curry '(curry chicken with curry rice)))
  377. ;//=>(chicken with rice)
  378.  
  379.  
  380. ; now we've rewritten it to ask three questions
  381. (def mrember-curry
  382. (fn [l]
  383. (cond
  384. (null? l) '()
  385. (= (first l) 'curry) (mrember-curry (rest l))
  386. true (cons (first l) (mrember-curry (rest l))))))
  387.  
  388. (println (mrember-curry '(curry chicken with curry rice)))
  389. ;//=>(chicken with rice)
  390.  
  391. ; now we're rewriting it to return a curried function
  392. (def curry-maker
  393. (fn [future]
  394. (fn [l]
  395. (cond
  396. (null? l) '()
  397. (= (first l) 'curry) ((curry-maker future) (rest l))
  398. true (cons (first l) ((curry-maker future) (rest l)))))))
  399.  
  400. (def mrember-curry (curry-maker 0))
  401.  
  402. ;//=>(chicken with rice)
  403.  
  404. ; this could be a spin-out
  405. (def mrember-curry
  406. (curry-maker curry-maker))
  407. (println (mrember-curry '(curry chicken with curry rice)))
  408. ;//=>(chicken with rice)
  409.  
  410. ; ie curry-maker is not specific to this function
  411.  
  412. (def function-maker
  413. (fn [future]
  414. (fn [l]
  415. (cond
  416. (null? l) '()
  417. (= (first l) 'curry) ((future future) (rest l))
  418. true (cons (first l) ((future future) (rest l)))))))
  419.  
  420. ;for yielding mrember-curry when applied to a fcuntion
  421.  
  422. ;
  423. (def mrember-curry
  424. (function-maker function-maker))
  425. (println (mrember-curry '(curry chicken with curry rice)))
  426. ;//=>(chicken with rice)
  427.  
  428.  
  429. ;so (future future) is the same as (function-maker function-maker)
  430. ;and mrember-curry doesn't actually need a name - it can be anonymous
  431. ;no recursive function needs to be given a name with def
  432. ;so for add1 - we don't need the (def, we could just start with the (fn
  433. ; this implies that (fn [x] (add1 x)) can be replaced by (fn [x] ((fn [x] (add1 x)) x))
  434.  
  435. (def function-maker
  436. (fn [future]
  437. (fn [l]
  438. (cond
  439. (null? l) '()
  440. (= (first l) 'curry) ((fn [arg] ((future future) arg)) (rest l))
  441. true (cons (first l) ((fn [arg] ((future future) arg)) (rest l)))))))
  442.  
  443. (def mrember-curry
  444. (function-maker function-maker))
  445. (println (mrember-curry '(curry chicken with curry rice)))
  446. ;//=>(chicken with rice)
  447.  
  448.  
  449. ;now we'll add an extra function
  450. (def function-maker
  451. (fn [future]
  452. ((fn [recfun]
  453. (fn [l]
  454. (cond
  455. (null? l) '()
  456. (= (first l) 'curry) (recfun (rest l))
  457. true (cons (first l) ((future future))))))
  458. (fn [arg] ((future future) arg)))))
  459. ;abstraction above to remove l
  460. ; just take my word on this for now
  461.  
  462.  
  463.  
  464. ; now we'll split it up into two functions
  465. (def M
  466. (fn [recfun]
  467. (fn [l]
  468. (cond
  469. (null? l) '()
  470. (= (first l) 'curry) (recfun (rest l))
  471. true (cons (first l) (recfun (rest l)))))))
  472.  
  473. (def function-maker
  474. (fn [future]
  475. (M (fn [arg]
  476. ((future future) arg)))))
  477.  
  478.  
  479. ;Now we'll change this
  480. (def mrember-curry
  481. (function-maker function-maker))
  482. ;to this
  483. (def mrember-curry
  484. ((fn [future]
  485. (M (fn [arg]
  486. ((future future) arg))))
  487. (fn [future]
  488. (M (fn [arg]
  489. ((future future) arg))))))
  490.  
  491. ; now we'll pass in M as a function
  492. (def Y
  493. (fn [M]
  494. ((fn [future]
  495. (M (fn [arg]
  496. ((future future) arg))))
  497. (fn [future]
  498. (M (fn [arg]
  499. ((future future) arg)))))))
  500.  
  501. (def mrember-curry (Y M))
  502.  
  503. (println (mrember-curry '(curry chicken with curry rice)))
  504. ;//=>(chicken with rice)
  505.  
  506. ;using add1 from chapter 7 not chapter 4
  507. (def add1
  508. (fn [n]
  509. (cons '() n)))
  510.  
  511. ; now we'll look at using the y-combinator to look at the length of a list
  512. (def L
  513. (fn [recfun]
  514. (fn [l]
  515. (cond
  516. (null? l) '()
  517. true (add1 (recfun (rest l)))))))
  518.  
  519. (def length (Y L))
  520.  
  521. (println (length '(curry chicken with curry rice)))
  522. ;//=>(() () () () ()) ie 5
  523.  
  524. ;strangely enough we switch our definition of add1 to the definition from chapter 4
  525. (def add1
  526. (fn [n]
  527. (+ 1 n)))
  528.  
  529. ;just for the sake of it - we'll rewrite length without the L function
  530. (def length
  531. (Y
  532. (fn [recfun]
  533. (fn [l]
  534. (cond
  535. (null? l) 0
  536. true (add1 (recfun (rest l))))))))
  537.  
  538. (println (length '(curry chicken with curry rice)))
  539. ;//=>5
  540.  
  541. ;now we'll define length without Y or L
  542. (def length
  543. ((fn [M]
  544. ((fn [future]
  545. (M (fn [arg]
  546. ((future future) arg))))
  547. (fn [future]
  548. (M (fn [arg]
  549. ((future future) arg))))))
  550. (fn [recfun]
  551. (fn [l]
  552. (cond
  553. (null? l) 0
  554. true (add1 (recfun (rest l))))))))
  555.  
  556. (println (length '(curry chicken with curry rice)))
  557. ;//=>5
  558. ;----
  559. ;exercise 9.8 and 9.10
  560. ;-----
  561.  
  562. ;building a pair with an S-expression and a thunk leads to a stream
  563. (def first$ first)
  564.  
  565. (def second$
  566. (fn [str]
  567. ((second str))))
  568.  
  569. ; careful re use of first and second here - as yet undefined!
  570.  
  571. (def build
  572. (fn [a b]
  573. (cond
  574. true (cons a (cons b '())))))
  575.  
  576. (def str-maker
  577. (fn [next n]
  578. (build n (fn [] (str-maker next (next n))))))
  579.  
  580. (def int_ (str-maker add1 0))
  581.  
  582. (def even (str-maker (fn [n] (+ 2 n)) 0))
  583.  
  584. ;sub1 from chapter 4
  585. (def sub1
  586. (fn [n]
  587. (- n 1)))
  588.  
  589. (def frontier
  590. (fn [str n]
  591. (cond
  592. (zero? n) '()
  593. true (cons (first$ str) (frontier (second$ str) (sub1 n))))))
  594.  
  595. (frontier int_ 10)
  596. ;//=>(0 1 2 3 4 5 6 7 8 9)
  597. ; 9.10
  598.  
  599.  
  600. (def Q
  601. (fn [str n]
  602. (cond
  603. (zero? (rem (first$ str) n)) (Q (second$ str) n)
  604. true (build (first$ str) (fn [] (Q (second$ str) n))))))
  605. ; note new function call rem - re new primitve
  606.  
  607. (def P
  608. (fn [str]
  609. (build (first$ str) (fn [] (P (Q str (first$ str)))))))
  610.  
  611. (frontier (P (second$ (second$ int_))) 10)
  612. ;//=>(2 3 5 7 11 13 17 19 23 29)
  613.  
Success #stdin #stdout 1.65s 220224KB
stdin
Standard input is empty
stdout
defined null? as a utility function

rember-f
(lemonade and (cake))

rember-f - refactored to remove redundant condition
(lemonade and (cake))

eq-c?
#<Chapter9LambdaTheUltimate$eq_QMARK__c$fn__27 Chapter9LambdaTheUltimate$eq_QMARK__c$fn__27@13785d3>
false
true

eq-salad?
false
true

rember-f with function arg
(salad is good)
(salad is good)

insertL with function arg
(a hot cup of creamy latte)

insertR with function arg
(new york cheese cake)

insertL with common definition
(a hot cup of creamy latte)

insertR with common definition
(new york cheese cake)

insertL with inline common definition
(a hot cup of creamy latte)

subst with inline common definition
(a hot cup of espresso)

subst with common definition
(a hot cup of espresso)

rember with common definition
(a cup of espresso)

number_?

first-sub-exp

second-sub-exp

operator

value
2

atom-to-function

value simplified
2

member?

subset?
false
true

intersect?
true
true
true
(toasted banana bread with butter for)
(chicken with rice)
(chicken with rice)
(chicken with rice)
(chicken with rice)
(chicken with rice)
(chicken with rice)
(() () () () ())
5
5