diff --git a/project.clj b/project.clj index 82d098d..6ce8170 100644 --- a/project.clj +++ b/project.clj @@ -3,7 +3,8 @@ [generateme/fastmath "2.4.0"] [hiccup "2.0.0-RC3"] [javax.xml.bind/jaxb-api "2.4.0-b180830.0359"] - [org.clojure/clojure "1.8.0"] + [org.clojure/clojure "1.11.3"] + [org.clojure/data.xml "0.0.8"] ;; [org.clojure/clojurescript "1.9.229"] ;; [org.omcljs/om "1.0.0-beta1"] ;; [reagent "0.6.0"] diff --git a/resources/public/sample-data.edn b/resources/public/sample-data.edn index fe1ca2b..51d121e 100644 --- a/resources/public/sample-data.edn +++ b/resources/public/sample-data.edn @@ -1,40 +1,125 @@ {:id "ge2024" :label "UK General Election 2024" + :colour "white" :children [{:id "no-show" :label "Did not vote" - :magnitude 18365357} + :quantity 18365357} {:id "voted" :label "Voted" - :children [{:id "reform" - :label "Reform UK Ltd." - :magnitude 4091549} - {:id "greenew" - :label "Green Party of England and Wales" - :magnitude 1939502} - {:id "pc" - :label "Plaid Cymru" - :magnitude 194811} - {:id "sf" - :label "Sinn Féin" - :magnitude 210891} - {:id "ld" - :label "Liberal Democrats" - :magnitude 3499933} - {:id "labour" + :children [{:id "labour" :label "Labour" - :magnitude 9712011} - {:id "apni" - :label "Alliance Party" - :magnitude 117191} - {:id "sdlp" - :label "Social Democratic and Labour Party" - :magnitude 86861} - {:id "dup" - :label "Democratic Unionist Party" - :magnitude 172058} - {:id "snp" - :label "Scottish National Party" - :magnitude 708759} + :colour "red" + :quantity 9712011 + :children [{:id "negative" + :colour "gray" + :children [{:id "anti-tory" + :label "To get the Tories out" + :colour "#424242" + :quantity 4658234} + {:id "change" + :label "The country needs a change" + :colour "#424242" + :quantity 1261605} + {:id "nhs" + :label "To support the NHS" + :colour "#424242" + :quantity 388186} + {:id "alternative" + :label "The best alternative" + :quantity 388186} + {:id "anti-sunak" + :label "Rishi Sunak" + :colour "#424242" + :quantity 97047} + {:id "anti-snp" + :label "To oust the SNP" + :colour "#424242" + :quantity 97047}]} + {:id "other" + :colour "maroon" + :quantity 291140} + {:id "positive" + :colour "red" + :children [{:id "policies" + :label "I agree with their policies" + :colour "#d32f2f" + :quantity 485233} + {:id "mp" + :label "Like my MP" + :colour "#d32f2f" + :quantity 194093} + {:id "fairer" + :label "For a fairer society" + :colour "#d32f2f" + :quantity 194093} + {:id "habit" + :label "I always vote Labour" + :colour "#d32f2f" + :quantity 194093} + {:id "honesty" + :quantity 194093} + {:id "caop" + :label "Care about ordinary people" + :colour "#d32f2f" + :quantity 97047} + {:id "fwc" + :label "For the working class" + :colour "#d32f2f" + :quantity 97047} + {:id "cl" + :label "Address the cost of living" + :colour "#d32f2f" + :quantity 97047} + {:id "stability" + :label "Economic stability" + :colour "#d32f2f" + :quantity 97047} + {:id "pro-starmer" + :label "Keir Starmer" + :colour "#d32f2f" + :quantity 97047} + {:id "services" + :label "For better public services" + :colour "#d32f2f" + :quantity 97047}]}]} {:id "con" :label "Conservative" - :magnitude 6814469}]}]} \ No newline at end of file + :colour "blue" + :quantity 6814469} + {:id "ld" + :label "Liberal Democrats" + :colour "gold" + :quantity 3499933} + {:id "snp" + :label "Scottish National Party" + :colour "yellow" + :quantity 708759} + {:id "sf" + :label "Sinn Féin" + :quantity 210891} + {:id "independents" + :label "independents" + :colour "silver" + :quantity 564243} + {:id "reform" + :label "Reform UK Ltd." + :colour "cyan" + :quantity 4091549} + {:id "dup" + :label "Democratic Unionist Party" + :quantity 172058} + {:id "greenew" + :label "Green Party of England and Wales" + :colour "green" + :quantity 1939502} + {:id "pc" + :label "Plaid Cymru" + :colour "#005b54" + :quantity 194811} + {:id "apni" + :label "Alliance Party" + :colour "#f6cb2f" + :quantity 117191} + {:id "sdlp" + :label "Social Democratic and Labour Party" + :quantity 86861}]}]} \ No newline at end of file diff --git a/src/clj/rsvggraph/core.clj b/src/clj/rsvggraph/core.clj index b08bdd2..27be4f6 100644 --- a/src/clj/rsvggraph/core.clj +++ b/src/clj/rsvggraph/core.clj @@ -1 +1,92 @@ -(ns rsvggraph.core) +(ns rsvggraph.core + (:require [clojure.math :refer [cos PI sin]] + [clojure.string :refer [join replace]] + [clojure.xml :refer [emit]] + [fastmath.core :refer [pow]] + [hiccup2.core :refer [html]] + [rsvggraph.data :refer [normalise]])) + + + +(defn polar-to-cartesian + "Return, as a map with keys :x. :y, the cartesian coordinates at the point + `radius` distance at `theta` (degrees) angle from a point at + cartesian coordinates `cx`, `cy`." + [cx cy radius theta] + (let + [in-radians (/ (* (- theta 90) PI) 180.0)] + {:x (+ cx (* radius (cos in-radians))) + :y (+ cy (* radius (sin in-radians)))})) + +(defn describe-arc + "Return as a string an SVG path definition describing an arc centred + at `cx`, cy` starting at `start-angle` and ending at `end-angle` (both + angles in degrees)." + [cx cy radius start-angle end-angle] + (let + [start (polar-to-cartesian cx cy radius start-angle) + end (polar-to-cartesian cx cy radius end-angle) + large-arc? (if (<= (- end-angle start-angle) 180) 0 1) + sweep (if (> end-angle start-angle) 1 0)] + (join " " ["M" (:x start) (:y start) "A" radius radius 0 large-arc? sweep (:x end) (:y end)]))) + +(defn draw-segment + [datum diameter] + (let [r' (/ diameter 2) + thickness (/ r' (:ring datum));; (/ 1 (pow 3 (:ring datum))) + radius (- r' (/ thickness 2)) + start-angle (* (:left datum) 360) + end-angle (* (:right datum) 360) + id (str (:id datum) "-segment") + path-data (describe-arc r' r' radius start-angle end-angle)] +;; (println (format "Id: %s; radius: %s; start: %s; end: %s; thickness %s" id radius start-angle end-angle thickness)) + [:g {:id (str id "group")} + [:path {:class "rsvggraph-segment" + :id id + :style {:fill "none" + :stroke (:colour datum) + :stroke-width thickness} + :d path-data}] + [:text [:textPath {:href (str "#" id) + :path path-data} (:label datum)]]])) + +(defn flatten-data + [data] + (cond (empty? (:children data)) data + :else (flatten (cons (dissoc data :children) (map flatten-data (:children data)))))) + +(def ^:dynamic *background* "white") + +(def ^:dynamic *foreground* "black") + +(defn data->svg + [data diameter] + (let [data' (normalise data)] + [:svg {:xmlSpace "preserve" + :overflow "visible" + :viewBox (join " " [0 0 diameter diameter]) + :width (str diameter "px") + :height (str diameter "px") + :y "0px" + :x "0px" + :version "1.1" + :id (:id data') + :class (str "rsvggraph-graph") + :xmlns "http://www.w3.org/2000/svg"} + [:circle {:id (str (:id data') "-background") :cx (/ diameter 2) :cy (/ diameter 2) :r (/ diameter 2) :style {:fill "white"}}] + [:text + {:text-anchor "middle" + :x (/ diameter 2) + :y (/ diameter 2) + :width (/ diameter 4) + :id (str (:id data') "-title") + :class "rsvggraph-value"} [:tspan (:label data) ": " (:quantity data)]] + (map #(draw-segment % diameter) (flatten-data data))])) + +(defn data->svg-file + [data diameter path] + (emit (data->svg data diameter))) + +(defn data->html-file + [data diameter path] + (spit path (join "\n" ["" (replace (html (data->svg data diameter)) #"\> *\<" ">\n<")]))) \ No newline at end of file diff --git a/src/clj/rsvggraph/data.clj b/src/clj/rsvggraph/data.clj index 090e1df..5d3f93b 100644 --- a/src/clj/rsvggraph/data.clj +++ b/src/clj/rsvggraph/data.clj @@ -1,29 +1,89 @@ (ns rsvggraph.data - "Normalise data for use in generating radial graphs." - (:require [clojure2d.color :refer [gradient]])) + "Normalise data for use in generating radial graphs. A lot of the things + I want to do here, especially with colour, are not readily portable between + clojure and clojurescript, so this is Clojure only for now." + (:require [clojure2d.color :refer [format-hex gradient]] + [fastmath.core :refer [pow]])) -(def ;; ^:dynamic - *gradient* +(def ^:dynamic *gradient* "The gradient to use to automatically assign pleasing colours to sectors, if no colours are defined in the data. Suitable gradients are defined [here](https://clojure2d.github.io/clojure2d/docs/static/gradients/)." :rainbow2) -(def children-fn +(def ^:dynamic *children* "Basic (overridable) children function; assumes `data` is a map, and returns the value of the `:children` key within that map." (memoize (fn [data] (:children data)))) -(def quantity-fn +(def ^:dynamic *quantity* "Basic (overridable) children function; assumes `data` is a map. If the value of the `:children` key within that map is a sequence, sums the result of mapping itself over that sequence. Otherwise, returns the value of the `:quantity` key, if present and a number, or `1` as a final default." (memoize (fn [data] - (let [c (children-fn data) + (let [c (*children* data) q (:quantity data)] - (cond (coll? c) (reduce + 0 (map quantity-fn c)) - (number? q) q - :else 1))))) \ No newline at end of file + (cond (number? q) q + (coll? c) (reduce + 0 (map *quantity* c)) + :else 1))))) + +(def ^:dynamic *colour* + "Return, as a hex string acceptable to HTML and CSS, the appropriate colour + for this `datum` having this `central-quantity-fraction` as the centre of + its position in the arc." + (fn [data central-quantity-fraction] + (let [col (:colour data) + grad (gradient *gradient*)] + (cond + col col + (number? data) (format-hex (grad data)) + (number? central-quantity-fraction) (format-hex (grad central-quantity-fraction)) + :else "gray")))) + +(def proportion + (memoize + (fn [data total] + (double (/ (*quantity* data) total))))) + +(defn normalise + ([data] + (normalise data 1 (*quantity* data) 0)) + ([data ring total left] + (let [id (or (:id data) + (keyword (gensym (or (:title data) "datum")))) + q (*quantity* data) + p (proportion data total) + color (*colour* data (+ left (/ p 2)))] + (assoc data + :children + (when (:children data) + (loop [c (first (:children data)) + l left + y (rest (:children data)) + v nil] + (let [r (+ l (proportion c total)) + c' (assoc + (normalise c (inc ring) total l) + :left l + :right r) + v' (cons c' v)] + ;; (println (format "Label: %s: ring: %d; left: %f; right: %f; colour %s." + ;; (:label c') ring (double l) r color)) + (cond (empty? y) (vec v') + :else + (recur (first y) + r + (rest y) + v'))))) + :colour color + :id id + :inner-diameter (/ 1 (pow 3 ring)) + :label (or (:label data) id) + :left 0 + :proportion p + :quantity q + :right 1 + :ring ring)))) \ No newline at end of file