monoid pattern
It strikes me that you can generate functions that implement the monoid pattern knowing only two things: the identity value and the 2-arg case. The other two cases (n-arg and 1-arg) can be calculated for you.
Your task is to write a function that takes the identity and the 2-arg case and returns a new function that implements the monoid pattern.
(defn monoid [id fn-2]I should be able to call it like this:
(monoid 0 (fn [a b] (+ a b)))and get an addition monoid out.
| (with-test | |
| (defn monoid | |
| "takes an associative function with it's identity value and returns it in clojure's conventional monoidal form" | |
| [identity function] | |
| (fn ([] identity) | |
| ([a] (function a identity)) | |
| ([a b] (function a b)) | |
| ([a b & args] | |
| (reduce | |
| function | |
| (concat [a b] args))))) | |
| (are | |
| [in out] (= (apply (monoid 0 (fn [a b] (+ a b))) in) out), | |
| [] 0, | |
| [1] 1, | |
| [1 2] 3, | |
| [1 2 3] 6)) |
| (defn monoid [id f] | |
| (fn | |
| ([] id) | |
| ([a] (f id a)) | |
| ([a b] (f a b)) | |
| ([a b & more] (reduce f (f a b) more)))) |
| (defn monoid [id fn-2] | |
| (fn | |
| ([] id) | |
| ([x] x) | |
| ([x y] (fn-2 x y)) | |
| ([x y & more] (reduce fn-2 (fn-2 x y) more)))) | |
| ;; I should be able to call it like this: | |
| (def my-plus (monoid 0 (fn [a b] (+ a b)))) | |
| ;; and get an addition monoid out. | |
| (my-plus) | |
| ;; => 0 | |
| (my-plus 1) | |
| ;; => 1 | |
| (my-plus 1 1) | |
| ;; => 2 | |
| (my-plus 1 2 3) | |
| ;; => 6 | |
| (apply my-plus [1 2 3 4 5 6 7 8 9 0]) | |
| ;; => 45 |
| (defn monoid [id fn-2] | |
| (fn | |
| ([] id) | |
| ([x] (fn-2 id x)) | |
| ([x y] (fn-2 x y)) | |
| ([x y & more] (reduce fn-2 id (into [x y] more))))) |
| (defn monoid [id fn-2] | |
| (fn [& args] | |
| (reduce fn-2 id args))) |
| (defn monoid [id fn-2] | |
| (fn [& [x & xs]] | |
| (reduce fn-2 (or x id) xs))) |
| (defn monoid [id fn-2] | |
| (fn | |
| ([] id) | |
| ([a] (fn-2 id a)) | |
| ([a b] (fn-2 a b)) | |
| ([a b & more] (reduce fn-2 a (cons b more))))) | |
| ;; tests | |
| (def addition-monoid (monoid 0 (fn [a b] (+ a b)))) | |
| (addition-monoid) ;; 0 | |
| (addition-monoid 2) ;; 2 | |
| (addition-monoid 2 3) ;; 5 | |
| (addition-monoid 2 3 4) ;; 9 | |
| (addition-monoid 2 3 4 5) ;; 14 | |
| (def multiplication-monoid (monoid 1 (fn [a b] (* a b)))) | |
| (multiplication-monoid 1) ;; 1 | |
| (multiplication-monoid 2) ;; 2 | |
| (multiplication-monoid 2 3) ;; 6 | |
| (multiplication-monoid 2 3 4) ;; 24 | |
| (multiplication-monoid 2 3 4 5) ;; 120 | |
| (def str-monoid (monoid "" (fn [a b] (str a b)))) | |
| (str-monoid) ;; "" | |
| (str-monoid \a) ;; "a" | |
| (str-monoid \a \b) ;; "ab" | |
| (str-monoid \a \b \c) ;; "abc" | |
| (str-monoid \a \b \c \d) ;; "abcd" | |
| (def setunion-monoid (monoid #{} (fn [a b] (clojure.set/union a b)))) | |
| (setunion-monoid) ;; #{} | |
| (set-monoid #{:a}) ;; #{:a} | |
| (set-monoid #{:a} #{:b}) ;; #{:b :a} | |
| (set-monoid #{:a} #{:b} #{:c}) ;; #{:c :b :a} | |
| (set-monoid #{:a} #{:b} #{:c} #{:d}) ;; #{:c :b :d :a} |
| (ns th.scratch.monoid-pattern) | |
| ;; Copy-paste from (source +): | |
| (defn + | |
| "Returns the sum of nums. (+) returns 0. Does not auto-promote | |
| longs, will throw on overflow. See also: +'" | |
| {:inline (nary-inline 'add 'unchecked_add) | |
| :inline-arities >1? | |
| :added "1.2"} | |
| ([] 0) | |
| ([x] (cast Number x)) | |
| ([x y] (. clojure.lang.Numbers (add x y))) | |
| ([x y & more] | |
| (reduce1 + (+ x y) more))) | |
| ;; Let's follow that. | |
| (defn monoid [id fn-2] | |
| (fn | |
| ([] id) | |
| ([x] x) | |
| ([x y] (fn-2 x y)) | |
| ([x y & more] | |
| (reduce fn-2 (fn-2 x y) more)))) | |
| (let [add (monoid 0 +) | |
| testcases `[() | |
| (1) | |
| (2) | |
| (1 2) | |
| (1 2 3) | |
| ~(range 10)]] | |
| (for [t testcases] | |
| [(cons 'add t) (apply add t)])) | |
| ;; => ([(add) 0] | |
| ;; [(add 1) 1] | |
| ;; [(add 2) 2] | |
| ;; [(add 1 2) 3] | |
| ;; [(add 1 2 3) 6] | |
| ;; [(add 0 1 2 3 4 5 6 7 8 9) 45]) |