1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/src/clojure/contrib/accumulators.clj	Sat Aug 21 06:25:44 2010 -0400
     1.3 @@ -0,0 +1,324 @@
     1.4 +;; Accumulators
     1.5 +
     1.6 +;; by Konrad Hinsen
     1.7 +;; last updated May 19, 2009
     1.8 +
     1.9 +;; This module defines various accumulators (list, vector, map,
    1.10 +;; sum, product, counter, and combinations thereof) with a common
    1.11 +;; interface defined by the multimethods add and combine.
    1.12 +;; For each accumulator type, its empty value is defined in this module.
    1.13 +;; Applications typically use this as a starting value and add data
    1.14 +;; using the add multimethod.
    1.15 +
    1.16 +;; Copyright (c) Konrad Hinsen, 2009. All rights reserved.  The use
    1.17 +;; and distribution terms for this software are covered by the Eclipse
    1.18 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
    1.19 +;; which can be found in the file epl-v10.html at the root of this
    1.20 +;; distribution.  By using this software in any fashion, you are
    1.21 +;; agreeing to be bound by the terms of this license.  You must not
    1.22 +;; remove this notice, or any other, from this software.
    1.23 +
    1.24 +(ns
    1.25 +  ^{:author "Konrad Hinsen"
    1.26 +     :doc "A generic accumulator interface and implementations of various
    1.27 +           accumulators."}
    1.28 +  clojure.contrib.accumulators
    1.29 +  (:refer-clojure :exclude (deftype))
    1.30 +  (:use [clojure.contrib.types :only (deftype)])
    1.31 +  (:use [clojure.contrib.def :only (defvar defvar- defmacro-)])
    1.32 +  (:require [clojure.contrib.generic.arithmetic :as ga]))
    1.33 +
    1.34 +(defmulti add
    1.35 +  "Add item to the accumulator acc. The exact meaning of adding an
    1.36 +   an item depends on the type of the accumulator."
    1.37 +   {:arglists '([acc item])}
    1.38 +  (fn [acc item] (type acc)))
    1.39 +
    1.40 +(defn add-items
    1.41 +  "Add all elements of a collection coll to the accumulator acc."
    1.42 +  [acc items]
    1.43 +  (reduce add acc items))
    1.44 +
    1.45 +(defmulti combine
    1.46 +  "Combine the values of the accumulators acc1 and acc2 into a
    1.47 +   single accumulator of the same type."
    1.48 +  {:arglists '([& accs])}
    1.49 +  (fn [& accs] (type (first accs))))
    1.50 +
    1.51 +;
    1.52 +; An ::accumulator type tag is attached to tbe built-in types
    1.53 +; when used as accumulators, and new types are derived from it.
    1.54 +; Multimethods add and combine for ::accumulator sub-dispatch on class.
    1.55 +; We also define generic addition as the combine operation.
    1.56 +;
    1.57 +(let [meta-map {:type ::accumulator}]
    1.58 +  (defn- with-acc-tag
    1.59 +    [x]
    1.60 +    (with-meta x meta-map)))
    1.61 +
    1.62 +(defmethod add ::accumulator
    1.63 +  [a e]
    1.64 +  ((get-method add (class a)) a e))
    1.65 +
    1.66 +(defmethod combine ::accumulator
    1.67 +  [& as]
    1.68 +  (apply (get-method combine (class (first as))) as))
    1.69 +
    1.70 +(defmethod ga/+ ::accumulator
    1.71 +  [x y]
    1.72 +  (combine x y))
    1.73 +
    1.74 +;
    1.75 +; Vector accumulator
    1.76 +;
    1.77 +(defvar empty-vector (with-acc-tag [])
    1.78 +  "An empty vector accumulator. Adding an item appends it at the end.")
    1.79 +
    1.80 +(defmethod combine clojure.lang.IPersistentVector
    1.81 +  [& vs]
    1.82 +  (with-acc-tag (vec (apply concat vs))))
    1.83 +
    1.84 +(defmethod add clojure.lang.IPersistentVector
    1.85 +  [v e]
    1.86 +  (with-acc-tag (conj v e)))
    1.87 +
    1.88 +;
    1.89 +; List accumulator
    1.90 +;
    1.91 +(defvar empty-list (with-acc-tag '())
    1.92 +  "An empty list accumulator. Adding an item appends it at the beginning.")
    1.93 +
    1.94 +(defmethod combine clojure.lang.IPersistentList
    1.95 +  [& vs]
    1.96 +  (with-acc-tag (apply concat vs)))
    1.97 +
    1.98 +(defmethod add clojure.lang.IPersistentList
    1.99 +  [v e]
   1.100 +  (with-acc-tag (conj v e)))
   1.101 +
   1.102 +;
   1.103 +; Queue accumulator
   1.104 +;
   1.105 +(defvar empty-queue (with-acc-tag clojure.lang.PersistentQueue/EMPTY)
   1.106 +  "An empty queue accumulator. Adding an item appends it at the end.")
   1.107 +
   1.108 +(defmethod combine clojure.lang.PersistentQueue
   1.109 +  [& vs]
   1.110 +  (add-items (first vs) (apply concat (rest vs))))
   1.111 +
   1.112 +(defmethod add clojure.lang.PersistentQueue
   1.113 +  [v e]
   1.114 +  (with-acc-tag (conj v e)))
   1.115 +
   1.116 +;
   1.117 +; Set accumulator
   1.118 +;
   1.119 +(defvar empty-set (with-acc-tag #{})
   1.120 +  "An empty set accumulator.")
   1.121 +
   1.122 +(defmethod combine (class empty-set)
   1.123 +  [& vs]
   1.124 +  (with-acc-tag (apply clojure.set/union vs)))
   1.125 +
   1.126 +(defmethod add (class empty-set)
   1.127 +  [v e]
   1.128 +  (with-acc-tag (conj v e)))
   1.129 +
   1.130 +;
   1.131 +; String accumulator
   1.132 +;
   1.133 +(defvar empty-string ""
   1.134 +  "An empty string accumulator. Adding an item (string or character)
   1.135 +   appends it at the end.")
   1.136 +
   1.137 +(defmethod combine java.lang.String
   1.138 +  [& vs]
   1.139 +  (apply str vs))
   1.140 +
   1.141 +(defmethod add java.lang.String
   1.142 +  [v e]
   1.143 +  (str v e))
   1.144 +
   1.145 +;
   1.146 +; Map accumulator
   1.147 +;
   1.148 +(defvar empty-map (with-acc-tag {})
   1.149 +  "An empty map accumulator. Items to be added must be [key value] pairs.")
   1.150 +
   1.151 +(defmethod combine clojure.lang.IPersistentMap
   1.152 +  [& vs]
   1.153 +  (with-acc-tag (apply merge vs)))
   1.154 +
   1.155 +(defmethod add clojure.lang.IPersistentMap
   1.156 +  [v e]
   1.157 +  (with-acc-tag (conj v e)))
   1.158 +
   1.159 +;
   1.160 +; Numerical accumulators: sum, product, minimum, maximum
   1.161 +;
   1.162 +(defmacro- defacc
   1.163 +  [name op empty doc-string]
   1.164 +  (let [type-tag (keyword (str *ns*) (str name))
   1.165 +	empty-symbol (symbol (str "empty-" name))]
   1.166 +  `(let [op# ~op]
   1.167 +     (deftype ~type-tag ~name
   1.168 +       (fn [~'x] {:value ~'x})
   1.169 +       (fn [~'x] (list (:value ~'x))))
   1.170 +     (derive ~type-tag ::accumulator)
   1.171 +     (defvar ~empty-symbol (~name ~empty) ~doc-string)
   1.172 +     (defmethod combine ~type-tag [& vs#]
   1.173 +       (~name (apply op# (map :value vs#))))
   1.174 +     (defmethod add ~type-tag [v# e#]
   1.175 +       (~name (op# (:value v#) e#))))))
   1.176 +
   1.177 +(defacc sum + 0
   1.178 +  "An empty sum accumulator. Only numbers can be added.")
   1.179 +
   1.180 +(defacc product * 1
   1.181 +  "An empty sum accumulator. Only numbers can be added.")
   1.182 +
   1.183 +; The empty maximum accumulator should have value -infinity.
   1.184 +; This is represented by nil and taken into account in an
   1.185 +; adapted max function. In the minimum accumulator, nil is
   1.186 +; similarly used to represent +infinity.
   1.187 +
   1.188 +(defacc maximum (fn [& xs]
   1.189 +		  (when-let [xs (seq (filter identity xs))]
   1.190 +		      (apply max xs)))
   1.191 +                nil
   1.192 +  "An empty maximum accumulator. Only numbers can be added.")
   1.193 +
   1.194 +(defacc minimum (fn [& xs]
   1.195 +		  (when-let [xs (seq (filter identity xs))]
   1.196 +		      (apply min xs)))
   1.197 +                nil
   1.198 +  "An empty minimum accumulator. Only numbers can be added.")
   1.199 +
   1.200 +;
   1.201 +; Numeric min-max accumulator
   1.202 +; (combination of minimum and maximum)
   1.203 +;
   1.204 +(deftype ::min-max min-max
   1.205 +  (fn [min max] {:min min :max max})
   1.206 +  (fn [mm] (list (:min mm) (:max mm))))
   1.207 +
   1.208 +(derive ::min-max ::accumulator)
   1.209 +
   1.210 +(defvar empty-min-max (min-max nil nil)
   1.211 +  "An empty min-max accumulator, combining minimum and maximum.
   1.212 +   Only numbers can be added.")
   1.213 +
   1.214 +(defmethod combine ::min-max
   1.215 +  [& vs]
   1.216 +  (let [total-min (apply min (map :min vs))
   1.217 +	total-max (apply max (map :max vs))]
   1.218 +    (min-max total-min total-max)))
   1.219 +
   1.220 +(defmethod add ::min-max
   1.221 +  [v e]
   1.222 +  (let [min-v (:min v)
   1.223 +	max-v (:max v)
   1.224 +	new-min (if (nil? min-v) e (min min-v e))
   1.225 +	new-max (if (nil? max-v) e (max max-v e))]
   1.226 +    (min-max new-min new-max)))
   1.227 +
   1.228 +;
   1.229 +; Mean and variance accumulator
   1.230 +;
   1.231 +(deftype ::mean-variance mean-variance)
   1.232 +
   1.233 +(derive ::mean-variance ::accumulator)
   1.234 +
   1.235 +(defvar empty-mean-variance (mean-variance {:n 0 :mean 0 :variance 0})
   1.236 +  "An empty mean-variance accumulator, combining sample mean and
   1.237 +   sample variance. Only numbers can be added.")
   1.238 +
   1.239 +(defmethod combine ::mean-variance
   1.240 +  ([mv]
   1.241 +   mv)
   1.242 +
   1.243 +  ([mv1 mv2]
   1.244 +   (let [{n1 :n mean1 :mean var1 :variance} mv1
   1.245 +	 {n2 :n mean2 :mean var2 :variance} mv2
   1.246 +	 n (+ n1 n2)
   1.247 +	 mean (/ (+ (* n1 mean1) (* n2 mean2)) n)
   1.248 +	 sq #(* % %)
   1.249 +	 c    (+ (* n1 (sq (- mean mean1))) (* n2 (sq (- mean mean2))))
   1.250 +	 var  (if (< n 2)
   1.251 +		0
   1.252 +		(/ (+ c (* (dec n1) var1) (* (dec n2) var2)) (dec n)))]
   1.253 +     (mean-variance {:n n :mean mean :variance var})))
   1.254 +   
   1.255 +  ([mv1 mv2 & mvs]
   1.256 +   (reduce combine (combine mv1 mv2) mvs)))
   1.257 +
   1.258 +(defmethod add ::mean-variance
   1.259 +  [mv x]
   1.260 +  (let [{n :n mean :mean var :variance} mv
   1.261 +	n1 (inc n)
   1.262 +	d (- x mean)
   1.263 +	new-mean (+ mean (/ d n1))
   1.264 +	new-var (if (zero? n) 0 (/ (+ (* (dec n) var) (* d (- x new-mean))) n))]
   1.265 +    (mean-variance {:n n1 :mean new-mean :variance new-var})))
   1.266 +
   1.267 +;
   1.268 +; Counter accumulator
   1.269 +;
   1.270 +(deftype ::counter counter)
   1.271 +
   1.272 +(derive ::counter ::accumulator)
   1.273 +
   1.274 +(defvar empty-counter (counter {})
   1.275 +  "An empty counter accumulator. Its value is a map that stores for
   1.276 +   every item the number of times it was added.")
   1.277 +
   1.278 +(defmethod combine ::counter
   1.279 +  [v & vs]
   1.280 +  (letfn [(add-item [cntr [item n]]
   1.281 +		    (assoc cntr item (+ n (get cntr item 0))))
   1.282 +	  (add-two [c1 c2] (reduce add-item c1 c2))]
   1.283 +	 (reduce add-two v vs)))
   1.284 +
   1.285 +(defmethod add ::counter
   1.286 +  [v e]
   1.287 +  (assoc v e (inc (get v e 0))))
   1.288 +
   1.289 +;
   1.290 +; Counter accumulator with total count
   1.291 +;
   1.292 +(deftype ::counter-with-total counter-with-total)
   1.293 +(derive ::counter-with-total ::counter)
   1.294 +
   1.295 +(defvar empty-counter-with-total
   1.296 +  (counter-with-total {:total 0})
   1.297 +  "An empty counter-with-total accumulator. It works like the counter
   1.298 +   accumulator, except that the total number of items added is stored as the
   1.299 +   value of the key :total.")
   1.300 +
   1.301 +(defmethod add ::counter-with-total
   1.302 +  [v e]
   1.303 +  (assoc v e (inc (get v e 0))
   1.304 +	 :total (inc (:total v))))
   1.305 +
   1.306 +;
   1.307 +; Accumulator n-tuple
   1.308 +;
   1.309 +(deftype ::tuple acc-tuple)
   1.310 +
   1.311 +(derive ::tuple ::accumulator)
   1.312 +
   1.313 +(defn empty-tuple
   1.314 +  "Returns an accumulator tuple with the supplied empty-accumulators
   1.315 +   as its value. Accumulator tuples consist of several accumulators that
   1.316 +   work in parallel. Added items must be sequences whose number of elements
   1.317 +   matches the number of sub-accumulators."
   1.318 +  [empty-accumulators]
   1.319 +  (acc-tuple (into [] empty-accumulators)))
   1.320 +
   1.321 +(defmethod combine ::tuple
   1.322 +  [& vs]
   1.323 +  (acc-tuple (vec (map combine vs))))
   1.324 +
   1.325 +(defmethod add ::tuple
   1.326 +  [v e]
   1.327 +  (acc-tuple (vec (map add v e))))