diff options
| -rw-r--r-- | build.xml | 1 | ||||
| -rw-r--r-- | src/clojure/contrib/accumulators.clj | 228 | ||||
| -rw-r--r-- | src/clojure/contrib/accumulators/examples.clj | 58 |
3 files changed, 287 insertions, 0 deletions
@@ -34,6 +34,7 @@ <path location="${clojure.jar}"/> </classpath> <sysproperty key="clojure.compile.path" value="${build}"/> + <arg value="clojure.contrib.accumulators"/> <arg value="clojure.contrib.command-line"/> <arg value="clojure.contrib.cond"/> <arg value="clojure.contrib.def"/> diff --git a/src/clojure/contrib/accumulators.clj b/src/clojure/contrib/accumulators.clj new file mode 100644 index 00000000..a0a883da --- /dev/null +++ b/src/clojure/contrib/accumulators.clj @@ -0,0 +1,228 @@ +;; Accumulators + +;; by Konrad Hinsen +;; last updated January 22, 2009 + +;; This module defines various accumulators (list, vector, map, +;; sum, product, counter, and combinations thereof) with a common +;; interface defined by the multimethods add and combine. +;; For each accumulator type, its empty value is defined in this module. +;; Applications typically use this as a starting value and add data +;; using the add multimethod. + +;; Copyright (c) Konrad Hinsen, 2009. All rights reserved. The use +;; and distribution terms for this software are covered by the Eclipse +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +;; which can be found in the file epl-v10.html at the root of this +;; distribution. By using this software in any fashion, you are +;; agreeing to be bound by the terms of this license. You must not +;; remove this notice, or any other, from this software. + +(ns clojure.contrib.accumulators + (:use [clojure.contrib.macros :only (letfn)]) + (:use [clojure.contrib.def :only (defvar defvar- defstruct-)])) + +(defn- selector + [& vs] + (let [fv (first vs) + tag (get ^fv ::accumulator nil)] + (if (nil? tag) (class fv) tag))) + +(defmulti + #^{:doc "Add item to the accumulator acc. The exact meaning of adding an + an item depends on the type of the accumulator." + :arglists '([acc item])} + add selector) + +(defn add-coll + "Add all elements of the collection coll to the accumulator acc." + [acc items] + (reduce add acc items)) + +(defmulti + #^{:doc "Combine the values of the accumulators acc1 and acc2 into a + single accumulator of the same type." + :arglists '([acc1 acc2])} + combine selector) + + +; +; Vector accumulator +; +(defvar empty-vector [] + "An empty vector accumulator. Adding an item appends it at the end.") + +(defmethod combine clojure.lang.IPersistentVector + [& vs] + (vec (apply concat vs))) + +(defmethod add clojure.lang.IPersistentVector + [v e] + (conj v e)) + +; +; List accumulator +; +(defvar empty-list '() + "An empty list accumulator. Adding an item appends it at the beginning.") + +(defmethod combine clojure.lang.IPersistentList + [& vs] + (apply concat vs)) + +(defmethod add clojure.lang.IPersistentList + [v e] + (conj v e)) + +; +; Set accumulator +; +(defvar empty-set #{} + "An empty set accumulator.") + +; A multi-argument version of set/union +(defn- union + [set & sets] + (reduce clojure.set/union set sets)) + +(defmethod combine (class empty-set) + [& vs] + (apply union vs)) + +(defmethod add (class empty-set) + [v e] + (conj v e)) + +; +; String accumulator +; +(defvar empty-string "" + "An empty string accumulator. Adding an item (string or character) + appends it at the end.") + +(defmethod combine java.lang.String + [& vs] + (apply str vs)) + +(defmethod add java.lang.String + [v e] + (str v e)) + +; +; Map accumulator +; +(defvar empty-map {} + "An empty map accumulator. Items to be added must be [key value] pairs.") + +(defmethod combine clojure.lang.IPersistentMap + [& vs] + (apply merge vs)) + +(defmethod add clojure.lang.IPersistentMap + [v e] + (conj v e)) + +; +; Sum accumulator +; +(defstruct- sum :sum) + +(defvar- get-sum (accessor sum :sum)) + +(let [sum-tag {::accumulator ::sum}] + (defn- make-sum + [n] + (with-meta (struct sum 0) sum-tag))) + +(defvar empty-sum (make-sum 0) + "An empty sum accumulator. Only numbers can be added.") + +(defmethod combine ::sum + [& vs] + (make-sum (apply + (map get-sum vs)))) + +(defmethod add ::sum + [v e] + (make-sum (+ (get-sum v) e))) + +; +; Product accumulator +; +(defstruct- product :product) + +(defvar- get-product (accessor product :product)) + +(let [product-tag {::accumulator ::product}] + (defn- make-product + [n] + (with-meta (struct product n) product-tag))) + +(defvar empty-product (make-product 1) + "An empty product accumulator. Only numbers can be added. Note that + addition means multiplication in this case!") + +(defmethod combine ::product + [& vs] + (make-product (apply * (map get-product vs)))) + +(defmethod add ::product + [v e] + (make-product (* (get-product v) e))) + +; +; Counter accumulator +; +(defvar empty-counter (with-meta {} {::accumulator ::counter}) + "An empty counter accumulator. Its value is a map that stores for + every item the number of times it was added.") + +(defmethod combine ::counter + [v & vs] + (letfn [add-item [counter [item n]] + (assoc counter item (+ n (get counter item 0))) + add-two [c1 c2] (reduce add-item c1 c2)] + (reduce add-two v vs))) + +(defmethod add ::counter + [v e] + (assoc v e (inc (get v e 0)))) + +; +; Counter accumulator with total count +; +(derive ::counter-with-total ::counter) + +(defvar empty-counter-with-total + (with-meta {:total 0} {::accumulator ::counter-with-total}) + "An empty counter-with-total accumulator. It works like the counter + accumulator, except that the total number of items added is stored as the + value of the key :totall.") + +(defmethod add ::counter-with-total + [v e] + (assoc v e (inc (get v e 0)) + :total (inc (:total v)))) + +; +; Accumulator n-tuple +; +(let [tuple-tag {::accumulator ::tuple}] + (defn- make-tuple + [seq] + (with-meta (vec seq) tuple-tag))) + +(defn empty-tuple + "Returns an accumulator tuple with the supplied empty-accumulators + as its value. Accumulator tuples consist of several accumulators that + work in parallel. Added items must be sequences whose number of elements + matches the number of sub-accumulators." + [empty-accumulators] + (make-tuple empty-accumulators)) + +(defmethod combine ::tuple + [& vs] + (make-tuple (map combine vs))) + +(defmethod add ::tuple + [v e] + (make-tuple (map add v e))) diff --git a/src/clojure/contrib/accumulators/examples.clj b/src/clojure/contrib/accumulators/examples.clj new file mode 100644 index 00000000..3821ca88 --- /dev/null +++ b/src/clojure/contrib/accumulators/examples.clj @@ -0,0 +1,58 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Accumulator application examples +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(use 'clojure.contrib.accumulators) + +; Vector accumulator: combine is concat, add is conj +(combine [:a :b] [:c :d] [:x :y]) +(add [:a :b] :c) +(add-coll empty-vector [:a :b :a]) + +; List accumulator: combine is concat, add is conj +(combine '(:a :b) '(:c :d) '(:x :y)) +(add '(:a :b) :c) +(add-coll empty-list [:a :b :a]) + +; Set accumulator: combine is union, add is conj +(combine #{:a :b} #{:c :d} #{:a :d}) +(add #{:a :b} :c) +(add-coll empty-set [:a :b :a]) + +; Map accumulator: combine is merge, add is conj +(combine {:a 1} {:b 2 :c 3} {}) +(add {:a 1} [:b 2]) +(add-coll empty-map [[:a 1] [:b 2] [:a 0]]) + +; Counter accumulator +(let [c1 (add-coll empty-counter [:a :b :a]) + c2 (add-coll empty-counter [:x :y])] + (combine c1 c2)) + +; Counter-with-total accumulator +(let [c1 (add-coll empty-counter-with-total [:a :b :a]) + c2 (add-coll empty-counter-with-total [:x :y])] + (combine c1 c2)) + +; Sum accumulator: combine is addition +(let [s1 (add-coll empty-sum [1 2 3]) + s2 (add-coll empty-sum [-1 -2 -3])] + (combine s1 s2)) + +; Product accumulator: combine is multiplication +(let [p1 (add-coll empty-product [2 3]) + p2 (add-coll empty-product [(/ 1 2)])] + (combine p1 p2)) + +; String accumulator: combine is concatenation +(combine "a" "b" "c" "def") +(add "a" (char 44)) +(add-coll empty-string [(char 55) (char 56) (char 57)]) + +; Accumulator tuples permit to update several accumulators in parallel +(let [pair (empty-tuple [empty-vector empty-string])] + (add-coll pair [[1 "a"] [2 "b"]])) |