forked from timelyportfolio's block: vsup ggplot2 interactive svg to add cartogram
Claus Wilke has been doing some amazing work within the R community. Recently, he posted a VSUP
example map using his package multiscales
and the newest ggplot2
. I thought a little interactivity would be a nice addition.
# will need newest ggplot2, github multiscales, and dev version of colorspace
# install.packages('ggplot2')
# install.packages("colorspace", repos = "http://R-Forge.R-project.org")
# devtools::install_github("clauswilke/multiscales")
library(htmltools)
library(d3r)
library(svglite)
library(ggplot2)
library(multiscales)
colors <- scales::colour_ramp(
colors = c(red = "#AC202F", purple = "#740280", blue = "#2265A3")
)((0:7)/7)
types <- c(
'Natural state geometry',
'Cartogram weigted by electoral votes'
)
US_polling$type <- types[1]
US_polling_cartogram$type <- types[2]
US_all <- rbind(US_polling, US_polling_cartogram)
US_all$type <- factor(US_all$type, levels = types)
ggp <- ggplot(US_all) +
geom_sf(aes(fill = zip(Clinton_lead, moe_normalized)), color = "gray30", size = 0.2) +
coord_sf(datum = NA) +
bivariate_scale(
"fill",
pal_vsup(values = colors, max_desat = 0.8, pow_desat = 0.2, max_light = 0.7, pow_light = 1),
name = c("Clinton lead", "uncertainty"),
limits = list(c(-40, 40), c(0, 1)),
breaks = list(c(-40, -20, 0, 20, 40), c(0, 0.25, 0.50, 0.75, 1.)),
labels = list(waiver(), scales::percent),
guide = "colourfan"
) +
theme_void() +
theme(
strip.text = element_text(size = 11, margin = margin(3, 0, 3, 0)),
legend.key.size = grid::unit(0.8, "cm"),
legend.title.align = 0.5,
plot.margin = margin(5.5, 20, 5.5, 5.5)
) +
facet_wrap(~type, ncol = 1)
s <- svgstring()
ggp
dev.off()
browsable(
tagList(
tags$div(style="width:100%",HTML(s())),
tags$script(HTML(
"
var svg = d3.select('svg')
// add original fill as data on each state path
svg.selectAll('path').each( function(d) {
d3.select(this).datum({color: d3.select(this).style('fill')})
})
// this is not necessary but makes it cleaner
// add g group for each polygon in the legend
// the polygons are multiple small portions of the space in the legend
// rather than one polygon for each color
var legendcolors = d3.set()
svg.selectAll('polygon').each(function(d){legendcolors.add(d3.select(this).style('fill'))})
legendcolors.values().forEach(function(color) {
var g = svg.insert('g','svg>polygon').classed('legend-color',true).datum({color: color})
svg.selectAll('polygon')
.filter(function(d) {return d3.select(this).style('fill') === color})
.each(function(d) {
g.node().appendChild(this)
})
})
svg.selectAll('g.legend-color').on('mouseover', function(d) {
svg.selectAll('path').filter(function(pathd){return pathd.color !== d.color}).style('fill', 'white')
svg.selectAll('path').filter(function(pathd){return pathd.color === d.color}).style('fill', d.color)
})
svg.selectAll('g.legend-color').on('mouseout', function(d) {
svg.selectAll('path').style('fill', function(pathd){return pathd.color})
})
// create a legend container g
var legend = svg.insert('g', 'g.legend-color')
.classed('legend',true)
.datum({transformx:0,transformy:0})
// add legend elements to a g container
svg.selectAll('g.legend-color,g[clip-path]').each(function(d){
// this is unfortunately manual and specific to this graph
// svglite does not identify what is what from the ggplot2
// so we will just ignore the text labels for each plot
if(d3.select(this).text().indexOf('geometry') === -1 && d3.select(this).text().indexOf('Cartogram') === -1) {
legend.node().appendChild(this)
}
})
// make a crude drag function to move the legend when dragged
// probably a better way than storing the transforms in datum
// but it was my first idea and it works
function dragged(d) {
var transformx = d3.select(this).datum().transformx + d3.event.dx
var transformy = d3.select(this).datum().transformy + d3.event.dy
d3.select(this).attr('transform', 'translate(' + transformx + ',' + transformy + ')');
d3.select(this).datum({transformx:transformx, transformy: transformy})
}
drag = d3.drag().on('drag',dragged)
legend.call(drag)
"
)),
d3_dep_v5()
)
)
https://unpkg.com/d3@5.5.0/dist/d3.min.js