fork download
copy 
  1. (def atom?
  2.   (fn [a]
  3.     (not (seq? a))))
  4.  
  5. (println "atom?")
  6. (println (atom? 'a))
  7. (println (atom? '()))
  8. (println (atom? (quote thai)))
  9.  
  10. (def null?
  11.   (fn [a]
  12.     (or
  13.       (nil? a)
  14.       (= () a))))
  15.  
  16. (def not_
  17.   (fn [b]
  18.     (cond
  19.       b false
  20.       true true)))
  21.  
  22. (println "")
  23. (println "not_")
  24. (println (not_ true))
  25. (println (not_ false))
  26. (println (not_ (= 1 1)))
  27. (println (not_ (= 'a 'b)))
  28.  
  29. (def non-atom?
  30.   (fn [s]
  31.     (not_ (atom? s))))
  32.  
  33. (println "")
  34. (println "non-atom?")
  35. (println (non-atom? 'a))
  36. (println (non-atom? '(a)))
  37. (println (non-atom? (quote thai)))
  38.  
  39.  
  40. (def leftmost
  41.   (fn [l]
  42.     (cond
  43.       (null? l) '()
  44.       (non-atom? (first l)) (leftmost (first l))
  45.       true (first l))))
  46.  
  47. (println "")
  48. (println "leftmost")
  49. (println (leftmost (quote ((((pad))thai))chicken())))
  50.  
  51. (def rember*
  52.   (fn [a l]
  53.     (cond
  54.       (null? l) '()
  55.       (non-atom? (first l)) (cons (rember* a (first l)) (rember* a (rest l)))
  56.       true (cond
  57.              (= (first l) a) (rember* a (rest l))
  58.              true (cons (first l) (rember* a (rest l)))))))
  59.  
  60. (println "")
  61. (println "rember*")
  62. (println (rember* 'bacon '(((bbq sauce)) (with (egg and (bacon))))))
  63.  
  64. (def insertR*
  65.   (fn [new old l]
  66.     (cond
  67.       (null? l) '()
  68.       (non-atom? (first l)) (cons (insertR* new old (first l)) (insertR* new old (rest l)))
  69.       true (cond
  70.              (= (first l) old) (cons old (cons new (insertR* new old (rest l))))
  71.              true (cons (first l) (insertR* new old (rest l)))))))
  72.  
  73. (println "")
  74. (println "insertR*")
  75. (println (insertR* 'chicken 'baked '(((baked)) (with roast) vegetables)))
  76.  
  77. (def zero_?
  78.   (fn [n]
  79.     (= 0 n)))
  80.  
  81. (def add1
  82.   (fn [n]
  83.     (+ 1 n)))
  84.  
  85. (def sub1
  86.   (fn [n]
  87.     (- n 1)))
  88.  
  89. (def +_
  90.   (fn [n m]
  91.     (cond
  92.       (zero_? m) n
  93.       true (add1 (+ n (sub1 m))))))
  94.  
  95. (def occur*
  96.   (fn [a l]
  97.     (cond
  98.       (null? l) 0
  99.       (non-atom? (first l)) (+_ (occur* a (first l)) (occur* a (rest l)))
  100.       true (cond
  101.              (= (first l) a) (add1 (occur* a (rest l)))
  102.              true (occur* a (rest l))))))
  103.  
  104. (println "")
  105. (println "occur*")
  106. (println (occur* 'creamy '(((creamy)) new (york (cheesecake)) with a ((creamy) latte))))
  107.  
  108. (def subst*
  109.   (fn [new old l]
  110.     (cond
  111.       (null? l) '()
  112.       (non-atom? (first l)) (cons (subst* new old (first l)) (subst* new old (rest l)))
  113.       true (cond 
  114.              (= (first l) old) (cons new (subst* new old (rest l)))
  115.              true (cons (first l) (subst* new old (rest l)))))))
  116.  
  117. (println "")
  118. (println "subst*")
  119. (println (subst* 'baked 'creamy '(((creamy) cheesecake) (with (hot (espresso))))))
  120.  
  121. (def insertL*
  122.   (fn [new old l]
  123.     (cond
  124.       (null? l) '()
  125.       (non-atom? (first l))
  126.         (cons
  127.           (insertL* new old (first l))
  128.           (insertL* new old (rest l)))
  129.       true (cond
  130.         (= (first l) old)
  131.           (cons new
  132.             (cons old
  133.               (insertL*
  134.                 new old (rest l))))
  135.         true (cons (first l)
  136.           (insertL*
  137.             new old (rest l)))))))
  138.  
  139. (println "")
  140. (println "insertL*")
  141. (println (insertL* 'fresh 'creamy '(((creamy) cheesecake) (with (hot (espresso))))))
  142.  
  143. (def member*
  144.   (fn [a l]
  145.     (cond
  146.       (null? l) false
  147.       (non-atom? (first l))
  148.         (or
  149.           (member* a (first l))
  150.           (member* a (rest l)))
  151.       true (or
  152.         (= (first l) a)
  153.         (member* a (rest l))))))
  154.  
  155. (println "")
  156. (println "member*")
  157. (println (member* 'creamy '(((creamy) cheesecake) (with (hot (espresso))))))
  158.  
  159.  
  160. (def member*
  161.   (fn [a l]
  162.     (cond
  163.       (null? l) false
  164.       (atom? (first l))
  165.         (or
  166.           (= (first l) a)
  167.           (member* a (rest l)))
  168.       true (or
  169.         (member* a (first l))
  170.         (member* a (rest l))))))
  171.  
  172. (println "")
  173. (println "member* - without non-atom?")
  174. (println (member* 'creamy '(((creamy) cheesecake) (with (hot (espresso))))))
  175.  
  176. (def >_
  177.   (fn [n m]
  178.     (cond
  179.       (zero_? n) false
  180.       (zero_? m) true
  181.       true (>_ (sub1 n) (sub1 m)))))
  182.  
  183. (println "")
  184. (println ">_")
  185. (println (>_ 10 1))
  186. (println (>_ 1 10))
  187.  
  188. (def =_   
  189.   (fn [n m]     
  190.     (cond       
  191.       (>_ n m) false
  192.       true true)))
  193.  
  194. (println "")
  195. (println "=_")
  196. (println (=_ 1 10))
  197. (println (=_ 10 1))
  198. (println (=_ 10 10))
  199.  
  200. (def eqan?
  201.   (fn [a1 a2]
  202.     (cond
  203.       (number? a1)
  204.         (cond
  205.           (number? a2) (=_ a1 a2)
  206.           true false)
  207.       (number? a2) false
  208.       true (= a1 a2))))
  209.  
  210. (println "")
  211. (println "eqan?")
  212. (println (eqan?  1 10))
  213. (println (eqan?  10 1))
  214. (println (eqan?  10 10))
  215. (println (eqan?  'a 'b))
  216. (println (eqan?  'a 'a))
  217.  
  218.  
  219. (def eqlist?
  220.   (fn [l1 l2]
  221.     (cond
  222.       (and (null? l1) (null? l2)) true
  223.       (or (null? l1) (null? l2)) false
  224.       (and (non-atom? (first l1)) (non-atom? (first l2)))
  225.         (and (eqlist? (first l1) (first l2))
  226.              (eqlist? (rest l1) (rest l2)))
  227.       (or (non-atom? (first l1)) (non-atom? (first l2))) false
  228.       true (and
  229.         (eqan? (first l1) (first l2))
  230.         (eqlist? (rest l1) (rest l2))))))
  231.  
  232. (println "")
  233. (println "eqlist?")
  234. (println (eqlist? '(with (hot (espresso))) '(with (hot (espresso)))))
  235. (println (eqlist? '(with (hot (espresso))) '((creamy) cheesecake)))
  236.  
  237.  
  238. (def equal?
  239.   (fn [s1 s2]
  240.     (cond
  241.       (and (atom? s1) (atom? s2))
  242.         (eqan? s1 s2)
  243.       (and (non-atom? s1) (non-atom? s2))
  244.         (eqlist? s1 s2)
  245.       true false)))
  246.  
  247. (println "")
  248. (println "equal?")
  249. (println (equal? '(hot espresso coffee) '(creamy cheesecake)))
  250. (println (equal? '(creamy cheesecake) '(creamy cheesecake)))
  251.  
  252. (def eqlist?
  253.   (fn [l1 l2]
  254.     (cond
  255.       (and (null? l1) (null? l2)) true
  256.       (or (null? l1) (null? l2)) false
  257.       true (and
  258.         (equal? (first l1) (first l2))
  259.         (eqlist? (rest l1) (rest l2))))))
  260.  
  261. (println "")
  262. (println "eqlist? refactored")
  263. (println (eqlist? '(with (hot (espresso))) '(with (hot (espresso)))))
  264. (println (eqlist? '(with (hot (espresso))) '((creamy) cheesecake)))
  265.  
  266. (def rember
  267.   (fn [s l]
  268.     (cond
  269.       (null? l) '()
  270.       (non-atom? (first l)) 
  271.         (cond
  272.           (equal? (first l) s) (rest l)
  273.           true (cons (first l) (rember s (rest l))))
  274.       true (cond
  275.         (equal? (first l) s) (rest l)
  276.         true (cons (first l) (rember s (rest l)))))))
  277.  
  278. (println "")
  279. (println "rember")
  280. (println (rember 'fresh '(((fresh creamy) cheesecake) (with (hot (espresso))))))
  281. (println (rember 'fresh '(fresh creamy cheesecake with hot espresso)))
  282.  
  283. (def rember
  284.   (fn [s l]
  285.     (cond
  286.       (null? l) '()
  287.       true (cond
  288.         (equal? (first l) s) (rest l)
  289.         true (cons (first l) (rember s (rest l)))))))
  290.  
  291. (println "")
  292. (println "rember - refactored")
  293. (println (rember 'fresh '(((fresh creamy) cheesecake) (with (hot (espresso))))))
  294. (println (rember 'fresh '(fresh creamy cheesecake with hot espresso)))
  295.  
  296. (def rember
  297.   (fn [s l]
  298.     (cond
  299.       (null? l) '()
  300.       (equal? (first l) s) (rest l)
  301.       true (cons (first l) (rember s (rest l))))))
  302.  
  303. (println "")
  304. (println "rember - refactored again")
  305. (println (rember 'fresh '(((fresh creamy) cheesecake) (with (hot (espresso))))))
  306. (println (rember 'fresh '(fresh creamy cheesecake with hot espresso)))
  307.  
  308. (def insertL*
  309.   (fn [new old l]
  310.     (cond
  311.       (null? l) '()
  312.       (non-atom? (first l))
  313.         (cons
  314.           (insertL* new old (first l))
  315.           (insertL* new old (rest l)))
  316.       (= (first l) old)
  317.         (cons new (cons old (insertL* new old (rest l))))
  318.       true (cons (first l) (insertL* new old (rest l))))))
  319.  
  320. (println "")
  321. (println "insertL* - refactored")
  322. (println (insertL* 'fresh 'creamy '(((creamy) cheesecake) (with (hot (espresso))))))
  323.  
Success #stdin #stdout 1.54s 221248KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
atom?
true
false
true

not_
false
true
false
true

non-atom?
false
true
false

leftmost
pad

rember*
(((bbq sauce)) (with (egg and ())))

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

occur*
2

subst*
(((baked) cheesecake) (with (hot (espresso))))

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

member*
true

member* - without non-atom?
true

>_
true
false

=_
true
false
true

eqan?
true
false
true
false
true

eqlist?
true
false

equal?
false
true

eqlist? refactored
true
false

rember
(((fresh creamy) cheesecake) (with (hot (espresso))))
(creamy cheesecake with hot espresso)

rember - refactored
(((fresh creamy) cheesecake) (with (hot (espresso))))
(creamy cheesecake with hot espresso)

rember - refactored again
(((fresh creamy) cheesecake) (with (hot (espresso))))
(creamy cheesecake with hot espresso)

insertL* - refactored
(((fresh creamy) cheesecake) (with (hot (espresso))))
https://ideone.com/KiBxn
language:
Clojure (clojure 1.10.0)
created:
12 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!