Skip to content
Fetching contributors…
Cannot retrieve contributors at this time
325 lines (264 sloc) 8.62 KB
;; Accumulators
;; by Konrad Hinsen
;; last updated May 19, 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 (
;; 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.
^{:author "Konrad Hinsen"
:doc "A generic accumulator interface and implementations of various
(:refer-clojure :exclude (deftype))
(:use [clojure.contrib.types :only (deftype)])
(:use [clojure.contrib.def :only (defvar defvar- defmacro-)])
(:require [clojure.contrib.generic.arithmetic :as ga]))
(defmulti add
"Add item to the accumulator acc. The exact meaning of adding an
an item depends on the type of the accumulator."
{:arglists '([acc item])}
(fn [acc item] (type acc)))
(defn add-items
"Add all elements of a collection coll to the accumulator acc."
[acc items]
(reduce add acc items))
(defmulti combine
"Combine the values of the accumulators acc1 and acc2 into a
single accumulator of the same type."
{:arglists '([& accs])}
(fn [& accs] (type (first accs))))
; An ::accumulator type tag is attached to tbe built-in types
; when used as accumulators, and new types are derived from it.
; Multimethods add and combine for ::accumulator sub-dispatch on class.
; We also define generic addition as the combine operation.
(let [meta-map {:type ::accumulator}]
(defn- with-acc-tag
(with-meta x meta-map)))
(defmethod add ::accumulator
[a e]
((get-method add (class a)) a e))
(defmethod combine ::accumulator
[& as]
(apply (get-method combine (class (first as))) as))
(defmethod ga/+ ::accumulator
[x y]
(combine x y))
; Vector accumulator
(defvar empty-vector (with-acc-tag [])
"An empty vector accumulator. Adding an item appends it at the end.")
(defmethod combine clojure.lang.IPersistentVector
[& vs]
(with-acc-tag (vec (apply concat vs))))
(defmethod add clojure.lang.IPersistentVector
[v e]
(with-acc-tag (conj v e)))
; List accumulator
(defvar empty-list (with-acc-tag '())
"An empty list accumulator. Adding an item appends it at the beginning.")
(defmethod combine clojure.lang.IPersistentList
[& vs]
(with-acc-tag (apply concat vs)))
(defmethod add clojure.lang.IPersistentList
[v e]
(with-acc-tag (conj v e)))
; Queue accumulator
(defvar empty-queue (with-acc-tag clojure.lang.PersistentQueue/EMPTY)
"An empty queue accumulator. Adding an item appends it at the end.")
(defmethod combine clojure.lang.PersistentQueue
[& vs]
(add-items (first vs) (apply concat (rest vs))))
(defmethod add clojure.lang.PersistentQueue
[v e]
(with-acc-tag (conj v e)))
; Set accumulator
(defvar empty-set (with-acc-tag #{})
"An empty set accumulator.")
(defmethod combine (class empty-set)
[& vs]
(with-acc-tag (apply clojure.set/union vs)))
(defmethod add (class empty-set)
[v e]
(with-acc-tag (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 (with-acc-tag {})
"An empty map accumulator. Items to be added must be [key value] pairs.")
(defmethod combine clojure.lang.IPersistentMap
[& vs]
(with-acc-tag (apply merge vs)))
(defmethod add clojure.lang.IPersistentMap
[v e]
(with-acc-tag (conj v e)))
; Numerical accumulators: sum, product, minimum, maximum
(defmacro- defacc
[name op empty doc-string]
(let [type-tag (keyword (str *ns*) (str name))
empty-symbol (symbol (str "empty-" name))]
`(let [op# ~op]
(deftype ~type-tag ~name
(fn [~'x] {:value ~'x})
(fn [~'x] (list (:value ~'x))))
(derive ~type-tag ::accumulator)
(defvar ~empty-symbol (~name ~empty) ~doc-string)
(defmethod combine ~type-tag [& vs#]
(~name (apply op# (map :value vs#))))
(defmethod add ~type-tag [v# e#]
(~name (op# (:value v#) e#))))))
(defacc sum + 0
"An empty sum accumulator. Only numbers can be added.")
(defacc product * 1
"An empty sum accumulator. Only numbers can be added.")
; The empty maximum accumulator should have value -infinity.
; This is represented by nil and taken into account in an
; adapted max function. In the minimum accumulator, nil is
; similarly used to represent +infinity.
(defacc maximum (fn [& xs]
(when-let [xs (seq (filter identity xs))]
(apply max xs)))
"An empty maximum accumulator. Only numbers can be added.")
(defacc minimum (fn [& xs]
(when-let [xs (seq (filter identity xs))]
(apply min xs)))
"An empty minimum accumulator. Only numbers can be added.")
; Numeric min-max accumulator
; (combination of minimum and maximum)
(deftype ::min-max min-max
(fn [min max] {:min min :max max})
(fn [mm] (list (:min mm) (:max mm))))
(derive ::min-max ::accumulator)
(defvar empty-min-max (min-max nil nil)
"An empty min-max accumulator, combining minimum and maximum.
Only numbers can be added.")
(defmethod combine ::min-max
[& vs]
(let [total-min (apply min (map :min vs))
total-max (apply max (map :max vs))]
(min-max total-min total-max)))
(defmethod add ::min-max
[v e]
(let [min-v (:min v)
max-v (:max v)
new-min (if (nil? min-v) e (min min-v e))
new-max (if (nil? max-v) e (max max-v e))]
(min-max new-min new-max)))
; Mean and variance accumulator
(deftype ::mean-variance mean-variance)
(derive ::mean-variance ::accumulator)
(defvar empty-mean-variance (mean-variance {:n 0 :mean 0 :variance 0})
"An empty mean-variance accumulator, combining sample mean and
sample variance. Only numbers can be added.")
(defmethod combine ::mean-variance
([mv1 mv2]
(let [{n1 :n mean1 :mean var1 :variance} mv1
{n2 :n mean2 :mean var2 :variance} mv2
n (+ n1 n2)
mean (/ (+ (* n1 mean1) (* n2 mean2)) n)
sq #(* % %)
c (+ (* n1 (sq (- mean mean1))) (* n2 (sq (- mean mean2))))
var (if (< n 2)
(/ (+ c (* (dec n1) var1) (* (dec n2) var2)) (dec n)))]
(mean-variance {:n n :mean mean :variance var})))
([mv1 mv2 & mvs]
(reduce combine (combine mv1 mv2) mvs)))
(defmethod add ::mean-variance
[mv x]
(let [{n :n mean :mean var :variance} mv
n1 (inc n)
d (- x mean)
new-mean (+ mean (/ d n1))
new-var (if (zero? n) 0 (/ (+ (* (dec n) var) (* d (- x new-mean))) n))]
(mean-variance {:n n1 :mean new-mean :variance new-var})))
; Counter accumulator
(deftype ::counter counter)
(derive ::counter ::accumulator)
(defvar empty-counter (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 [cntr [item n]]
(assoc cntr item (+ n (get cntr 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
(deftype ::counter-with-total counter-with-total)
(derive ::counter-with-total ::counter)
(defvar empty-counter-with-total
(counter-with-total {:total 0})
"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 :total.")
(defmethod add ::counter-with-total
[v e]
(assoc v e (inc (get v e 0))
:total (inc (:total v))))
; Accumulator n-tuple
(deftype ::tuple acc-tuple)
(derive ::tuple ::accumulator)
(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."
(acc-tuple (into [] empty-accumulators)))
(defmethod combine ::tuple
[& vs]
(acc-tuple (vec (map combine vs))))
(defmethod add ::tuple
[v e]
(acc-tuple (vec (map add v e))))
Something went wrong with that request. Please try again.