setShapeStyle, setCircleMarkerStyle and setCircleMarkerRadius (#496)

NAMESPACE

@@ -156,7 +156,10 @@ export(removeTopoJSON)
 export(renderLeaflet)
 export(safeLabel)
 export(scaleBarOptions)
+export(setCircleMarkerRadius)
+export(setCircleMarkerStyle)
 export(setMaxBounds)
+export(setShapeStyle)
 export(setView)
 export(showGroup)
 export(tileOptions)

NEWS

@@ -1,3 +1,9 @@
+
+leaflet 2.0.4
+
+* Added new functions setShapeStyle, setCircleMarkerStyle and setCircleMarkerRadius to change
+style and radius of already generated polygons, polylines and circle markers (leafletProxy)
+
 leaflet 2.0.3
 --------------------------------------------------------------------------------
 

R/layers.R

@@ -989,6 +989,60 @@ addCircleMarkers <- function(
     expandLimits(pts$lat, pts$lng)
 }
 
+#' @describeIn map-layers Change radius of existing circle markers.
+#' @export
+setCircleMarkerRadius <- function(map, layerId, radius, data=getMapData(map)){
+  options <- list(layerId = layerId, radius = radius)
+  # 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)))
+  leaflet::invokeMethod(map, data, "setRadius", options$layerId, options$radius)
+}
+
+#' @describeIn map-layers Change style of existing circle markers.
+#' @export
+setCircleMarkerStyle <- function(map, layerId
+                                 , radius = NULL
+                                 , stroke = NULL
+                                 , color = NULL
+                                 , weight = NULL
+                                 , opacity = NULL
+                                 , fill = NULL
+                                 , fillColor = NULL
+                                 , fillOpacity = NULL
+                                 , dashArray = NULL
+                                 , options = NULL
+                                 , data = getMapData(map)
+){
+  if (!is.null(radius)){
+    setCircleMarkerRadius(map, layerId = layerId, radius = radius, data = data)
+  }
+
+  options <- c(list(layerId = layerId),
+               options,
+               filterNULL(list(stroke = stroke, color = color,
+                               weight = weight, opacity = opacity,
+                               fill = fill, fillColor = fillColor,
+                               fillOpacity = fillOpacity, dashArray = dashArray
+               )))
+
+  if (length(options) < 2) { # no style options set
+    return()
+  }
+  # 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", "marker", layerId, style);
+}
+
+
 #' @rdname remove
 #' @export
 removeMarker <- function(map, layerId) {
@@ -1235,6 +1289,37 @@ addPolygons <- function(
     expandLimitsBbox(pgons)
 }
 
+#' @describeIn map-layers Change style of existing polygons or polylines
+#' @export
+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);
+}
+
+
 #' @rdname remove
 #' @export
 removeShape <- function(map, layerId) {
@@ -1247,6 +1332,8 @@ clearShapes <- function(map) {
   invokeMethod(map, NULL, "clearShapes")
 }
 
+
+
 #' @param geojson a GeoJSON list, or character vector of length 1
 #' @describeIn map-layers Add GeoJSON layers to the map
 #' @export

inst/examples/setStyle.R

@@ -0,0 +1,32 @@
+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)