setShapeStyle, setCircleMarkerStyle and setCircleMarkerRadius (#496)

[edwindj]

I have added three new methods that allow for style changes of already rendered choropleths and circlemarkers. Its usage is typically with leafletproxy in shiny and is a fix for issue #496.

Example

A minimal example is included in inst/examples/setStyle.R

library(shiny)
library(leaflet)

coor <- sp::coordinates(gadmCHE)

ui <- fluidPage(
  leafletOutput("map"),
  radioButtons("color", "Color", choices = c("blue", "red",  "green")),
  sliderInput("radius", "Radius", min = 1, max = 30, value=5, animate = TRUE)
)

server <- function(input, output, session){
  output$map <- renderLeaflet({
    leaflet(data=gadmCHE) %>%
      addPolygons(layerId = ~NAME_1, weight = 1) %>%
      addCircleMarkers(layerId = gadmCHE$NAME_1, data = coor, weight = 1)
  })

  observe({
    leafletProxy("map", data = gadmCHE) %>%
      setCircleMarkerRadius(gadmCHE$NAME_1, input$radius)
  })

  observe({
    leafletProxy("map", data = gadmCHE) %>%
      setShapeStyle(layerId = ~NAME_1, fillColor=input$color, color = input$color) %>%
      setCircleMarkerStyle(layerId = ~NAME_1, fillColor = input$color, color = input$color)
  })

}

shinyApp(ui, server)

[edwindj]

Current travis warning is not due to PR (which does nothing with map-shiny.Rd or shiny.R), but to roxygen2 inheritsParams htmlwidgets::shinyWidgetOutput which generates a invalid \href statement (a opening and closing bracket too much): r-lib/roxygen2#778

[CLAassistant]

Thank you for your submission! We really appreciate it. Like many open source projects, we ask that you sign our Contributor License Agreement before we can accept your contribution.
_{You have signed the CLA already but the status is still pending? Let us recheck it.}

[edwindj]

Any news on this?

[courtwarr]

Maybe the wrong place to post this, but @edwindj I'm using leafgl to plot ~35k line segments. Implementing your solution directly (as in #496) works perfectly for a layer built using leaflet::addPolyLines but not for one built using leafgl::addGlPolyLines. Any advice? Reprex below:

library(shiny)
library(sf)
library(leaflet)
library(leafgl)

data <- gadmCHE %>%
as("SpatialLinesDataFrame") %>%
st_as_sf() %>%
st_cast("LINESTRING")

setShapeStyle <- function( map, data = getMapData(map), layerId,
stroke = NULL, color = NULL,
weight = NULL, opacity = NULL,
fill = NULL, fillColor = NULL,
fillOpacity = NULL, dashArray = NULL,
smoothFactor = NULL, noClip = NULL,
options = NULL
){
options <- c(list(layerId = layerId),
options,
filterNULL(list(stroke = stroke, color = color,
weight = weight, opacity = opacity,
fill = fill, fillColor = fillColor,
fillOpacity = fillOpacity, dashArray = dashArray,
smoothFactor = smoothFactor, noClip = noClip
)))

evaluate all options

options <- evalFormula(options, data = data)

make them the same length (by building a data.frame)

options <- do.call(data.frame, c(options, list(stringsAsFactors=FALSE)))

layerId <- options[[1]]
style <- options[-1] # drop layer column

#print(list(style=style))
leaflet::invokeMethod(map, data, "setStyle", "shape", layerId, style);
}

ui <- fluidPage(
tags$head(
tags$script(HTML(
'
window.LeafletWidget.methods.setStyle = function(category, layerId, style){
var map = this;
if (!layerId){
return;
} else if (!(typeof(layerId) === "object" && layerId.length)){ // in case a single layerid is given
layerId = [layerId];
}

//convert columnstore to row store
style = HTMLWidgets.dataframeToD3(style);
//console.log(style);

layerId.forEach(function(d,i){
var layer = map.layerManager.getLayer(category, d);
if (layer){ // or should this raise an error?
layer.setStyle(style[i]);
}
});
};
'
))
),
fluidRow(
column(width=6,offset=0,leafletOutput("map")),
column(width=6,offset=0,leafletOutput("glMap"))
),
radioButtons("color", "Color", choices = c("blue", "red"))
)

server <- function(input, output, session){
output$map <- renderLeaflet({
leaflet(data) %>%
addPolylines(data=data,layerId = as.character(1:nrow(data)))
})

output$glMap <- renderLeaflet({
leaflet(data) %>%
addGlPolylines(data=data,layerId = as.character(1:nrow(data)))
})

observe({
leafletProxy("map", data = data) %>%
setShapeStyle(layerId = as.character(1:nrow(data)), color = input$color)
})

observe({
leafletProxy("glMap", data = data) %>%
setShapeStyle(layerId = as.character(1:nrow(data)), color = input$color)
})

}

shinyApp(ui, server)