com.keminglabs/c2

0.2.3-SNAPSHOT


Declarative data visualization in Clojure(Script).

dependencies

org.clojure/clojure
1.4.0
org.clojure/core.match
0.2.0-alpha12
clj-iterate
0.96
com.keminglabs/singult
0.1.6
com.keminglabs/reflex
0.1.1



(this space intentionally left almost blank)

namespaces

 

c2.core

toc
(ns c2.core
  (:use [clojure.string :only [join]]))

Map data to hiccup vectors via provided mapping function.

(defn unify
  ([data mapping]
     (map mapping data))
  ([container data mapping]
      (into container (unify data mapping))))
 

c2.util

toc
(ns c2.util
  (:use [reflex.macros :only [computed-observable]]))

Print and return native JavaScript argument.

(defmacro p
  [x]
  `(let [res# ~x]
     (.log js/console res#)
     res#))

Pretty print and return argument (uses prn-str internally).

(defmacro pp
  [x]
  `(let [res# ~x]
     (.log js/console (prn-str res#))
     res#))

Profile body and print descr. Returns result of body.

(defmacro profile
  [descr & body]
  `(let [start# (.getTime (js/Date.))
         ret# (do ~@body)]
    (print (str ~descr ": " (- (.getTime (js/Date.)) start#) " msecs"))
    ret#))
(defmacro timeout [delay & body]
  `(js/setTimeout (fn [] ~@body) ~delay))
(defmacro interval [delay & body]
  `(js/setInterval (fn [] ~@body) ~delay))

Define record and corresponding constructor that accepts keyword arguments. The constructor function is defined to be the given name, with the record having an underscore prefix.

(defmacro c2-obj
  [name fields-with-defaults & body]
  (let [recname (symbol (str "_" (clojure.core/name name)))]
    `(do
       (defrecord ~recname ~(into [] (map (comp symbol clojure.core/name)
                                          (keys fields-with-defaults)))
         ~@body)
       (defn ~name [& ~'kwargs]
         (~(symbol (str "map->" (clojure.core/name recname)))
          (merge ~fields-with-defaults (apply hash-map ~'kwargs)))))))

Element-by-element operations between sequences. Used by c2.maths for vector arithmetic. Modified from Incanter.

(defmacro combine-with
  [A B op fun]
  `(cond
    (and (number? ~A) (number? ~B)) (~op ~A ~B)
    (and (coll? ~A) (coll? ~B)) (map ~op ~A ~B)
    (and (number? ~A) (coll? ~B)) (map ~op (replicate (count ~B) ~A)  ~B)
    (and (coll? ~A) (number? ~B)) (map ~op ~A (replicate (count ~A) ~B))))

Merges hiccup-el onto el (selector or live node). Recalculates hiccup-el and updates DOM whenever any of the atoms dereferenced within hiccup-el changes state. Returns computed observable of hiccup element.

(defmacro bind!
  [el hiccup-el]
  `(let [co# (computed-observable ~hiccup-el)
         $el# (c2.dom/->dom ~el)]
     (singult.core/merge! $el# @co#)
     (add-watch co# :update-dom #(singult.core/merge! $el# @co#))
    co#))

Detaches el from DOM, runs macro body, reattaches el to its old parent and returns el.

(defmacro with-detached
  [el & body]
  `(let [$el# (c2.dom/->dom ~el)
         $parent# (c2.dom/parent $el#)]
     (dom/remove! $el#)
     ~@body
     (dom/append! $parent# $el#)
     $el#))
 

c2.core

toc

Core functions that map data to DOM elements.

(ns c2.core
  (:use-macros [c2.util :only [p pp]])
  (:require [singult.core :as singult]
            ;;These namespaces required here so they're sucked into deps calculation.
            ;;(Some macros expand with calls to fns in these namespaces)
            [c2.dom :as dom]
            [reflex.core :as reflex]))
(def node-data singult/node-data)
(defn unify [data mapping & args]
  ;;Execute the mapping on the first datum so that atoms within the mapping fn will be derefed.
  ;;This should eliminate confusion wherin c2.util#bind! doesn't pick up on dependencies within the unify mapping fn (because the mapping fn isn't executed until rendering, which happens after computed-observable dependencies are calculated).
  (when (seq data)
    (mapping (first data)))
  (apply singult/unify data mapping args))
 

c2.dom

toc
(ns c2.dom
  (:refer-clojure :exclude [val])
  (:use-macros [c2.util :only [p pp timeout bind!]]
               [clojure.core.match.js :only [match]])
  (:require [clojure.string :as string]
            [singult.core :as singult]
            [goog.dom :as gdom]
            [goog.dom.forms :as gforms]
            [goog.dom.classes :as gclasses]
            [goog.style :as gstyle]))

Going down a terrible, terrible road here...

(js* "Element.prototype.matchesSelector = Element.prototype.webkitMatchesSelector || Element.prototype.mozMatchesSelector || Element.prototype.msMatchesSelector || Element.prototype.oMatchesSelector")

Seq over native JavaScript node collections

(when (js* "typeof NodeList != \"undefined\"")
  (extend-type js/NodeList
    ISeqable
    (-seq [array] (array-seq array 0))))
(extend-type js/HTMLCollection
  ISeqable
  (-seq [array] (array-seq array 0)))
(declare select)
(defprotocol IDom
  (->dom [x] "Converts x to a live DOM node"))
(extend-protocol IDom
  string
  (->dom [selector] (select selector))

  PersistentVector
  (->dom [v] (singult/render v)))
(when (js* "typeof Node != \"undefined\"")
  (extend-type js/Node
    IDom
    (->dom [node] node)))

Select a single DOM node via CSS selector, optionally scoped by second arg.

Like select, but returns a collection of nodes.

(defn select
  ([selector] (.querySelector js/document selector))
  ([selector container] (.querySelector (->dom container) selector)))
(defn select-all
  ([selector] (.querySelectorAll js/document selector))
  ([selector container] (.querySelectorAll (->dom container) selector)))

Does live node match CSS selector?

(defn matches-selector?
  [node selector]
  (.matchesSelector node selector))

Return the children of a live DOM element.

(defn children
  [node]
  (.-children (->dom node)))

Return parent of a live DOM node.

(defn parent
  [node]
  (.-parentNode (->dom node)))

Make element last child of container. Returns live child.

(defn append!
  [container el]
  (let [el (->dom el)]
    (gdom/appendChild (->dom container) el)
    el))

Make element first child of container. Returns live DOM child.

(defn prepend!
  [container el]
  (let [el (->dom el)]
    (gdom/insertChildAt (->dom container) el 0)
    el))

Remove element from DOM and return it.

el CSS selector or live DOM node

(defn remove!
  [el]
  (gdom/removeNode (->dom el)))

Replace live DOM node with a new one, returning the latter.

old CSS selector or live DOM node new CSS selector, live DOM node, or hiccup vector

(defn replace!
  [old new]
  (let [new (->dom new)]
    (gdom/replaceNode new (->dom old))
    new))

Get or set inline element style.

(style el) map of inline element styles

(style el :keyword) value of style :keyword

(style el {:keyword val}) sets inline style according to map, returns element

(style el :keyword val) sets single style, returns element

(defn style
  ([el] (throw (js/Error. "TODO: return map of element styles")))
  ([el x]
     (let [el (->dom el)]
       (match [x]
              [(k :guard keyword?)] (gstyle/getComputedStyle el (name k))
              [(m :guard map?)]
              (do
                (doseq [[k v] m] (style el k v))
                el))))
  ([el k v]
     (gstyle/setStyle (->dom el) (name k)
                      (match [v]
                             [s :guard string?] s
                             [n :guard number?]
                             (if (#{:height :width :top :left :bottom :right} (keyword k))
                               (str n "px")
                               n)))
     el))

Get or set element attributes.

(attr el) map of element attributes

(attr el :keyword) value of attr :keyword

(attr el {:keyword val}) sets element attributes according to map, returns element

(attr el :keyword val) sets single attr, returns element

(defn attr
  ([el] (let [attrs (.-attributes (->dom el))]
          (into {} (for [i (range (.-length attrs))]
                     [(keyword  (.-name (aget attrs i)))
                      (.-value (aget attrs i))]))))
  ([el x]
     (let [el (->dom el)]
       (match [x]
              [(k :guard keyword?)] (.getAttribute el (name k))
              [(m :guard map?)]
              (do (doseq [[k v] m] (attr el k v))
                  el))))
  ([el k v]
     (let [el (->dom el)]
       (if (nil? v)
         (.removeAttribute el (name k))
         (if (= :style k)
           (style el v)
           (.setAttribute el (name k) v)))
       el)))

Get or set element text, returning element

(defn text
  ([el]
     (gdom/getTextContent (->dom el)))
  ([el v]
     (let [el (->dom el)]
       (gdom/setTextContent el v)
       el)))

Get or set element value.

(defn val
  ([el]
     (gforms/getValue (->dom el)))
  ([el v]
     (let [el (->dom el)]
       (gforms/setValue el v)
       el)))

Add or remove class to element based on boolean classed?, returning element.

(defn classed!
  [el class classed?]
  (gclasses/enable (->dom el) (name class) classed?)
  el)

TODO: make these kind of shortcuts macros for better performance.

(defn add-class! [el class] (classed! el class true))
(defn remove-class! [el class] (classed! el class false))

Call this fn with a fn that should be executed on the next browser animation frame.

(def request-animation-frame
  (or (.-requestAnimationFrame js/window)
      (.-webkitRequestAnimationFrame js/window)
      #(timeout 10 (%))))
 

c2.event

toc
(ns c2.event
  (:use [cljs.reader :only [read-string]]
        [c2.core :only [node-data]])
  (:require [c2.dom :as dom]
            [goog.events :as gevents]))

Execute fn when browser load event fires.

(defn on-load
  [f]
  (.listen goog.events js/window goog.events.EventType.LOAD f))

Attach event-type handler f to node, a CSS selector or live DOM node. Event type is something like :click or :mousemove. Optional :capture boolean kwarg to fire listener in capture phase (default false).

(defn on-raw
  [node event-type f
   & {:keys [capture]
      :or {capture false}}]
  (gevents/listen (dom/->dom node) (name event-type) f capture))

Attach delegate event-type event handler f to node whose children were created via c2.core/unify!, scoped by optional selector. Handler is called with datum, $node, and the event object. Optional :capture boolean kwarg to fire listener in capture phase (default false).

Example usage:

   (unify! "#scatterplot" data-set (fn [[x y]] [:circle {:cx x :cy y}]))
   (on "#scatterplot" :click (fn [d] (p (str "circle clicked:" (prn-str d)))))

This method should be preferred over attaching event handlers to individual nodes created by a unify! call because it creates a single event handler on the parent instead of a handler on each child.

(defn on
  ([node event-type f] (on node "*" event-type f))
  ([node selector event-type f
    & {:keys [capture]
       :or {capture false}}]
     (gevents/listen (dom/->dom node)
                     (name event-type)
                     (fn [event]
                       ;;Check to see if the target is what we want to listen to.
                       ;;This could be, say, a data-less button that is a child of a node with c2 data.
                       (if (dom/matches-selector? (.-target event) selector)
                         ;;Loop through the parent nodes of the event origin node, event.target, until we reach one with c2 data attached.
                         (loop [$node (.-target event)]
                           (if-let [d (node-data $node)]
                             ;;Then, call the handler on this node
                             (f d $node event)
                             (if-let [parent (dom/parent $node)]
                               (recur parent))))))
                     capture)))
 

c2.util

toc
(ns c2.util
  (:require [singult.core :as singult]))

Convert something into a collection, if it's not already.

(defn ->coll
  [x]
  (if (coll? x) x [x]))
 

c2.geo.core

toc
^:clj (ns c2.geo.core
        (:use [c2.maths :only [rad sq sqrt sin asin cos radians-per-degree]]
              [clojure.core.match :only [match]]
              [clojure.string :only [join]]))
^:cljs (ns c2.geo.core
         (:refer-clojure :exclude [map])
         (:use-macros [clojure.core.match.js :only [match]])
         (:use [c2.maths :only [rad sq sqrt sin asin cos radians-per-degree]]))

Use JS native map and join fns; this is about 3 times faster than using CLJS seqs and str.

^:cljs (do
         (defn ->arr [c]
           (if (= js/Array (type c))
             c
             (into-array c)))
         (defn join
           ([c] (join  c))
           ([sep c] (.join (->arr c) sep)))
         (defn map [f c] (.map (->arr c) f)))

Convert geoJSON to SVG path data.

Kwargs:

:projection fn applied to each coordinate, defaults to identity

(defn geo->svg
  [geo & {:keys [projection]
          :or {projection identity}}]
  (let [project (fn [coordinate]
                  (join "," (projection coordinate)))
        coords->path (fn [coordinates]
                       (str "M"
                            (join "L" (map project coordinates))
                            "Z"))]
    ;;See http://geojson.org/geojson-spec.html
    ;;This SVG rendering doesn't implement the full spec.
    (match [geo]
           [{:type "FeatureCollection" :features xs}]
           (join (map #(geo->svg % :projection projection) xs))
           [{:type "Feature" :geometry g}] (geo->svg g :projection projection)
           [{:type "Polygon" :coordinates xs}]
           (join (map coords->path xs))
           [{:type "MultiPolygon" :coordinates xs}]
           ;;It'd be nice to recurse to the actual branch that handles Polygon, instead of repeating...
           (join (map (fn [subpoly]
                        (join (map coords->path subpoly)))
                      xs)))))

Convert coordinates (potentially map of {:lat :lon}) to 2-vector.

(defn ->latlon
  [coordinates]
  (match [coordinates]
         [[lat lon]] [lat lon]
         [{:lat lat :lon lon}] [lat lon]))

Radius of OUR AWESOME PLANET, in kilometers

(def radius-of-earth
  6378.1)

Calculate the great-circle distance between two lat/lon coordinates on a sphere with radius r (defaults to Earth radius).

(defn haversine
  ([co1 co2] (haversine co1 co2 radius-of-earth))
  ([co1 co2 r]
     (let [[lat1 lon1] (->latlon co1)
           [lat2 lon2] (->latlon co2)
           square-half-chord (+ (sq (sin (/ (rad (- lat2 lat1)) 2)))
                                (* (cos (rad lat1))
                                   (cos (rad lat2))
                                   (sq (sin (/ (rad (- lon2 lon1)) 2)))))
           angular-distance (* (asin (sqrt square-half-chord)) 2)]
       (* angular-distance r))))
 

c2.geo.geom

toc
^:clj (ns c2.geo.geom
        (:use [clojure.core.match :only [match]]
              [clojure.string :only [join]]
              [c2.maths :only [abs add sub div mul]])
        (:require c2.geom.polygon))
^:cljs (ns c2.geo.geom
         (:use-macros [clojure.core.match.js :only [match]])
         (:use [c2.maths :only [abs add sub div mul]])
         (:require [c2.geom.polygon :as c2.geom.polygon]))

Calculate the area of a geoJSON feature.

Kwargs:

:projection fn applied to each coordinate, defaults to identity. If your input coordinates are lat/lon, you probably want this to be (albers :scale radius-of-earth) since albers is an area-preserving projection.

(defn area
  [geo & {:keys [projection]
          :or {projection identity}}]
  (let [polygon-area (fn [poly-coordinates]
                       (let [area (fn [coordinates]
                                    (abs (c2.geom.polygon/area (map projection coordinates))))]
                         ;;area of exterior boundary - interior holes
                         (apply - (area (first poly-coordinates))
                                (map area (rest poly-coordinates)))))]
    (abs (match [geo]
                [{:type "FeatureCollection" :features xs}]
                (apply + (map area xs))
                [{:type "Feature" :geometry g}]
                (area g)
                [{:type "Polygon" :coordinates xs}]
                (polygon-area xs)
                [{:type "MultiPolygon" :coordinates xs}]
                (apply + (map polygon-area xs))))))

Calculate the centroid coordinates of a geoJSON feature.

Kwargs:

:projection fn applied to each coordinate, defaults to identity.

(defn centroid
  [geo & {:keys [projection]
                       :or {projection identity}}]
  (let [polygon-centroid (fn [poly-coordinates]
                           ;;Compute polygon centroid by geometric decomposition.
                           ;;http://en.wikipedia.org/wiki/Centroid#By_geometric_decomposition
                           (let [areas (map (fn [coordinates]
                                              (abs (c2.geom.polygon/area (map projection coordinates))))
                                            poly-coordinates)]
                             ;;Return hashmap containing the area so weighted centroid can be calculated for MultiPolygons.
                             {:centroid (div (apply sub (map (fn [coordinates area]
                                                               (mul (c2.geom.polygon/centroid coordinates)
                                                                    area))
                                                             poly-coordinates areas))
                                             (apply - areas))
                              :area (apply + areas)}))]
    (match [geo]
           [{:type "Feature" :geometry g}]
           (centroid g)
           [{:type "Polygon" :coordinates xs}]
           (:centroid (polygon-centroid xs))
           [{:type "MultiPolygon" :coordinates xs}]
           (let [centroids (map polygon-centroid xs)]
             (div (apply add (map (fn [{:keys [centroid area]}]
                                    (mul centroid area))
                                  centroids))
                  (apply add (map :area centroids)))))))
 

c2.geo.projection

toc
^:clj (ns c2.geo.projection
        (:use [c2.maths :only [radians-per-degree
                               sin cos sqrt]]
              [c2.util :only [c2-obj]]))
^:cljs (ns c2.geo.projection
         (:use-macros [c2.util :only [c2-obj]])
         (:use [c2.maths :only [radians-per-degree
                                sin cos sqrt]]))

The Albers equal-area conic projection

(c2-obj albers
        {:origin [-98 38]
         :parallels [29.5, 45.5]
         :scale 1000
         :translate [480 250]}

        clojure.lang.IFn
        (invoke [this coordinates]
                (let [[lon lat] coordinates
                      phi1 (* radians-per-degree (first parallels))
                      phi2 (* radians-per-degree (second parallels))
                      lng0 (* radians-per-degree (first origin))
                      lat0 (* radians-per-degree (second origin))

                      s (sin phi1), c (cos phi1)
                      n (* 0.5 (+ s (sin phi2)))
                      C (+ (* c c) (* 2 n s))
                      p0 (/ (sqrt (- C (* 2 n (sin lat0)))) n)

                      t (* n (- (* radians-per-degree lon)
                                lng0))
                      p (/ (sqrt (- C (* 2 n (sin (* radians-per-degree lat)))))
                           n)]
                  [(+ (* scale p (sin t)) (first translate))
                   (+ (* scale (- (* p (cos t)) p0)) ;;Note that we've negated the p0 - p*cos(t) term so the projection is into a coordinate system where positive y is downward.
                      (second translate))])))

Albers projection with Alaska, Hawaii, and Puerto Rico scaled and translated to fit nicely with each other

(c2-obj albers-usa
        {:origin [-98 38]
         :parallels [29.5, 45.5]
         :scale 1000
         :translate [480 250]}
        
        clojure.lang.IFn
        (invoke [_ coordinates]
                (let [[lon lat] coordinates
                      lower48 (albers :origin origin
                                      :parallels parallels
                                      :scale scale
                                      :translate translate)
                      [dx dy] translate
                      dz      (/ (:scale lower48) 1000)
                      alaska  (assoc lower48
                                :origin [-160 60]
                                :parallels [55 65]
                                :scale (* 0.6 (:scale lower48))
                                :translate [(- dx (* dz 400))
                                            (+ dy (* dz 170))])
                      hawaii (assoc lower48
                               :origin [-160 20]
                               :parallels [8 18]
                               :translate [(- dx (* dz 190))
                                           (+ dy (* dz 200))])
                      puerto-rico (assoc lower48
                                    :origin [-60 10]
                                    :parallels [8 18]
                                    :scale (* 1.5 (:scale lower48))
                                    :translate [(+ dx (* dz 580))
                                                (+ dy (* dz 430))])]

                  ((cond (and (> lat 50) (< lon -127)) alaska
                         (< lon -140) hawaii
                         (< lat 21) puerto-rico
                         :else lower48)
                   [lon lat]))))
 

c2.geom.polygon

toc
(ns c2.geom.polygon
  (:use [c2.maths :only [add div]]))

Closes a collection of coordinates by adding the first coordinate to the end

(defn close-coordinates
  [coordinates]
  (concat coordinates
          [(first coordinates)]))

Calculate area from list of counterclockwise coordinates, ref Wikipedia

(defn area
  [coordinates]
  (* 0.5 (apply + (map (fn [[[x0 y0] [x1 y1]]]
                         (- (* y0 x1)
                            (* x0 y1)))
                       (partition 2 1 (close-coordinates coordinates))))))

Calculate centroid from list of counterclockwise coordinates, ref Wikipedia

(defn centroid
  [coordinates]
  (div (apply add (map (fn [[[x0 y0] [x1 y1]]]
                              (let [cross (- (* y0 x1) (* x0 y1))]
                                [(* cross (+ x0 x1)), (* cross (+ y0 y1))]))
                            (partition 2 1 (close-coordinates coordinates))))
            (* 6 (area coordinates))))
 

c2.layout.histogram

toc

The histogram layout transforms data by grouping descrete data points into bins.

(hist/histogram [{:name "sally" :age 20} {:name "al" :age 55} {:name "ali" :age 56} {:name "amanda" :age 12} {:name "andy" :age 26} {:name "brock" :age 30}] :value :age :range [13 30] :bins 3)

(ns c2.layout.histogram
  (:use [c2.maths :only [log]]))
(defn- binary-search [v target]
  "VM agnostic j.u.Collections/binarySearch, from http://www.gettingclojure.com/cookbook:sequences"
  (loop [low 0
         high (dec (count v))]
    (if (> low high)
      (- (inc low))
      (let [mid (quot (+ low high) 2)
            mid-val (v mid)]
        (cond (< mid-val target) (recur (inc mid) high)
              (< target mid-val) (recur low (dec mid))
              :else mid)))))

Calulate reasonable number of bins assuming an approximately normal distribution

(defn- sturges
  [values]
  (-> (count values)
    (log 2)
    int
    inc))

Return the inclusive upper threshold of all bins

(defn- fixed-size-bins
  [[mn mx] n]
  (let [size (/ (- mx mn) n)]
    (vec (for [step (range (inc n))]
           (+ mn (* size step))))))

The histogram layout transforms data by grouping descrete data points into bins. Returns a collection of values with the following metadata set:

:x the lower bound of the bin (inclusive).

:dx the width of the bin; x + dx is the upper bound (exclusive).

:y the count

Kwargs:

:value fn that calculates value of node, defaults to :value

:index opaque value passed to :bins and :range

:range fn which calculates the minimum and maximum values given the array of values

:bins Number of bins /or/ fn that takes the range, array of values, and current index

(defn histogram
  [data & {:keys [value index range bins]
           :or {value :value
                range (fn [xs _] ((juxt (partial reduce min)
                                        (partial reduce max))
                                    xs))
                bins (fn [r xs _] (fixed-size-bins r (sturges xs)))}}]
  (let [values (map value data)
        r (cond
            (fn? range) (range values index)
            :else range)
        thresholds (cond
                     (fn? bins) (bins r values index)
                     (number? bins) (fixed-size-bins r bins)
                     :else bins)
        binner (fn [e] (->> (value e)
                                        ; remove trailing threshold number
                         (binary-search (subvec thresholds 0 (dec (count thresholds))))
                         inc
                         Math/abs
                         dec))
        groups (group-by binner
                         (filter #(and (>= (value %) (r 0))
                                       (<= (value %) (r 1)))
                                 data))]
    (map-indexed (fn [index [mn mx]]
                   (let [group (or (groups index)
                                   [])]
                     (with-meta group
                                {:x mn
                                 :dx (- mx mn)
                                 :y (count group)})))
                 (partition 2 1 thresholds))))
 

c2.layout.partition

toc

The partition layout transforms root node of hierarchy into a flat collection of nodes positioned and sized according to provided value fn. E.g., a doughnut plot can be created by partitioning the angular width and radius of a circle:

(partition {:name "Pie"
            :slices [{:name "Big slice" :val 5}
                     {:name "Lil' slice" :val 3}]}
            :size [Tau 1]
            :value :val
            :children :slices) ;;=>

(;;Centre piece; circle with radius 1/2.
 {:partition {:dy 1/2, :dx 6.283185307179586, :y 0N, :x 0, :value 8, :depth 0}, :name "Pie", :slices [{:name "Big slice", :val 5} {:name "Lil' slice", :val 3}]}

 ;;Outer pieces; radii from 1/2 to 1 and angular displacement given according to val
 {:partition {:dy 1/2, :dx 3.9269908169872414, :y 1/2, :x 0, :value 5, :depth 1}, :name "Big slice", :val 5}
 {:partition {:dy 1/2, :dx 2.356194490192345, :y 1/2, :x 3.9269908169872414, :value 3, :depth 1}, :name "Lil' slice", :val 3})

(ns c2.layout.partition
  (:refer-clojure :exclude [partition]))

Transforms root node of hierarchy into a flat collection of nodes positioned and sized according to provided value fn.

Kwargs:

:children fn that calculates children of node, defaults to :children

:value fn that calculates value of node, defaults to :value

:size 2D space to be partitioned, defaults to [1, 1]

:output-key keyword added to node map in output collection that holds calculated positions, defaults to :partition

(defn partition
  [root & {:keys [children value size output-key]
           :or {children :children
                value :value
                size [1 1]
                output-key :partition}}]
  (defn depth [node]
    (inc (if-let [cs (children node)]
           (apply max (map depth cs))
           0)))
  (defn node-value [node]
    (if-let [cs (children node)]
      (apply + (map node-value cs))
      (value node)))
  (defn position [node depth x [dx dy]]
    (concat
     ;;parent node
     [(assoc node output-key (merge (output-key node)
                                    {:depth depth
                                     :value (node-value node)
                                     :x x, :y (* depth dy)
                                     :dx dx, :dy dy}))]
     ;;child nodes
     (let [unit-cdx (/ dx (node-value node))
           cs (children node)]
       (flatten
        (map (fn [child cx]
               (position child (inc depth) cx [(* unit-cdx (node-value child)) dy]))
             cs
             ;;Calculate each child's x-offset
             (reductions (fn [cx child] (+ cx (* unit-cdx (node-value child))))
                         x cs))))))
  (position root 0 0 [(first size) (/ (second size) (depth root))]))
(comment
  (use '[vomnibus.d3 :only [flare]])
  (use '[c2.maths :only [Tau]])
  (partition flare :value #(do % 1))

  (partition {:name "rrr"
              :children [ {:name "A"
                           :children [{:name "a" :value 1}
                                      {:name "b" :value 1}
                                      {:name "c" :value 1}]}
                          {:name "B"
                           :children [{:name "ba" :value 2}
                                      {:name "bb" :value 2}
                                      {:name "bc" :value 2}]}]}))
 

c2.maths

toc
^:clj (ns c2.maths
        (:use [c2.util :only [combine-with]]))
^:cljs (ns c2.maths
         (:use-macros [c2.util :only [combine-with]]))
(def Pi Math/PI)
(def Tau (* 2 Pi))
(def e Math/E)
(def radians-per-degree (/ Pi 180))
(defn rad [x] (* radians-per-degree x))
(defn deg [x] (/ x radians-per-degree))
(defn sin [x] (Math/sin x))
(defn asin [x] (Math/asin x))
(defn cos [x] (Math/cos x))
(defn acos [x] (Math/acos x))
(defn tan [x] (Math/tan x))
(defn atan [x] (Math/atan x))
(defn expt
  ([x] (Math/exp x))
  ([x y] (Math/pow x y)))
(defn sq [x] (expt x 2))
(defn sqrt [x] (Math/sqrt x))
(defn floor [x] (Math/floor x))
(defn ceil [x] (Math/ceil x))
(defn abs [x] (Math/abs x))
(defn log
  ([x] (Math/log x))
  ([base x] (/ (Math/log x)
               (Math/log base))))
(defn ^:clj log10 [x] (Math/log10 x))
(defn ^:cljs log10 [x] (/ (.log js/Math x)
                          (.-LN10 js/Math)))

Returns 2-vector of min and max elements in xs.

(defn extent
  [xs]
  [(apply min xs)
   (apply max xs)])

Arithemetic mean of collection

TODO: replace mean and median with smarter algorithms for better performance.

(defn mean
  [xs]
  (/ (reduce + xs)
     (count xs)))

Median of a collection.

(defn median
  [xs]
  (let [sorted (sort xs)
        n (count xs)]
    (cond
     (= n 1)  (first sorted)
     (odd? n) (nth sorted (/ (inc n) 2))
     :else    (let [mid (/ n 2)]
                (mean [(nth sorted (floor mid))
                       (nth sorted (ceil mid))])))))

Inclusive range; same as core/range, but includes the end.

(defn irange
  ([start] (range start))
  ([start end] (concat (range start end) [end]))
  ([start end step]
     (let [r (range start end step)]
       (if (== (mod (first r) step)
               (mod end step))
         (concat r [end])
         r))))

Checks if bottom <= x <= top.

(defn within?
  [x [bottom top]]
  (<= bottom x top))

element-by-element arithmetic Code modified from Incanter

(defn add
  ([& args] (reduce (fn [A B] (combine-with A B clojure.core/+ add)) args)))
(defn sub
  ([& args] (if (= (count args) 1)
              (combine-with 0 (first args) clojure.core/- sub)
              (reduce (fn [A B] (combine-with A B clojure.core/- sub)) args))))
(defn mul
  ([& args] (reduce (fn [A B] (combine-with A B clojure.core/* mul)) args)))
(defn div
  ([& args] (if (= (count args) 1)
              (combine-with 1 (first args) clojure.core// div)
              (reduce (fn [A B] (combine-with A B clojure.core// div)) args))))

Returns the quantiles of a dataset.

Kwargs:

 > *:probs*: ntiles of the data to return, defaults to `[0 0.25 0.5 0.75 1]`

Algorithm is the same as R's quantile type=7. Transcribed from Jason Davies; https://github.com/jasondavies/science.js/blob/master/src/stats/quantiles.js

(defn quantile
  [data & {:keys [probs] :or {probs [0 0.25 0.5 0.75 1]}}]
  (let [xs (into [] (sort data))
        n-1 (dec (count xs))]
    (for [q probs]
      (let [index (inc (* q n-1))
            lo    (int (floor index))
            h     (- index lo)
            a     (xs (dec lo))]
        (if (= h 0)
          a
          (+ a (* h (- (xs lo) a))))))))
 

c2.scale

toc
^:clj (ns c2.scale
        (:use [c2.util :only [c2-obj]]
              [c2.maths :only [expt]])
        (:require [c2.maths :as maths]))
^:cljs (ns c2.scale
         (:use-macros [c2.util :only [c2-obj]])
         (:use [c2.maths :only [expt]])
         (:require [c2.maths :as maths]))
(defprotocol IInvertable
  (invert [scale] "Inverted scale"))

Linear scale

Kwargs:

:domain domain of scale, default [0 1]

:range range of scale, default [0 1]

(c2-obj linear {:domain [0 1]
                :range  [0 1]}

        clojure.lang.IFn
        (invoke [_ x] (let [domain-length (- (last domain) (first domain))
                            range-length (- (last range) (first range))]
                        (+ (first range)
                           (* range-length
                              (/ (- x (first domain))
                                 domain-length)))))
        IInvertable
        (invert [this]
                (assoc this
                  :domain range
                  :range domain)))
(declare log)

Power scale

Kwargs:

:domain domain of scale, default [0 1]

:range range of scale, default [0 1]

(c2-obj power {:domain [0 1]
               :range  [0 1]}
        
        clojure.lang.IFn
        (invoke [_ x]
                ((comp (linear :domain (map expt domain)
                               :range range)
                       expt) x)))

Logarithmic scale

Kwargs:

:domain domain of scale, default [1 10]

:range range of scale, default [0 1]

(c2-obj log {:domain [1 10]
             :range  [0 1]}
        
        clojure.lang.IFn
        (invoke [_ x]
                ((comp (linear :domain (map maths/log domain)
                               :range range)
                       maths/log) x)))
 

c2.svg

toc

Collection of helpers for dealing with scalable vector graphics.

Coordinates to any fn can be 2-vector [x y] or map {:x x :y y}.

^:clj (ns c2.svg
        (:use [c2.core :only [unify]]
              [c2.maths :only [Pi Tau radians-per-degree
                               sin cos mean]]))
^:cljs (ns c2.svg
         (:use [c2.core :only [unify]]
               [c2.maths :only [Pi Tau radians-per-degree
                                sin cos mean]])
         (:require [c2.dom :as dom]))

Stub for float fn, which does not exist on cljs runtime

^:cljs (def float identity)

Convert coordinates (potentially map of {:x :y}) to 2-vector.

(defn ->xy
  [coordinates]
  (cond
   (and (vector? coordinates) (= 2 (count coordinates))) coordinates
   (map? coordinates) [(:x coordinates) (:y coordinates)]))
(defn translate [coordinates]
  (let [[x y] (->xy coordinates)]
    (str "translate(" (float x) "," (float y) ")")))
(defn scale [coordinates]
  (cond
   (number? coordinates) (str "scale(" (float coordinates) ")")
   (map? coordinates) [(:x coordinates) (:y coordinates)]
   (and (vector? coordinates) (= 2 (count count))) coordinates))
(defn rotate
  ([angle] (rotate angle [0 0]))
  ([angle coordinates]
     (let [[x y] (->xy coordinates)]
       (str "rotate(" (float angle) "," (float x) "," (float y) ")"))))

Returns map of {:x :y :width :height} containing SVG element bounding box. All coordinates are in userspace. Ref SVG spec

(defn ^:cljs get-bounds
  [$svg-el]
  (let [b (.getBBox $svg-el)]
    {:x (.-x b)
     :y (.-y b)
     :width (.-width b)
     :height (.-height b)}))

Returns a transform string that will scale and center provided element {:width :height :x :y} within container {:width :height}.

(defn transform-to-center
  [element container]
  (let [{ew :width eh :height x :x y :y} element
        {w :width h :height} container
        s (min (/ h eh) (/ w ew))]
    (str (translate [(- (/ w 2) (* s (/ ew 2)))
                     (- (/ h 2) (* s (/ eh 2)))]);;translate scaled to center
         " " (scale s) ;;scale
         " " (translate [(- x) (- y)]) ;;translate to origin)))

Scales and centers $svg-el within its parent SVG container. Uses parent's width and height attributes only.

(defn ^:cljs transform-to-center!
  [$svg-el]
  (let [$svg (.-ownerSVGElement $svg-el)
        t (transform-to-center (get-bounds $svg-el)
                               {:width (js/parseFloat (dom/attr $svg :width))
                                :height (js/parseFloat (dom/attr $svg :height))})]
    (dom/attr $svg-el :transform t)))

Returns axis hiccup vector for provided input scale and collection of ticks (numbers). Direction away from the data frame is defined to be positive; use negative margins and widths to render axis inside of data frame.

Kwargs:

:orientation ∈ (:top, :bottom, :left, :right), where the axis should be relative to the data frame, defaults to :left

:formatter fn run on tick values, defaults to str

:major-tick-width width of ticks (minor ticks not yet implemented), defaults to 6

:text-margin distance between axis and start of text, defaults to 9

:label axis label, centered on axis; :left and :right orientation labels are rotated by +/- pi/2, respectively

:label-margin distance between axis and label, defaults to 28

(defn axis
  [scale ticks & {:keys [orientation
                         formatter
                         major-tick-width
                         text-margin
                         label
                         label-margin]
                  :or {orientation :left
                       formatter str
                       major-tick-width 6
                       text-margin 9
                       label-margin 28}}]
  (let [[x y x1 x2 y1 y2] (case orientation
                            (:left :right) [:x :y :x1 :x2 :y1 :y2]
                            (:top :bottom) [:y :x :y1 :y2 :x1 :x2])
        parity (case orientation
                 (:left :top) -1
                 (:right :bottom) 1)]
    [:g {:class (str "axis " (name orientation))}
     [:line.rule (apply hash-map (interleave [y1 y2] (:range scale)))]
     [:g.ticks
      ;;Need to weave scale into tick stream so that unify updates nodes when the scale changes.
      (unify (map vector ticks (repeat scale))
             (fn [[d scale]]
               [:g.tick.major-tick {:transform (translate {x 0 y (scale d)})}
                [:text {x (* parity text-margin)} (formatter d)]
                [:line {x1 0 x2 (* parity major-tick-width)}]]))]
     (when label
       [:text.label {:transform (str (translate {x (* parity label-margin)
                                                 y (mean (:range scale))})
                                     " "
                                     (case orientation
                                       :left (rotate -90)
                                       :right (rotate 90)
                                       ""))}
        label])
     ]))
(def ArcMax (- Tau 0.0000001))

Calculate SVG path data for a circle of radius starting at 3 o'clock and sweeping in positive y.

(defn circle
  ([radius] (circle [0 0] radius))
  ([coordinates radius]
     (let [[x y] (->xy coordinates)]
       (str "M"  (+ x radius) "," y
            "A" (+ x radius) "," (+ y radius) " 0 1,1" (- (+ x radius)) "," y
            "A" (+ x radius) "," (+ y radius) " 0 1,1" (+ x radius) "," y))))

Calculate SVG path data for an arc.

(defn arc
  [& {:keys [inner-radius, outer-radius
             start-angle, end-angle, angle-offset]
      :or {inner-radius 0, outer-radius 1
           start-angle 0, end-angle Pi, angle-offset 0}}]
  (let [r0 inner-radius
        r1 outer-radius
        [a0 a1]  (sort [(+ angle-offset start-angle)
                        (+ angle-offset end-angle)])
        da (- a1 a0)
        large-arc-flag (if (< da Pi) "0" "1")
        s0 (sin a0), c0 (cos a0)
        s1 (sin a1), c1 (cos a1)]
    ;;SVG "A" parameters: (rx ry x-axis-rotation large-arc-flag sweep-flag x y)
    ;;see http://www.w3.org/TR/SVG/paths.html#PathData
    (if (>= da ArcMax)
      ;;Then just draw a full annulus
      (str "M0," r1
           "A" r1 "," r1 " 0 1,1 0," (- r1)
           "A" r1 "," r1 " 0 1,1 0," r1
           (if (not= 0 r0) ;;draw inner arc
             (str "M0," r0
                  "A" r0 "," r0 " 0 1,0 0," (- r0)
                  "A" r0 "," r0 " 0 1,0 0," r0))
           "Z")
      ;;Otherwise, draw the wedge
      (str "M" (* r1 c0) "," (* r1 s0)
           "A" r1 "," r1 " 0 " large-arc-flag ",1 " (* r1 c1) "," (* r1 s1)
           (if (not= 0 r0) ;;draw inner arc
             (str "L" (* r0 c1) "," (* r0 s1)
                  "A" r0 "," r0 " 0 " large-arc-flag ",0 " (* r0 c0) "," (* r0 s0))
             "L0,0")
           "Z"))))
 

c2.ticks

toc

Implementation of An Extension of Wilkinson’s Algorithm for Positioning Tick Labels on Axes by Justin Talbot, Sharon Lin, and Pat Hanrahan. See also Talbot's website.

^:clj (ns c2.ticks
        (:use [c2.maths :only [sq ceil floor log10 expt irange within?]]
              [iterate :only [iter]]))
^:cljs (ns c2.ticks
         (:use-macros [iterate :only [iter]])
         (:use [c2.maths :only [sq ceil floor log10 expt irange within?]]))

Preference-ordered list of nice step sizes

(def Q 
  [1 5 2 2.5 4 3])

Index of x in coll

(defn index-of 
  [x coll]
  (first (for [[idx y] (map-indexed vector coll)
               :when (= y x)] idx)))
(defn label-range-contains-zero? [l-min l-max l-step]
  (and (> l-max 0) (< l-min 0) (zero? (mod l-min l-step))))

Objective function modeling niceness of step sizes and whether a range includes zero

(defn simplicity
  [q j label-range-contains-zero]
  (let [v (if label-range-contains-zero 1 0)]
    (if (<= (count Q) 1)
      (+ (- 1 j) v)
      (+ (- 1 (/ (index-of q Q) (dec (count Q))) j)
         v))))
(defn max-simplicity [q j] (simplicity q j true))

Objective function based on distances between extreme data and extreme labels

(defn coverage
  [d-min d-max l-min l-max]
  (- 1 (* 0.5 (/ (+ (sq (- d-max l-max))
                    (sq (- d-min l-min)))
                 (sq (* 0.1 (- d-max d-min)))))))

When the label range is centered on the data range

(defn max-coverage
  [d-min d-max span]
  (let [d-range (- d-max d-min)]
    (if (> span d-range)
      (- 1 (sq (/ (- span d-range)
                  (* 0.2 d-range))))
      1)))

Objective function for a candidate density r and desired density rt (e.g. labels-per-cm)

(defn density
  [r rt]
  ;;Note the formula should be 2-, not 1- as in the paper.
  (- 2 (max (/ r rt) (/ rt r))))

Since the arguments are the same, I don't see what the story is with density / max density. This isn't satisfactorily explained in the paper.

(defn max-density [r rt]
  (if (>= r rt)
    (- 2 (/ r rt))
    1))

Balance the relative merits of different metrics

(defn- w
  [[simplicity coverage density legibility]]
  (let [w [0.2 0.25 0.5 0.05]]
    (+ (* simplicity (w 0))
       (* coverage (w 1))
       (* density (w 2))
       (* legibility (w 3)))))

Find best ticks for the data range [d-min, d-max]. Returns a map with {:min :max :step :extent :ticks} of optimal labeling (if one is found). Returns an empty map if no labelings can be found.

Kwargs:

:target-density labels per length, defaults to 0.01 (one label per 100 units)

:length available label spacing

:clamp? don't return ticks outside of data range, defaults to false.

Since there are no test input/output datasets for the labeling algorithm, I played it safe and copied the imperative algorithm from the paper. If you rewrite it in an understandable and performant functional style, I'll accept a pull request and buy you a bottle of whiskey.

(defn search
  [[d-min d-max] & {:keys [target-density length
                           clamp?]
                    :or {target-density 0.01 ;;Default to one label per 100 px
                         length         500
                         clamp?         false}}]
  (let [best-score (atom -2)
        label (atom {})]
    (iter {for q in Q}
          (iter {for j from 1}
                {for ms = (max-simplicity q j)}
                {return-if (< (w [ms 1 1 1]) @best-score)}
                (iter {for k from 2}
                      {for md = (max-density (/ k length) target-density)}
                      {return-if (< (w [ms 1 md 1]) @best-score)}
                      (let [delta ;;power of ten by which to multiply the step size
                            (/ (- d-max d-min)
                               (* (inc k) j k))]
                        (iter {for z from (ceil (log10 delta))}
                              {for l-step = (* q j (expt 10 z))}
                              {for mc = (max-coverage d-min d-max (* (dec k) l-step))}
                              {return-if (< (w [ms mc md 1]) @best-score)}
                              (iter {for start
                                     from (- (floor (/ d-max l-step))
                                             (dec k))
                                     to (/ d-min l-step)
                                     by (/ 1 j)}
                                    {for l-min = (* start l-step)}
                                    {for l-max = (+ l-min (* (dec k) l-step))}
                                    {for s = (simplicity q j (label-range-contains-zero? l-min l-max l-step))}
                                    {for c = (coverage d-min d-max l-min l-max)}
                                    {for d = (density (/ k length) target-density)}
                                    {for score = (w [s c d 1])}
                                    {return-if (< score @best-score)}
                                    ;;(println "inner loop")
                                    ;;todo, optimize legibility
                                    (reset! best-score score)
                                    (reset! label {:min l-min
                                                   :max l-max
                                                   :step l-step})))))))
    (let [l @label
          extent [(if clamp? d-min (min (:min l) d-min))
                 (if clamp? d-max (max (:max l) d-max))]]
      {:extent extent
       :min (first extent) :max (second extent)
       :ticks (filter #(within? % extent)
                      (irange (:min l) (:max l) (:step l)))})))
(comment
  (search [0.0 5000.0]
          :length 900
          :clamp? true)
  (search [1 9])
  (search [1 9] :target-density (/ 1 30))
  (search [10.4 33.9]
          :clamp? false)
  )
 
Generated by Marginalia.  Syntax highlighting provided by Alex Gorbatchev's SyntaxHighlighter