fork(1) download
  1. ; The Little Schemer in Clojure – Chapter 8 – Friends and Relations
  2. ; This is the code behind the page here:
  3. ; http://j...content-available-to-author-only...e.com/blog/2012/09/07/the-little-schemer-in-clojure-chapter-8-friends-and-relations/
  4.  
  5. (ns Chapter8FriendsAndRelations)
  6.  
  7. ; Big idea is set operations
  8.  
  9. (def atom?
  10. (fn [a]
  11. (not (seq? a))))
  12.  
  13. (def null?
  14. (fn [a]
  15. (or
  16. (nil? a)
  17. (= () a))))
  18.  
  19. ; from Chapter 5
  20. (def member?
  21. (fn [a lat]
  22. (cond
  23. (null? lat) false
  24. true (or
  25. (= (first lat) a)
  26. (member? a (rest lat)))) ))
  27.  
  28. ; assumes implementation of member
  29. (def set_?
  30. (fn [lat]
  31. (cond
  32. (null? lat) true
  33. true (cond
  34. (member? (first lat) (rest lat)) false
  35. true (set_? (rest lat))))))
  36.  
  37. (println "")
  38. (println "set_?")
  39. (println (set_? '(toasted banana bread with butter for breakfast)))
  40. ;//=>true
  41. (println (set_? '(breakfast toasted banana bread with butter for breakfast)))
  42. ;//=>false
  43.  
  44. ;simplified set
  45. (def member
  46. (fn [lat]
  47. (cond
  48. (null? lat) true
  49. (member? (first lat) (rest lat)) false
  50. true (set? (rest lat)))))
  51.  
  52. (println "")
  53. (println "set_? refactored")
  54. (println (set_? '(toasted banana bread with butter for breakfast)))
  55. ;//=>true
  56. (println (set_? '(breakfast toasted banana bread with butter for breakfast)))
  57. ;//=>false
  58.  
  59.  
  60. (def makeset
  61. (fn [lat]
  62. (cond
  63. (null? lat) '()
  64. (member? (first lat) (rest lat)) (makeset (rest lat))
  65. true (cons (first lat) (makeset (rest lat))))))
  66.  
  67. (println "")
  68. (println "makeset")
  69. (println (makeset '(breakfast toasted banana bread with butter for breakfast)))
  70. ;//=> (toasted banana bread with butter for breakfast)
  71. (println (set_? (makeset '(breakfast toasted banana bread with butter for breakfast))))
  72. ;//=>true
  73.  
  74. ; now we'll refactor makeset using multirember from Chapter 5
  75. (def multirember
  76. (fn [a lat]
  77. (cond
  78. (null? lat) '()
  79. true (cond
  80. (= (first lat) a) (multirember a (rest lat))
  81. true (cons (first lat) (multirember a (rest lat)))))))
  82.  
  83. (def makeset
  84. (fn [lat]
  85. (cond
  86. (null? lat) '()
  87. true (cons (first lat) (makeset (multirember (first lat) (rest lat)))))))
  88.  
  89. (println "")
  90. (println "makeset - refactored with multirember")
  91. (println (makeset '(breakfast toasted banana bread with butter for breakfast)))
  92. ;//=> (breakfast toasted banana bread with butter for)
  93. ; note other way around
  94. (println (set_? (makeset '(breakfast toasted banana bread with butter for breakfast))))
  95. ;//=>true
  96.  
  97. (def subset?
  98. (fn [set1 set2]
  99. (cond
  100. (null? set1) true
  101. true (cond
  102. (member? (first set1) set2) (subset? (rest set1) set2)
  103. true false))))
  104.  
  105. (println "")
  106. (println "subset ")
  107. (println (subset? '(banana butter) '(breakfast toasted banana bread with butter for breakfast)))
  108. ;//=>true
  109. (println (subset? '(banana butter) '(toasted banana bread with butter for breakfast)))
  110. ;//=>true
  111. (println (subset? '(peanut butter) '(toasted banana bread with butter for breakfast)))
  112. ;//=>false
  113.  
  114.  
  115. ;refactor subset? to remove redundant second conditional
  116. (def subset?
  117. (fn [set1 set2]
  118. (cond
  119. (null? set1) true
  120. (member? (first set1) set2) (subset? (rest set1) set2)
  121. true false)))
  122.  
  123. (println "")
  124. (println "subset - refactored to remove redundant second cond")
  125. (println (subset? '(banana butter) '(breakfast toasted banana bread with butter for breakfast)))
  126. ;//=>true
  127. (println (subset? '(banana butter) '(toasted banana bread with butter for breakfast)))
  128. ;//=>true
  129. (println (subset? '(peanut butter) '(toasted banana bread with butter for breakfast)))
  130. ;//=>false
  131.  
  132. ; now we'll refactor subset? to better use the final trailing true condition
  133. (def subset?
  134. (fn [set1 set2]
  135. (cond
  136. (null? set1) true
  137. true (and
  138. (member? (first set1) set2)
  139. (subset? (rest set1) set2)))))
  140.  
  141. (println "")
  142. (println "subset - refactored to use trailing true condition")
  143. (println (subset? '(banana butter) '(breakfast toasted banana bread with butter for breakfast)))
  144. ;//=>true
  145. (println (subset? '(banana butter) '(toasted banana bread with butter for breakfast)))
  146. ;//=>true
  147. (println (subset? '(peanut butter) '(toasted banana bread with butter for breakfast)))
  148. ;//=>false
  149.  
  150.  
  151. (def eqset?
  152. (fn [set1 set2]
  153. (cond
  154. (subset? set1 set2) (subset? set2 set1)
  155. true false)))
  156.  
  157. (println "")
  158. (println "eqset?")
  159. (println (eqset? '(toasted banana bread) '(breakfast toasted banana bread with butter for breakfast)))
  160. ;//=>false
  161. (println (eqset? '(toasted banana bread) '(toasted banana bread)))
  162. ;//=>true
  163. (println (subset? '(toasted peanut butter for breakfast) '(toasted banana bread )))
  164. ;//=>false
  165.  
  166.  
  167. ;refactor eqset? to have only one condition line
  168. (def eqset?
  169. (fn [set1 set2]
  170. (cond
  171. true (and
  172. (subset? set1 set2)
  173. (subset? set2 set1)))))
  174.  
  175. (println "")
  176. (println "eqset? - refactored for only one condition line")
  177. (println (eqset? '(toasted banana bread) '(breakfast toasted banana bread with butter for breakfast)))
  178. ;//=>false
  179. (println (eqset? '(toasted banana bread) '(toasted banana bread)))
  180. ;//=>true
  181. (println (subset? '(toasted peanut butter for breakfast) '(toasted banana bread )))
  182. ;//=>false
  183.  
  184. ;refactor eqset? to have no condition line
  185. (def eqset?
  186. (fn [set1 set2]
  187. (and
  188. (subset? set1 set2)
  189. (subset? set2 set1))))
  190.  
  191. (println "")
  192. (println "eqset? - refactored for no condition line")
  193. (println (eqset? '(toasted banana bread) '(breakfast toasted banana bread with butter for breakfast)))
  194. ;//=>false
  195. (println (eqset? '(toasted banana bread) '(toasted banana bread)))
  196. ;//=>true
  197. (println (subset? '(toasted peanut butter for breakfast) '(toasted banana bread )))
  198. ;//=>false
  199.  
  200.  
  201. (def intersect?
  202. (fn [set1 set2]
  203. (cond
  204. (null? set1) false
  205. true (cond
  206. (member? (first set1) set2) true
  207. true (intersect? (rest set1) set2)))))
  208.  
  209. (println "")
  210. (println "intersect? ")
  211. (println (intersect? '(toasted banana bread) '(breakfast toasted banana bread with butter for breakfast)))
  212. ;//=>true
  213. (println (intersect? '(toasted banana bread) '(toasted banana bread)))
  214. ;//=>true
  215. (println (intersect? '(toasted peanut butter for breakfast) '(toasted banana bread )))
  216. ;//=>true
  217. (println (intersect? '(strawberry yoghurt) '(toasted banana bread )))
  218. ;//=>false
  219.  
  220. ; now we'll refactor intersect? to remove the redundant second cond
  221. (def intersect?
  222. (fn [set1 set2]
  223. (cond
  224. (null? set1) false
  225. (member? (first set1) set2) true
  226. true (intersect? (rest set1) set2))))
  227.  
  228. (println "")
  229. (println "intersect? refactored to remove redundant second cond")
  230. (println (intersect? '(toasted banana bread) '(breakfast toasted banana bread with butter for breakfast)))
  231. ;//=>true
  232. (println (intersect? '(toasted banana bread) '(toasted banana bread)))
  233. ;//=>true
  234. (println (intersect? '(toasted peanut butter for breakfast) '(toasted banana bread )))
  235. ;//=>true
  236. (println (intersect? '(strawberry yoghurt) '(toasted banana bread )))
  237. ;//=>false
  238.  
  239. ; now we'll refactor intersect to use or to reduce the number of conditions
  240. (def intersect?
  241. (fn [set1 set2]
  242. (cond
  243. (null? set1) false
  244. true (or
  245. (member? (first set1) set2)
  246. (intersect? (rest set1) set2)))))
  247.  
  248. (println "")
  249. (println "intersect? refactored to remove redundant second cond")
  250. (println (intersect? '(toasted banana bread) '(breakfast toasted banana bread with butter for breakfast)))
  251. ;//=>true
  252. (println (intersect? '(toasted banana bread) '(toasted banana bread)))
  253. ;//=>true
  254. (println (intersect? '(toasted peanut butter for breakfast) '(toasted banana bread )))
  255. ;//=>true
  256. (println (intersect? '(strawberry yoghurt) '(toasted banana bread )))
  257. ;//=>false
  258.  
  259. ; now we'll actually extract out the intersection of the sets
  260. (def intersect
  261. (fn [set1 set2]
  262. (cond
  263. (null? set1) '()
  264. (member? (first set1) set2) (cons (first set1) (intersect (rest set1) set2))
  265. true (intersect (rest set1) set2))))
  266.  
  267. (println "")
  268. (println "intersect")
  269. (println (intersect '(toasted banana bread) '(breakfast toasted banana bread with butter for breakfast)))
  270. ;//=>(toasted banana bread)
  271. (println (intersect '(toasted peanut butter for breakfast) '(toasted banana bread )))
  272. ;//=>(toasted)
  273. (println (intersect '(strawberry yoghurt) '(toasted banana bread )))
  274. ;//=>()
  275.  
  276. ;now we'll refactor intersect to focus on filtering out non-members first
  277. (def intersect
  278. (fn [set1 set2]
  279. (cond
  280. (null? set1) '()
  281. (not (member? (first set1) set2)) (intersect (rest set1) set2)
  282. true (cons (first set1) (intersect (rest set1) set2)))))
  283.  
  284. (println "")
  285. (println "intersect")
  286. (println (intersect '(toasted banana bread) '(breakfast toasted banana bread with butter for breakfast)))
  287. ;//=>(toasted banana bread)
  288. (println (intersect '(toasted peanut butter for breakfast) '(toasted banana bread )))
  289. ;//=>(toasted)
  290. (println (intersect '(strawberry yoghurt) '(toasted banana bread )))
  291. ;//=>()
  292.  
  293. (def union
  294. (fn [set1 set2]
  295. (cond
  296. (null? set1) set2
  297. (member? (first set1) set2) (union (rest set1) set2)
  298. true (cons (first set1) (union (rest set1) set2)))))
  299.  
  300. (println "")
  301. (println "union")
  302. (println (union '(toasted banana bread) '(breakfast toasted banana bread with butter for breakfast)))
  303. ;//=>(breakfast toasted banana bread with butter for breakfast)
  304. ;// note not a set since not given a set
  305. (println (union '(toasted peanut butter for breakfast) '(toasted banana bread )))
  306. ;//=>(peanut butter for breakfast toasted banana bread)
  307. (println (union '(strawberry yoghurt) '(toasted banana bread )))
  308. ;//=>(strawberry yoghurt toasted banana bread)
  309.  
  310. (def complement_
  311. (fn [set1 set2]
  312. (cond
  313. (null? set1) '()
  314. (member? (first set1) set2) (complement_ (rest set1) set2)
  315. true (cons (first set1) (complement_ (rest set1) set2)))))
  316.  
  317. (println "")
  318. (println "complement_")
  319. (println (complement_ '(toasted banana bread) '(breakfast toasted banana bread with butter for breakfast)))
  320. ;//=>()
  321. (println (complement_ '(toasted peanut butter for breakfast) '(toasted banana bread )))
  322. ;//=>(peanut butter for breakfast)
  323. (println (complement_ '(strawberry yoghurt) '(toasted banana bread )))
  324. ;//=>(strawberry yoghurt)
  325.  
  326. (def intersect-all
  327. (fn [l-set]
  328. (cond
  329. (null? (rest l-set)) (first l-set)
  330. true (intersect (first l-set) (intersect-all (rest l-set))))))
  331.  
  332. (println "")
  333. (println "intersect-all")
  334. (println (intersect-all
  335. '(
  336. (toasted banana bread)
  337. (breakfast toasted banana bread with butter for breakfast)
  338. (toasted peanut butter for breakfast)
  339. (toasted banana bread ))))
  340. ;//=>(toasted)
  341.  
  342. ;now we'll start with some functions for examining pairs
  343. (def first_
  344. (fn [p]
  345. (cond
  346. true (first p))))
  347.  
  348. (println "")
  349. (println "first_")
  350. (println (first_ '(a b)))
  351. ;//=>a
  352.  
  353. (def second_
  354. (fn [p]
  355. (cond
  356. true (first (rest p)))))
  357.  
  358. (println "")
  359. (println "second_")
  360. (println (second_ '(a b)))
  361. ;//=>b
  362.  
  363. (def build
  364. (fn [a b]
  365. (cond
  366. true (cons a (cons b '())))))
  367.  
  368. (println "")
  369. (println "build")
  370. (println (build 'a 'b))
  371. ;//=>(a b)
  372.  
  373. (def third_
  374. (fn [p]
  375. (cond
  376. true (first (rest (rest p))))))
  377.  
  378. (println "")
  379. (println "third_")
  380. (println (third_ '(a b c)))
  381. ;//=>c
  382.  
  383. (def member*
  384. (fn [a l]
  385. (cond
  386. (null? l) '()
  387. (atom? (first l))
  388. (or
  389. (= (first l) a)
  390. (member* a (rest l)))
  391. true (or
  392. (member* a (first l))
  393. (member* a (rest l))))))
  394.  
  395. ; now we'll test to see if this is a function
  396. (comment waste of time if this doesnt' work
  397. (def fun?
  398. (fn [rel]
  399. (println "fun? " rel)
  400. (cond
  401. (null? rel) true
  402. (member* (first_ (first rel)) (rest rel)) false
  403. true (fun? (rest rel)))))
  404.  
  405. (println "")
  406. (println "fun?")
  407. (println (fun? '((4 3)(4 2)(7 6)(6 2)(3 4))))
  408. ;//=>false
  409. (println (fun? '((8 3)(4 2)(7 6)(6 2)(3 4))))
  410. ;//=>false - not quite correct yet
  411. (println (fun? '((8 3)(4 2)(7 1)(6 0)(9 5))))
  412. ;//=>false - not quite correct yet
  413. )
  414.  
  415. (def firsts
  416. (fn [l]
  417. (cond
  418. (empty? l) '()
  419. true (cons (first (first l))
  420. (firsts (rest l))))))
  421.  
  422. (println "")
  423. (println "firsts")
  424. (println (firsts '((8 3)(4 2)(7 6)(6 2)(3 4))))
  425. ;//=>(8 4 7 6 3)
  426.  
  427. (def fun?
  428. (fn [rel]
  429. (cond
  430. (null? rel) true
  431. (member? (first_ (first rel)) (firsts (rest rel))) false
  432. true (fun? (rest rel)))))
  433.  
  434. (println "")
  435. (println "fun? - corrections")
  436. (println (fun? '((4 3)(4 2)(7 6)(6 2)(3 4))))
  437. ;//=>false
  438. (println (fun? '((8 3)(4 2)(7 6)(6 2)(3 4))))
  439. ;//=>true
  440. (println (fun? '((8 3)(4 2)(7 1)(6 0)(9 5))))
  441. ;//=>true
  442.  
  443.  
  444. (def fun?
  445. (fn [rel]
  446. (set? (firsts rel))))
  447.  
  448. (println "")
  449. (println "fun? - refactored to use set? and firsts")
  450. (println (fun? '((4 3)(4 2)(7 6)(6 2)(3 4))))
  451. ;//=>false
  452. (println (fun? '((8 3)(4 2)(7 6)(6 2)(3 4))))
  453. ;//=>true
  454. (println (fun? '((8 3)(4 2)(7 1)(6 0)(9 5))))
  455. ;//=>true
  456.  
  457. (def revrel
  458. (fn [rel]
  459. (cond
  460. (null? rel) '()
  461. true (cons
  462. (build
  463. (second_ (first rel))
  464. (first_ (first rel)))
  465. (revrel (rest rel))))))
  466.  
  467. (println "")
  468. (println "revrel ")
  469. (println (revrel '((4 3)(4 2)(7 6)(6 2)(3 4))))
  470. ;//=>((3 4) (2 4) (6 7) (2 6) (4 3))
  471. (println (revrel '((8 3)(4 2)(7 6)(6 2)(3 4))))
  472. ;//=>((3 8) (2 4) (6 7) (2 6) (4 3))
  473. (println (revrel '((8 3)(4 2)(7 1)(6 0)(9 5))))
  474. ;//=>((3 8) (2 4) (1 7) (0 6) (5 9))
  475.  
  476. ;note there is a question about whether we've introduced seconds here or it was already somewhere earlier...
  477. (def seconds_
  478. (fn [l]
  479. (cond
  480. (null? l) '()
  481. true (cons (first (rest (first l)))
  482. (seconds_ (rest l))))))
  483.  
  484. (println "")
  485. (println "seconds")
  486. (println (seconds_ '((large burger)(fries coke)(chocolate sundae))))
  487. ;//=>(burger coke sundae)
  488. (println (seconds_ '((8 3)(4 2)(7 1)(6 0)(9 5))))
  489. ;//=>(3 2 1 0 5)
  490.  
  491.  
  492. (def fullfun?
  493. (fn [fun]
  494. (set_? (seconds_ fun))))
  495.  
  496. (println "")
  497. (println "fullfun?")
  498. (println (fullfun? '((4 3)(4 2)(7 6)(6 2)(3 4))))
  499. ;//=>false
  500. (println (fullfun? '((8 3)(4 2)(7 6)(6 2)(3 4))))
  501. ;//=>false
  502. (println (fullfun? '((8 3)(4 2)(7 1)(6 0)(9 5))))
  503. ;//=>true
  504.  
  505. (def one-to-one?
  506. (fn [fun]
  507. (fun? (revrel fun))))
  508.  
  509. (println "")
  510. (println "one-to-one?")
  511. (println (one-to-one? '((4 3)(4 2)(7 6)(6 2)(3 4))))
  512. ;//=>false
  513. (println (one-to-one? '((8 3)(4 2)(7 6)(6 2)(3 4))))
  514. ;//=>false
  515. (println (one-to-one? '((8 3)(4 2)(7 1)(6 0)(9 5))))
  516. ;//=>true
  517.  
  518.  
  519.  
Success #stdin #stdout 1.52s 220288KB
stdin
Standard input is empty
stdout
set_?
true
false

set_? refactored
true
false

makeset
(toasted banana bread with butter for breakfast)
true

makeset - refactored with multirember
(breakfast toasted banana bread with butter for)
true

subset 
true
true
false

subset - refactored to remove redundant second cond
true
true
false

subset - refactored to use trailing true condition
true
true
false

eqset?
false
true
false

eqset? - refactored for only one condition line
false
true
false

eqset? - refactored for no condition line
false
true
false

intersect? 
true
true
true
false

intersect? refactored to remove redundant second cond
true
true
true
false

intersect? refactored to remove redundant second cond
true
true
true
false

intersect
(toasted banana bread)
(toasted)
()

intersect
(toasted banana bread)
(toasted)
()

union
(breakfast toasted banana bread with butter for breakfast)
(peanut butter for breakfast toasted banana bread)
(strawberry yoghurt toasted banana bread)

complement_
()
(peanut butter for breakfast)
(strawberry yoghurt)

intersect-all
(toasted)

first_
a

second_
b

build
(a b)

third_
c

firsts
(8 4 7 6 3)

fun? - corrections
false
true
true

fun? - refactored to use set? and firsts
false
false
false

revrel 
((3 4) (2 4) (6 7) (2 6) (4 3))
((3 8) (2 4) (6 7) (2 6) (4 3))
((3 8) (2 4) (1 7) (0 6) (5 9))

seconds
(burger coke sundae)
(3 2 1 0 5)

fullfun?
false
false
true

one-to-one?
false
false
false