r - How can I improve Leaflet rendering speed in Shiny?

Question

I've created a Shiny app (currently in progress at https://iseak.shinyapps.io/obsv_nac/ ) that has a Leaflet map of Spain with colored polygons that change based on user inputs. User inputs are defined in the left-hand column and in a year (slider) below the map.

The issue is that the year slider takes some time to update, and since I'd like to add a "play" button functionality to the slider (so that users can see how the map changes over time just by clicking play instead of having to move the slider to each year individually) it doesn't work very well. Does anyone have any suggestions on how to improve Leaflet rendering speed? Currently the code is:

1. Base map using renderLeaflet
2. Reactive values based on user input
3. Update map using leaflet proxy and reactive values

###>>Base leaflet map ---------
output$mapa = renderLeaflet({ leaflet( options = leafletOptions(zoomControl = F,
                                                                zoomSnap  = 0.1,
                                                                zoomDelta = 0.1
)
) %>%
    setView(lat = 39.138348,
            lng = -4.001968,
            zoom = 5.9) %>%
    addProviderTiles(provider="CartoDB.Positron") %>%
    htmlwidgets::onRender("function(el, x) {
                                       L.control.zoom({ position: 'topright' }).addTo(this)
                                   }") 
  
})

###>>Reactive vals mapa ----------
indic_reactive_mapa <- reactive({
  indic <- paste(colectivo_reactive(),
                 indic_reactive(),
                 input$anyo_sel,
                 sep = "_")
})

#Subset data (reactive)
data_ccaa_subset <- reactive({
  req(indic_reactive_mapa() %in% colnames(data_ccaa_geo_df@data))
  data_ccaa_subset      <- data_ccaa_geo_df
  data_ccaa_subset@data <- data_ccaa_geo_df@data %>%
    select(all_of(c("CCAA", indic_reactive_mapa()))) %>%
    rename(indic = 2)
  return(data_ccaa_subset)
})

#Pal (palette) (also reactive)
pal     <- reactive({
  domain  <- domains_ccaa[,indic_reactive()]
  pal_temp <- colorQuantile(palette = "Reds",
                            domain  = domain,
                            n = 100)
  
  return(pal_temp)
})

#Info on hover (reactive)
hover_info <- reactive({
  temp_data <- data_ccaa_subset()
  indic <- indic_reactive()
  
  if (grepl("P_", indic)){
    labels <- sprintf(
      "<strong>%s</strong><br/>%s<br/>Más información al clickar",
      temp_data$CCAA, paste0(prettyNum(temp_data$indic),"%")
    ) %>% lapply(htmltools::HTML)
  } else{
  
  labels <- sprintf(
    "<strong>%s</strong><br/>%s<br/>Más información al clickar",
    temp_data$CCAA, prettyNum(temp_data$indic)
  ) %>% lapply(htmltools::HTML)
  }
  return(labels)
})


###>>Update map based on reactive values -----
observe({
  temp_data <- data_ccaa_subset()
  leafletProxy(mapId = "mapa",
               data = data_ccaa_subset()) %>%
    clearShapes() %>%
    addRectangles(
      lng1=-6.674509, lat1=36.397682,
      lng2=-12.233590, lat2=34.010148,
      fillColor = "#282828",
      fillOpacity = 0.2,
      weight = 1,
      color = "transparent",
    ) %>%
    addPolygons(fillColor = ~pal()(indic),
                opacity   = 0.8,
                weight = 0.3,
                color = "white",
                fillOpacity = 0.95, 
                smoothFactor = 0.5,
                label = hover_info(),
                highlight = highlightOptions(
                  weight = 1.5,
                  color = "#333333",
                  bringToFront = T),
                popup = texto_popup_mapa(),
                layerId = ~CCAA
    )
  
})

Thank you in advance for any suggestions!

Answer 1

等待大神答复