vsup ggplot2 interactive svg

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)

# example from Claus Wilke's multiscales README
colors <- scales::colour_ramp(
  colors = c(red = "#AC202F", purple = "#740280", blue = "#2265A3")
)((0:7)/7)

ggp <- ggplot(US_polling) + 
  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(
    legend.key.size = grid::unit(0.8, "cm"),
    legend.title.align = 0.5,
    plot.margin = margin(5.5, 20, 5.5, 5.5)
  )

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){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()
  )
)