Mostly working, labels don't go on their paths.
This commit is contained in:
parent
3a1ae81f08
commit
240b76c889
|
|
@ -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"]
|
||||
|
|
|
|||
|
|
@ -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}]}]}
|
||||
: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}]}]}
|
||||
|
|
@ -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" ["<?xml version='1.0' encoding='UTF-8'?>" (replace (html (data->svg data diameter)) #"\> *\<" ">\n<")])))
|
||||
|
|
@ -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)))))
|
||||
(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))))
|
||||
Loading…
Reference in a new issue