Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

325 lines (264 sloc) 8.832 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 (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
#^{:author "Konrad Hinsen"
:doc "A generic accumulator interface and implementations of various
accumulators."}
clojure.contrib.accumulators
(: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
[x]
(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)))
nil
"An empty maximum accumulator. Only numbers can be added.")
(defacc minimum (fn [& xs]
(when-let [xs (seq (filter identity xs))]
(apply min xs)))
nil
"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
([mv]
mv)
([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)
0
(/ (+ 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."
[empty-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))))
Jump to Line
Something went wrong with that request. Please try again.