How to Recolor An Already Existing Polygon

[jrisi256]

Hi! Thanks for creating this wonderful library! I do have an issue though.

Currently I have shapefiles for all counties for all 50 states. And I am coloring them based on some outcome variable chosen by the user (e.g. unemployment, poverty rate, etc.)

Using leafletProxy() I can update the color however this necessitates a redrawing of the polygons even though it is the same polygons being drawn over and over again! I just want to change the color.

Normally, this wouldn't be an issue, but because it is a relatively large collection of shapefiles it can take a bit before the map updates.

I was wondering if there was any plans in the work to edit an already existing set of polygons or something along those lines? If not, what would you recommend I do? (I've already reduced the shapefiles down in size as much as possible). Would this be an issue for leaflet.extras perhaps?

https://github.com/rstudio/leaflet/issues/170

The above issue seems similar to mine, and it seems like at some point there was work to be done on it? But it's a few years old, and I can't tell if there has been any work on it since then.

Thanks again!

[cenuno]

@jrisi256 are you open to incorporating the shiny package with your leaflet map? If so, check out https://github.com/cenuno/shiny/tree/master/Interactive_UI/Dynamic_Legend: a small shiny app that does what you're doing but for the neighborhoods in the City of Chicago.

In global.R, I call addPolygons() for each variable of interest and assign each instance a group value. These groups are placed in addLayersControl() as base-groups, allowing the user to switch the colors based on the variable of interest.

In server.R, I use shiny::observeEvent() and leafletProxy() to update the legend to the user-selected variable.

[jrisi256]

I am looking at your code now, and my only concern is the map I am creating is much larger than the one you are creating.

For reference, I am using the shape files as detailed below, and I have about 13 outcome variables (and I am going to want to add more). And each time I add another set of Polygons based on the county shape files, I calculate it adds 3.65 Mb to the total size of the map. For my 13 outcomes, that comes out to over 50 Mb, and I anticipate that this would cause Leaflet/Shiny to slow down quite a bit.

So I'm curious if there is a more 'elegant' solution versus having to copy/paste a bunch of code and wasting a lot of computational resources rendering basically the same polygons over and over again.

library(sf)
library(sp)
library(albersusa)
library(tigris)

#Read in shape file for counties
usa_counties_sp = counties(cb=TRUE, resolution="20m")

#Shift Alaska and Hawaii closer to the United States (as well as shrinking them)
usa_counties_sp_shift = points_elided(usa_counties_sp)
usa_counties_sf = st_as_sf(usa_counties_sp_shift)

#Do some cleaning of the shape files like getting rid of U.S. territories
data("fips_codes")
usa_counties = usa_counties_sf %>%
  filter(!(STATEFP %in% c("78", "66", "69", "60", "72"))) %>%
  inner_join(fips_codes, by=c("STATEFP" = "state_code", "COUNTYFP" = "county_code")) %>%
  rename(county_name=NAME, state_code=STATEFP, county_code=COUNTYFP) %>%
  select(state_code, county_code, state_name, county_name)

[timelyportfolio]

@jrisi256, this is possible but not through the currently provided R interface. I am waiting on response on https://github.com/rstudio/leaflet/issues/496#ref-pullrequest-296433986 to make sure I am not missing another implementation. I will post an example if this will not be added to the API in the development version.

[jrisi256]

@timelyportfolio Thank you so much! I eagerly await your example. @cenuno Thank you as well. I tried your idea, and it allowed for very fast transition between the polygons. However, it took a very, very long time to load the map. So sort of one step forward, one step backward type situation.

[cenuno]

@jrisi256: for speed, you might want to consider exporting your final spatial polygon data frame (or your entire leaflet map for that matter) as an .rds file in a separate R script, and then import that file into your global.R.

Kyle Walker does this with his neighborhood diversity Shiny app. You can see his GitHub repo here.

[jrisi256]

@cenuno Thank you! I'll have to check that out if this current line of inquiry doesn't work. @timelyportfolio Any update? I found a function in leaflet.extras "setMapWidgetStyle()" which may work for my purposes however I have been unable to get it to work.

[jrisi256]

@timelyportfolio Hello! Not to be a bother, but do you think my best bet is to build the map ahead of time as cenuno suggested?

[jplecavalier]

I don't want to rush anybody, but I'm just curious if #598 is scheduled to be merge soon? I have to work with massive shapefiles of thousands of complex polygons and I will have to consider another R solution than leaflet if this issue is not addressed soon. Thanks for your wonderful work! :smile:

[PetraOleum]

Yeah, this would be so very useful

[timelyportfolio]

@PetraOleum @jplecavalier @jrisi256 I'm not sure why @edwindj #598 has not been accepted or discussed. In my mind his changes should work perfectly. I had considered this solved. Here is how to use it without the pull request. We'll need to add the JavaScript methods with tags$script and then insert the R functions in your session. Once we have the code available to both R and JavaScript, the lines at the end demonstrate where the style changes setShapeStyle(layerId = ~NAME_1, fillColor=input$color, color = input$color). I am happy to discuss further if my quick answer is not sufficient.

All at Once - Ugly and Intimidating

library(shiny)
library(leaflet)

# add in methods from https://github.com/rstudio/leaflet/pull/598
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)
}

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);
}

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);
}

coor <- sp::coordinates(gadmCHE)

ui <- fluidPage(
  tags$head(
    # add in methods from https://github.com/rstudio/leaflet/pull/598
    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]);
    }
  });
};

window.LeafletWidget.methods.setRadius = function(layerId, radius){
  var map = this;
  if (!layerId){
    return;
  } else if (!(typeof(layerId) === "object" && layerId.length)){ // in case a single layerid is given
    layerId = [layerId];
    radius = [radius];
  }

  layerId.forEach(function(d,i){
    var layer = map.layerManager.getLayer("marker", d);
    if (layer){ // or should this raise an error?
      layer.setRadius(radius[i]);
    }
  });
};
'
    ))
  ),
  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)

Cleaner and Maybe Less Scary

The code looks like a lot since we have to manually add the JavaScript and R functions. I'll do a slightly different example below where we use sf and separate the JS/R additions to hopefully make the code less scary.

Add the R + JS from pull 598

### R functions
# add in methods from https://github.com/rstudio/leaflet/pull/598
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)
}

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);
}

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);
}

### JS methods
leafletjs <-  tags$head(
    # add in methods from https://github.com/rstudio/leaflet/pull/598
    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]);
    }
  });
};

window.LeafletWidget.methods.setRadius = function(layerId, radius){
  var map = this;
  if (!layerId){
    return;
  } else if (!(typeof(layerId) === "object" && layerId.length)){ // in case a single layerid is given
    layerId = [layerId];
    radius = [radius];
  }

  layerId.forEach(function(d,i){
    var layer = map.layerManager.getLayer("marker", d);
    if (layer){ // or should this raise an error?
      layer.setRadius(radius[i]);
    }
  });
};
'
    ))
  )

Shiny app

Then I think the code becomes much less intimidating (run above first).

library(sf)
library(scales) # to color our shapes
library(shiny)
library(leaflet)

gadsf <- sf::st_as_sf(gadmCHE)
# add some random data to gadsf that we will color
#  this could be done on the fly if data supported it
gadsf$random1 <- scales::col_quantile(domain = c(0,100),palette="Set1")(runif(nrow(gadsf),0,100))
gadsf$random2 <- scales::col_factor(domain = NULL,palette="Accent")(LETTERS[runif(nrow(gadsf),1,4)])

ui <- fluidPage(
  leafletjs,
  leafletOutput("map"),
  # set our options to our random data variable names
  radioButtons("color", "Color", choices = c("random1", "random2"))
)

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

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

}

shinyApp(ui, server)

[PetraOleum]

You're a lifesaver (or at least a data-and-timesaver). Thanks a bunch!

Hopefully the changes will be merged in a future version

[martinzuba]

This is awesome. I will try to use it to update labels too.

This is how I did it:

Javascript:

window.LeafletWidget.methods.setLabel = function(category, layerId, label){
  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
  //label = HTMLWidgets.dataframeToD3(label);
  //console.log(label);

  layerId.forEach(function(d,i){
    var layer = map.layerManager.getLayer(category, d);
    if (layer){ // or should this raise an error?
      // layer.setStyle(style[i]);
      layer.unbindTooltip();
      layer.bindTooltip(label[i])
    }
  });
};

R function:

setShapeLabel <- function( map, data = getMapData(map), layerId,
                           label = NULL,
                           options = NULL
){
  options <- c(list(layerId = layerId),
               options,
               filterNULL(list(label = label
               )))
  # 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, "setLabel", "shape", layerId, label);
}

[DavZim]

This is indeed wonderful. One quick question that I have regarding this solution, is it possible to also update the label of shapes?

[NandhiniS08]

And also is it possible to the popup content also through leaflet proxy?

[fnisiyama]

Hi, I'm having an issue while adapting @edwindj setShapesStyle function to my own situation.

This is the piece of code of the server function where I'm having some problems:

 output$mapa_uf <- renderLeaflet({
    leaflet(data = uf_shp) %>%
      addPolygons(layerId = uf_shp$geocodigo, weight = 1, color = "white")
  })

  result<- reactive({
          ind_UF(dt_Sinan, dict_Sinan, input$indx_ind, input$rd_forma,
          input$ano_slider, input$n_sub,pop_UF, uf_shp)
    })

  observe({
    colorpal <- result()
    leafletProxy("mapa_uf", data = uf_shp) %>%
      setShapeStyle(layerId = uf_shp$geocodigo, fillColor = colorpal)
  })

I came up with this based on the example given by @timelyportfolio. but in my situation I'm assigning to fillColor a variable (colorpal) which is calculated inside a reactive expression by the function ind_UF(). This function basically returns a vector of colors with the same size of my shapefile (uf_shp) and take as arguments the inputs given by my controls.

When I run the app the polygons do not change their colors as I modify my inputs.

I've already tried using addPolygons instead of setShapeStyle, whithin the observer, using the same reactive arrange shown above and had the expected results.

I was wondering if someone had issues similar to this.

Thanks!

Edit 1: I've tested my shapefile (uf_shp) in the simple example provided by @timelyportfolio and had good results.

[Dennishi0925]

Hi, I'm having an issue while adapting @edwindj setShapesStyle function to my own situation.

This is the piece of code of the server function where I'm having some problems:

output$mapa_uf <- renderLeaflet({
   leaflet(data = uf_shp) %>%
     addPolygons(layerId = uf_shp$geocodigo, weight = 1, color = "white")
 })

 result<- reactive({
         ind_UF(dt_Sinan, dict_Sinan, input$indx_ind, input$rd_forma,
         input$ano_slider, input$n_sub,pop_UF, uf_shp)
   })

 observe({
   colorpal <- result()
   leafletProxy("mapa_uf", data = uf_shp) %>%
     setShapeStyle(layerId = uf_shp$geocodigo, fillColor = colorpal)
 })

I came up with this based on the example given by @timelyportfolio. but in my situation I'm assigning to fillColor a variable (colorpal) which is calculated inside a reactive expression by the function ind_UF(). This function basically returns a vector of colors with the same size of my shapefile (uf_shp) and take as arguments the inputs given by my controls.

When I run the app the polygons do not change their colors as I modify my inputs.

I've already tried using addPolygons instead of setShapeStyle, whithin the observer, using the same reactive arrange shown above and had the expected results.

I was wondering if someone had issues similar to this.

Thanks!

Edit 1: I've tested my shapefile (uf_shp) in the simple example provided by @timelyportfolio and had good results.

Have you solved this? Thanks.

[mrecos]

Updating @martinzuba's post and addressing @DavZim's question: I have extended this to update labels in the same way. I used this for labelling hex grid cells with a value, so had to cast from integer array to string. Your use case may vary, but the important fix was subsetting the JS object label to get the label element from it. Thanks @timelyportfolio for the great work!

JS function to include in your app

window.LeafletWidget.methods.setLabel = function(category, layerId, label){
  var map = this;
  if (!layerId){
    return;
  } else if (!(typeof(layerId) === "object" && layerId.length)){ // in case a single layerid is given
    layerId = [layerId];
  }

  layerId.forEach(function(d,i){
    var layer = map.layerManager.getLayer(category, d);
    if (layer){ // or should this raise an error?
      layer.unbindTooltip();
      // the object subsetting to get the integer array and casting to string is what I added
      layer.bindTooltip(label.label[i].toString());
    }
  });
};

The R function:

setShapeLabel <- function( map, data = getMapData(map), layerId,
                           label = NULL,
                           options = NULL
){
  cat("in setShapeLabel","\n")
  options <- c(list(layerId = layerId),
               options,
               filterNULL(list(label = label
               )))
  # 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]]
  label <- options[-1] # drop layer column

  # typo fixed in this line
  leaflet::invokeMethod(map, data, "setLabel", "shape", layerId, label);
}

And I call this in Shiny via calls in leafletProxy:

  leafletProxy("mymap", data = my_data) %>%
      # in my code label() is a reactiveVal() that computes the numerical value
      setShapeLabel(layerId = ~ID, label = label()) %>% 
      setShapeStyle( ... use as indicated in earlier comments... ) %>% 

[JWilson2021]

EDITED - found a bug in the original post, and working through it, realized that the question of interest is something else. I'm running into an issue where I have an animation time series (slider over dates), with multiple points being present per day. I need these points colour-coded (in a palette set by the overall data - some days will have 1 point, others - many, and the colours need to stay consistent), but can't seem to make it happen with @timelyportfolio's setCircleMarkerStyle approach. Any help would be amazing. The example below runs (but requires @timelyportfolio's set of functions from earlier in the thread).

`

library(plyr)
library(dplyr)
library(tidyr)
library(shiny)
library(shinydashboard)
library(leaflet)

set.seed(0)
data <- expand.grid(Date = seq(as.Date("2003-01-15"), as.Date("2003-01-20"), 1), Group = c("A", "B")) %>%
    mutate(Lon = rnorm(n(), -105.57, 0.1), 
            Lat = rnorm(n(), 64.86, 0.1))
data$Lab <- paste(data$Group, data$Date)

ui <- fluidPage(
  tags$head(
# add in methods from https://github.com/rstudio/leaflet/pull/598
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]);
    }
  });
};

window.LeafletWidget.methods.setRadius = function(layerId, radius){
  var map = this;
  if (!layerId){
return;
  } else if (!(typeof(layerId) === "object" && layerId.length)){ // in case a single layerid is given
layerId = [layerId];
radius = [radius];
  }

  layerId.forEach(function(d,i){
var layer = map.layerManager.getLayer("marker", d);
if (layer){ // or should this raise an error?
  layer.setRadius(radius[i]);
    }
  });
    };
    '
    ))),
  leafletOutput("map"),
  sliderInput("Date", "Date", min = min(data$Date), max = max(data$Date), value=min(data$Date), animate = TRUE)
    )

server <- function(input, output, session){
  pal <- colorFactor("RdYlBu", domain = sort(unique(data$Group)))
  output$map <- renderLeaflet({
leaflet(data=data) %>%
  addCircleMarkers(layerId = ~Lab, lng = ~Lon, lat = ~Lat, weight = 1, opacity = 0, fillOpacity = 0) %>%
  addLegend(title = "Group", position = "topleft", pal = pal, values = ~data$Group)                 
  })

  observe({
  pal <- colorFactor("RdYlBu", domain = sort(unique(data$Group)))
layers <- unique(data[grepl(input$Date, data$Lab),]$Lab)
if(length(layers) > 0){
    leafletProxy("map", data = data) %>%
  setCircleMarkerStyle(layerId = layers, fillColor = ~pal(Group), color = ~pal(Group),
    opacity = 0.5, fillOpacity = 0.5) %>%
  setCircleMarkerStyle(data = data[!data$Lab %in% layers,], 
    layerId = ~Lab, opacity = 0, fillOpacity = 0)
                        }

if(length(layers) == 0){
    leafletProxy("map", data = data) %>%
   setCircleMarkerStyle(data = data[!data$Lab %in% layers,], 
    layerId = ~Lab, opacity = 0, fillOpacity = 0)
                        }                           
  })  
    }

shinyApp(ui, server)    

`

[JWilson2021]

Is it possible to use this solution by referencing group rather than layerId? I'm plotting ~50K rows and the recolouring of each individual layerId is really slowing down my app animation. I'm wondering if updating style by group would resolve this issue (I only have ~500 groups on the map)... Any thoughts?

[Ferdinandinio]

I think I second @JWilson2021's reply. I tried using the approach above but I cannot get the polygons to recolor at all with my data. The most optimal option here would be to if setShapeStyle would work exactly 1:1 like addPolygons but with just recoloring instead of redrawing the polygons. Would anyone know how to replace addPolygons with setShapeStyle in my case?

My data is a spatialpolygonsdataframe, where the first column is the country iso and the second the country name. The following columns include the data that should be displayed. I designed my shiny app to make it possible to display the data of a certain column based on input selections. Here is an example of how the data is structured:

I would go and select the columns with the selection input, where choice1 could be col_1 and thus poly1[input$choice1] would be poly1["col_1"]. (see filtereddata below)

my_map <- leaflet(poly, options = leafletOptions(minZoom = 2, maxZoom = 7, worldCopyJump = T)) %>%
                  addProviderTiles(providers$CartoDB.Positron, options = providerTileOptions(noWrap = T)) %>%
                  addPolygons(fillColor = "grey", stroke = FALSE)

output$map <- renderLeaflet({my_map})

cchoices <- reactive(paste0(input$Indicator, input$TempRes)) # Combined choices of Indicator and TempRes return full Indicator name

    filteredData <- reactive({
        poly[cchoices()]

    observe({
        palette <- colorBin(bins=10, pretty=T,
                            palette = pal[[input$Indicator]],
                            domain = poly[[cchoices()]]
                            )

        leafletProxy("map", data = filteredData()) %>%
            clearControls() %>% clearPopups() %>%
            addPolygons(color = ~palette(poly[[cchoices()]]), label=poly$NAME_0, # data shown on hover
                                  weight = 1, popup=popupTable(pdata[, c(1, 2, grep(input$TempRes, names(poly)))], row.numbers = F, feature.id = F), 
                        fillOpacity = 0.7)  %>%
            addScaleBar(position = "bottomleft", options = scaleBarOptions()) %>%
            addLegend("topright", title=tcAttributes$Names[tcAttributes$Values==cchoices()], pal=palette, values=poly[[cchoices()]], na.label = "Missing", opacity=1)
            labelFormat(suffix=" ")
    })

Any help would be much appreciated!

[mrecos]

For anyone having issues with the polygons not changing color, despite everything looking right. The ID column in setShapeLabel(layerId = ~ID, label = label()) must be a character. All code being the same, if ID is numeric, it will not work. When I read in my data for mapping, I include mutate(ID = as.character(1:n())) as a step in my data ingest to make sure the ID is a character. I believe this stems from the behavior of the addlayer method of the layerManager class. The specific line checking for the string type is: let hasId = typeof(layerId) === "string";

https://github.com/rstudio/leaflet/blob/32cb9c5f49708a530b0a025b2e34129f3916bac7/javascript/src/layer-manager.js#L39

[daweller]

Hi! First of all, thanks for the great posts in this thread - I learned a lot about leaflet and shiny!

Currently, I'm trying to combine leaflet, shiny and shiny.i18n to have the labels of my leaflet maps (legend, base groups, etc.) translated automatically when users select another language via picker input. See here for an example: https://stackoverflow.com/questions/74941485/leaflet-map-crashes-on-recoloring-after-translation-shiny-leaflet-shiny-i18n

Unfortunately, the app crashes as soon as the language setting is changed, however, I have no idea if the problem is related to updating the polygon coloring or if the bug is somewhere else.

Any kind of help is greatly appreciated!

[mateolangston]

Has there been any progress on updating this feature? May I suggest an updatePolygons() function of some sort to match Shiny convention.