Single-pass histogram

histogram.clj

(ns histogram
  (:use
    [clojure.contrib.math :only [abs]]
    [clojure.contrib.priority-map]))

(defn- bin-weight [bin]
  (* (double (first bin)) (double (second bin))))

(defn- combine-bins [prev-bin next-bin]
  (let [first-weight (bin-weight prev-bin)
        second-weight (bin-weight next-bin)
        total-count (+ (int (second prev-bin)) (int (second next-bin)))
        new-point (/ (+ first-weight second-weight) total-count)]
    [new-point total-count]))

(defn- insert-gap [gaps prev-point next-point]
  (if (and prev-point next-point)
    (let [diff (- (double next-point) (double prev-point))]
      (assoc gaps prev-point diff))
    gaps))

(defn- insert-gaps [gaps prev-point point next-point]
  (insert-gap (insert-gap gaps point next-point) prev-point point))

(defn- merge-bins [maps]
  (let [hist (:hist maps)
        gaps (:gaps maps)
        min-gap-point (first (peek gaps))
        prev-point (first (first (rsubseq hist < min-gap-point)))
        next-point (first (first (subseq hist > min-gap-point)))
        second-point (first (second (subseq hist > min-gap-point)))
        new-bin (combine-bins (find hist min-gap-point) (find hist next-point))
        new-point (first new-bin)
        new-hist (conj (dissoc hist min-gap-point next-point) new-bin)
        new-gaps (insert-gaps 
                   (pop (dissoc gaps next-point))
                   prev-point 
                   new-point 
                   second-point)]
    {:hist new-hist :gaps new-gaps}))

(defn- insert [maps init-point]
  (let [hist (:hist maps)
        gaps (:gaps maps)
        point (double init-point)]
    (if point
      (if (contains? hist point)
        {:hist (assoc hist point (inc (hist point 0))) :gaps gaps}
        (let [prev-point (first (first (rsubseq hist < point)))
              next-point (first (first (subseq hist > point)))
              new-maps {:hist (assoc hist point 1) 
                        :gaps (insert-gaps gaps prev-point point next-point)}]
          (if (> (:bins (meta hist)) (count hist))
            new-maps
            (merge-bins new-maps))))
      maps)))

(defn create-hist [points hist-size]
  (let [maps {:hist (with-meta (sorted-map) {:bins hist-size})
              :gaps (priority-map)}]
    (:hist (reduce insert maps points))))