updated functional examples

Author: stuarthalloway

examples/functional.clj

@@ -1,6 +1,7 @@
 (ns examples.functional)
 
 ; START: stack-consuming-fibo
+; bad idea
 (defn stack-consuming-fibo [n]
   (cond
    (= n 0) 0 ; <label id="code.stack-consuming-fibo.0"/>
@@ -9,7 +10,7 @@
 ; END: stack-consuming-fibo
 
 ; START: tail-recursive-fibo
-; beware: still consumes stack!
+; also bad: still consumes stack!
 (defn tail-recursive-fibo [n]
   (cond
    (= n 0) 0
@@ -23,6 +24,7 @@
 ; END: tail-recursive-fibo
 
 ; START: loop-recur-fibo    
+; better but not great
 (defn loop-recur-fibo [n]
   (cond
    (= n 0) 0
@@ -35,7 +37,8 @@
 ; END: loop-recur-fibo
 
 ; START: fibo-series
-; returns series to n (heap-consuming!)
+; returns series to n 
+; still bad (heap-consuming!)
 (defn fibo-series [count]
   (let [n (dec count)]
     (cond
@@ -60,33 +63,6 @@
 (def head-fibo (lazy-cat [0 1] (map + head-fibo (rest head-fibo))))
 ; END: head-fibo
 
-; inspired by http://www.cs.uni.edu/~wallingf/patterns/recursion.html
-(defn symbol-replace [coll oldsym newsym]
-  (if (empty? coll)
-    ()
-    (let [f (first coll)]
-      (if (symbol? f)
-	(lazy-cons (if (= f oldsym) newsym f)
-		   (symbol-replace (rest coll) oldsym newsym))
-	(lazy-cons (symbol-replace f oldsym newsym)
-		   (symbol-replace (rest coll) oldsym newsym))))))
-      
-(declare h-male h-female)
-(defn h-male [n]
-  (if (= n 0)
-    0
-    (- n (h-female (h-male (dec n))))))
-
-(defn h-female [n]		 
-  (if (= n 0)
-    1
-    (- n (h-male (h-female (dec n))))))
-(def h-male (memoize h-male))
-(def h-female (memoize h-female))
-
-(def h-male-seq (map h-male (iterate inc 0)))
-(def h-female-seq (map h-female (iterate inc 0)))
-
 ; START: count-heads-pairs
 (defn count-heads-pairs [coll]
   (loop [cnt 0 coll coll] ; <label id="code.count-heads-loop.loop"/>
@@ -110,21 +86,29 @@
 (defn count-heads-pairs [coll]
   (count (filter (fn [pair] (every? #(= :h %) pair)) 
 		 (by-pairs coll))))
+; END: count-heads-by-pairs
 (def count-heads-by-pairs count-heads-pairs)
-; START: count-heads-by-pairs
 
-(def
-#^{:doc "Count items matching a predicate."
-   :arglists '([pred coll])}
-count-if (comp count filter))
+; START: count-if
+(use '[clojure.contrib.def :only (defvar)])
+(defvar count-if (comp count filter)  "Count items matching a filter")
+; END: count-if
 
+; START: count-runs
 (defn
  count-runs
  "Count runs of length n where pred is true in coll."
  [n pred coll]
  (count-if #(every? pred %) (partition n 1 coll)))
+; END: count-runs
 
+; START: count-heads-by-runs
+(defvar count-heads-pairs (partial count-runs 2 #(= % :h))
+  "Count runs of length two that are both heads")
+; END: count-heads-by-runs
+(def count-heads-by-runs count-heads-pairs)
 
+; START: my-odd-even
 (declare my-odd? my-even?)
 
 (defn my-odd? [n]
@@ -136,15 +120,32 @@ count-if (comp count filter))
   (if (= n 0)
     true
     (my-odd? (dec n))))
-
-(defn my-parity? [parity n]
-  (if (= n 0)
-    (= parity 0)
-    (recur (- 1 parity) (dec n))))
-
-(def my-even-2? (partial my-parity? 0))
-(def my-odd-2? (partial my-parity? 1))
-
+; END: my-odd-even
+
+; START: parity
+(defn parity [n]
+  (loop [n n par 0]
+    (if (= n 0)
+      par
+      (recur (dec n) (- 1 par)))))
+; END: parity
+
+; START: my-odd-even-parity
+(defn my-even? [n] (= 0 (parity n)))
+(defn my-odd? [n] (= 1 (parity n)))
+; END: my-odd-even-parity
+
+; START: curry
+; almost a curry
+(defn curry [f]
+  (fn [& front] 
+    (fn [& back]
+      (apply f (concat front back)))))
+; END: curry
+
+; --------------------------------------------------------------------------------------
+; -- See www.cs.brown.edu/~sk/Publications/Papers/Published/sk-automata-macros/paper.pdf
+; --------------------------------------------------------------------------------------
 (defn machine [stream]
    (let [step {[:init 'c] :more
                [:more 'a] :more
@@ -175,5 +176,4 @@ count-if (comp count filter))
   (when-not (seq stream) true))
 
 
-
-       
+	      

examples/male_female.clj

@@ -0,0 +1,16 @@
+(ns examples.male-female)
+
+; START: m-f
+; do not use these directly
+(declare m f)
+(defn m [n]
+  (if (= n 0)
+    0
+    (- n (f (m (dec n))))))
+
+(defn f [n]		 
+  (if (= n 0)
+    1
+    (- n (m (f (dec n))))))
+; END: m-f
+

examples/male_female_seq.clj

@@ -0,0 +1,22 @@
+(ns examples.male-female-seq
+  (use [clojure.contrib.def :only (defvar-)]))
+
+(declare m f)
+(defn- m [n]
+  (if (= n 0)
+    0
+    (- n (f (m (dec n))))))
+
+(defn- f [n]		 
+  (if (= n 0)
+    1
+    (- n (m (f (dec n))))))
+
+(defvar- m (memoize m))
+(defvar- f (memoize f))
+
+; START: m-f-seq
+(def m-seq (map m (iterate inc 0)))
+(def f-seq (map f (iterate inc 0)))
+; END: m-f-seq
+

examples/memoized_male_female.clj

@@ -0,0 +1,18 @@
+(ns examples.memoized-male-female)
+
+(declare m f)
+(defn- m [n]
+  (if (= n 0)
+    0
+    (- n (f (m (dec n))))))
+
+(defn- f [n]		 
+  (if (= n 0)
+    1
+    (- n (m (f (dec n))))))
+
+; START: m-f-memoize 
+(def m (memoize m))
+(def f (memoize f))
+; END: m-f-memoize
+

examples/symbol_replace.clj

@@ -0,0 +1,26 @@
+(ns examples.symbol-replace)
+
+; inspired by http://www.cs.uni.edu/~wallingf/patterns/recursion.html
+(defn- coll-or-scalar [x & _] (if (coll? x) :collection :scalar))
+(defmulti symbol-replace coll-or-scalar)
+
+(defmethod symbol-replace :collection [coll oldsym newsym]
+  (if (empty? coll)
+    coll
+    (cons (symbol-replace (first coll) oldsym newsym)
+	  (symbol-replace (rest coll) oldsym newsym))))
+
+(defmethod symbol-replace :scalar [obj oldsym newsym] 
+  (if (= obj oldsym) newsym obj))
+
+;; (defn symbol-replace [coll oldsym newsym]
+;;   (if (empty? coll)
+;;     coll
+;;     (let [f (first coll)]
+;;       (if (symbol? f)
+;; 	(lazy-cons (if (= f oldsym) newsym f)
+;; 		   (symbol-replace (rest coll) oldsym newsym))
+;; 	(lazy-cons (symbol-replace f oldsym newsym)
+;; 		   (symbol-replace (rest coll) oldsym newsym))))))
+
+

examples/test.clj

@@ -9,7 +9,8 @@
 	    :sequences :index-of-any :life-without-multi :multimethods.default
 	    :macros :macros.chain-1 :macros.chain-2 :macros.chain-3 :macros.chain-4
 	    :macros.chain-5 :lazy-index-of-any :macros.bench-1
-	    :concurrency :functional :snake :snippet]))
+	    :concurrency :functional :snake :snippet :symbol-replace
+	    :male-female :memoized-male-female :male-female-seq]))
 
 (def lancet-tests 
      (map #(symbol (str "lancet.test." (name %)))

examples/test/functional.clj

@@ -25,24 +25,8 @@
 (deftest test-head-fibo 
   (is (= ten-fibs (take 10 head-fibo))))
 
-(deftest test-symbol-replace
-  (are (= _1 _2)
-       () (symbol-replace () 'a 'b)
-       '(a) (symbol-replace '(a) 'b 'c)
-       '(c) (symbol-replace '(b) 'b 'c)
-       '(a (d e)) (symbol-replace '(a (d e)) 'b 'c)
-       '(c (c c)) (symbol-replace '(b (b b)) 'b 'c)
-))
-
-(deftest test-hofstadter-m-f
-  (are (= _1 _2)
-       [0, 0, 1, 2, 2, 3, 4, 4, 5, 6, 6, 7, 7, 8, 9, 9, 10, 11, 11, 12, 12]
-       (map h-male (range 0 21))
-       [1, 1, 2, 2, 3, 3, 4, 5, 5, 6, 6, 7, 8, 8, 9, 9, 10, 11, 11, 12, 13]
-       (map h-female (range 0 21))))
-
 (deftest test-count-heads-pairs
-  (doseq [count-fn [count-heads-loop count-heads-by-pairs]]
+  (doseq [count-fn [count-heads-loop count-heads-by-pairs count-heads-by-runs]]
       (are (= _1 _2)
 	   0 (count-fn [:h :t])
 	   1 (count-fn [:t :h :h :t])

examples/test/male_female.clj

@@ -0,0 +1,11 @@
+(ns examples.test.male-female
+  (:use clojure.contrib.test-is 
+        examples.male-female))
+
+(deftest test-hofstadter-m-f
+  (are (= _1 _2)
+       [0, 0, 1, 2, 2, 3, 4, 4, 5, 6, 6, 7, 7, 8, 9, 9, 10, 11, 11, 12, 12]
+       (map m (range 21))
+       [1, 1, 2, 2, 3, 3, 4, 5, 5, 6, 6, 7, 8, 8, 9, 9, 10, 11, 11, 12, 13]
+       (map f (range 21))))
+

examples/test/male_female_seq.clj

@@ -0,0 +1,11 @@
+(ns examples.test.male-female-seq
+  (:use clojure.contrib.test-is 
+        examples.male-female-seq))
+
+(deftest test-hofstadter-m-f
+  (are (= _1 _2)
+       [0, 0, 1, 2, 2, 3, 4, 4, 5, 6, 6, 7, 7, 8, 9, 9, 10, 11, 11, 12, 12]
+       (take 21 m-seq)
+       [1, 1, 2, 2, 3, 3, 4, 5, 5, 6, 6, 7, 8, 8, 9, 9, 10, 11, 11, 12, 13]
+       (take 21 f-seq)))
+

examples/test/memoized_male_female.clj

@@ -0,0 +1,11 @@
+(ns examples.test.memoized-male-female
+  (:use clojure.contrib.test-is 
+        examples.memoized-male-female))
+
+(deftest test-hofstadter-m-f
+  (are (= _1 _2)
+       [0, 0, 1, 2, 2, 3, 4, 4, 5, 6, 6, 7, 7, 8, 9, 9, 10, 11, 11, 12, 12]
+       (map m (range 21))
+       [1, 1, 2, 2, 3, 3, 4, 5, 5, 6, 6, 7, 8, 8, 9, 9, 10, 11, 11, 12, 13]
+       (map f (range 21))))
+

examples/test/symbol_replace.clj

@@ -0,0 +1,13 @@
+(ns examples.test.symbol-replace
+  (:use clojure.contrib.test-is 
+        examples.symbol-replace))
+
+(deftest test-symbol-replace
+  (are (= _1 _2)
+       () (symbol-replace () 'a 'b)
+       '(a) (symbol-replace '(a) 'b 'c)
+       '(c) (symbol-replace '(b) 'b 'c)
+       '(a (d e)) (symbol-replace '(a (d e)) 'b 'c)
+       '(c (c c)) (symbol-replace '(b (b b)) 'b 'c)
+))
+

examples/trampoline.clj

@@ -0,0 +1,31 @@
+(ns examples.trampoline)
+
+; START: tail-recursive-fibo
+; Example only. Don't write code like this.
+(defn tail-recursive-fibo [n]
+  (cond
+   (= n 0) 0
+   (= n 1) 1
+   true ((fn fib [f-2 f-1 current]
+	   (let [f (+ f-2 f-1)]
+	     (if (= n current) 
+	       f
+	       #(fib f-1 f (inc current))))) ; <label id="code.tail-recursive-fibo.trampoline"/>
+	 0 1 2)))
+; END: tail-recursive-fibo
+
+; START: odd-even
+(declare my-odd? my-even?)
+
+(defn my-odd? [n]
+  (if (= n 0)
+    false
+    #(my-even? (dec n)))) ; <label id="code.trampoline.my-odd"/>
+
+(defn my-even? [n]
+  (if (= n 0)
+    true
+    #(my-odd? (dec n)))) ; <label id="code.trampoline.my-even"/>
+; END: odd-even
+
+