How to Improve Leaflet Render Time

I would like to start off by apologizing for not providing the data but I am not at liberty to share the spatial data.

I have a shiny app with a leaflet/ tab in which the user can choose a date range, a national park, a species of interest, and finally the life stage of the species. The locations of where the species were encountered are then plotted on a leaflet map with addCircleMarkers which fall with in a polygon for the national park. The user can click on each unique spatial point and data associated with that encounter appears. I have provided the UI, Server, and Global below.

Currently it takes ~2 seconds for the data to appear on the map, another ~2 seconds for the map to respond if the user zooms, and another ~2 seconds for the map to re-render for the zoom. The lag is very challenging to work with.

I have already used ms_simplify(0.005) and observe() on the polygons and that did help. Looking through my UI, Server, and Global, where could I improve render time?

Global

if (!require(librarian)){
  install.packages("librarian")
  library(librarian)
}

# librarian downloads, if not already downloaded, and reads in needed packages

librarian::shelf(shiny, tidyverse, here, shinyWidgets, leafem, bslib, thematic, shinymanager, leaflet, ggrepel, sf, stringr,fontawesome,
                 shinycssloaders, shinydashboardPlus, lubridate, scales, 
                 rmapshaper)

#Bd data read in
bd_data <- read_csv(here("data", "bd_data.csv"))



#read in wilderness shape files
shape <- read_sf(here("data", "wilderness_shapes", "wilderness.shp")) %>% 
  mutate(names = gsub("_", " ", names),
         names = str_to_title(names)) %>% 
  ms_simplify(0.005)%>% 
  rename(wilderness = names)

#read in water types
water <- read_csv(here("data", "water_type.csv")) %>% 
  rename(id = lake_id)

#ves data read in
ves_data <- read_csv(here("data", "ves_data.csv")) %>% 
  left_join(bd_data) %>% 
  left_join(water)

# read in bd_plot data with month_year
bd_plot <- read_csv(here("data", "bd_plot.csv"))

# all visit data for map
all_visits <- read_csv(here("data", "all_visits.csv")) %>% 
  left_join(water, by = c("site_id" = "id"))

inactivity <- "function idleTimer() {
var t = setTimeout(logout, 120000);
window.onmousemove = resetTimer; // catches mouse movements
window.onmousedown = resetTimer; // catches mouse movements
window.onclick = resetTimer;     // catches mouse clicks
window.onscroll = resetTimer;    // catches scrolling
window.onkeypress = resetTimer;  //catches keyboard actions

function logout() {
window.close();  //close the window
}

function resetTimer() {
clearTimeout(t);
t = setTimeout(logout, 120000);  // time is in milliseconds (1000 is 1 second)
}
}
idleTimer();"

UI

ui <-  secure_app(head_auth = tags$script(inactivity), 
                  
    
    fluidPage(tags$head(
    
    
    
    tags$style(HTML("
      .shiny-output-error-validation {
        color: #ff0000;
        font-weight: bold;}"))),

    
    includeCSS(here("NPS_ShinyApp/theme.css")),
    
    #theme = theme,
    
    
    titlePanel(""),
    
    fluidPage(tabPanel(title = "Site Map", icon = icon("globe"),
                        
                        sidebarLayout(
                          
                          sidebarPanel(
                            sliderInput(inputId = "site_year",
                                        label = "Select an annual range",
                                        min = min(ves_data$date), max = max(ves_data$date), 
                                        value =  c(max(ves_data$date), max(ves_data$date)),
                                        sep = ""),
                            pickerInput(inputId = "wilderness",
                                        label = "Select a wilderness",
                                        choices = unique(ves_data$wilderness),
                                        multiple = F,
                                        options = pickerOptions(title = "Select Variable")),
                            pickerInput(inputId = "species",
                                        label = "Select a species",
                                        choices = unique(ves_data$species),
                                        options = pickerOptions(title = "Select Variable"),
                                        multiple = F),
                            pickerInput(inputId = "stage",
                                        label = "Select a life stage",
                                        choices = unique(ves_data$visual_life_stage),
                                        options = pickerOptions(title = "Select Variable"),
                                        multiple = F),
                            checkboxGroupButtons(inputId = "visits",
                                                 label = "All Sites Visited",
                                                 choices = c("Sites")),
                            h5("*Please be patient, map rendering can be delayed dependent on inputs*"),
                            hr(style = "border-top: 1px solid #000000;"),
                            checkboxGroupButtons(inputId = "clear",
                                                 label = "Clear Selection",
                                                 choices = c("Clear"))),
                          
                          mainPanel(withSpinner(leafletOutput(outputId = "site_map", width = 900, height = 500))))
                        
               )
    
    
)))

Server

server <- function(input, output, session){
  
  result_auth <- secure_server(check_credentials = check_credentials(credentials))
  
  output$res_auth <- renderPrint({
    reactiveValuesToList(result_auth)
  })

    #reactive ves map data frame filtering on year, wilderness, species, and life stage
    data_reactive <- reactive({
      
      
        ves_data %>%
            dplyr::filter(date <= input$site_year[2] & date >= input$site_year[1], wilderness == input$wilderness, 
                          species == input$species, visual_life_stage == input$stage) %>% 
        group_by(id, wilderness, species, visual_life_stage) %>% 
        mutate(sum_count = sum(count),
               med = mean(bd),
               bd = bd)
      
      
    })
    
    
    #reactive shape file for wilderness outlines
    
    shape_reactive <- reactive({

        shape %>%
            dplyr::filter(wilderness == input$wilderness)
    })
    
    # reactive for all visits
    
    visit_reactive <- reactive({
      
      all_visits %>% 
        filter(year <= input$site_year[2] & year >= input$site_year[1],
               wilderness == input$wilderness)
    })
    
  
    
    view <- reactive({

      shape %>%
        filter(wilderness == input$wilderness) %>%
        st_bbox(geometry) %>%
        as.vector()
    })

    
    # leaflet map with date, species, and site as reactive 
    output$site_map <- renderLeaflet({
      
      #OpenTopoMap
      #Esri.WorldTopoMap
      leaflet() %>% 
        addProviderTiles("OpenTopoMap") %>% 
        addMouseCoordinates() %>% 
        setView(lng = -119.36697, lat = 37.3, zoom = 7.25) %>% 
        addMeasure(
          position = "bottomleft",
          primaryLengthUnit = "feet",
          primaryAreaUnit = "sqfeet",
          activeColor = "#3D535D",
          completedColor = "#7D4479") 
        
     })

    
    observeEvent(c(input$site_year, input$wilderness), {

      leafletProxy("site_map") %>% 
        clearMarkers() %>% 
        clearShapes() %>% 
        fitBounds(view()[1], view()[2], view()[3], view()[4])  %>%
        
        addPolylines(data = shape_reactive()$geometry, color = "#0d0887", dashArray = T, opacity = 0.9, weight = 1.9,
                     label = paste("Wilderness:", shape_reactive()$wilderness),
                     popup = paste("<B>", input$site_year[1], "-", input$site_year[2], "Wilderness Totals <br>",
                                   
                                   "Wilderness:", shape_reactive()$wilderness, "<br>",
                                   
                                   paste(data_reactive()$visual_life_stage), paste(data_reactive()$species),
                                   "Median Wilderness log(Bd) Load:", round(data_reactive()$bd, 2), "<br>",
                                   
                                   paste(data_reactive()$visual_life_stage, paste(data_reactive()$species),
                                         "Count:", sum(data_reactive()$count)))) 

    })
    
    observeEvent(c(input$species, input$stage), {
      
      leafletProxy("site_map") %>%
        addCircleMarkers(data = data_reactive(), lng = ~long, lat = ~lat,  color = "#35b779", radius = 1, opacity = 0.05, 
                         fillOpacity = 0.05, weight = 5,
                         label = paste('Site:', data_reactive()$id),
                         popup = paste("<B>Year:",input$site_year[1], "-", input$site_year[2], "<br>",
                                       
                                       "Site:", data_reactive()$id, "(", paste(round(ves_data$lat, 3)),
                                       ",", paste(round(ves_data$long, 3)), ")", "<br>",
                                       
                                       "Water Type:", data_reactive()$lake_type, "<br>",
                                       
                                       data_reactive()$species, "Median log(Bd) Load:", round(data_reactive()$med, 2), "<br>",
                                       
                                       data_reactive()$visual_life_stage, data_reactive()$species, "Count:", data_reactive()$sum_count, "<br>"),
                         
                         popupOptions(closeOnClick = T))
      
    })
    
    observeEvent(input$visits, {
      
      leafletProxy("site_map") %>% 
        #clearMarkers() %>% 
        addCircleMarkers(data = visit_reactive(), lng = ~long, lat = ~lat, color = "#440154", radius = 1,
                         label = paste('Site:', visit_reactive()$site_id),
                         popup = paste("<B>Year:",input$site_year[1], "-", input$site_year[2], "<br>",
                                               
                                               "Site:", data_reactive()$id, "(", paste(round(ves_data$lat, 3)),
                                               ",", paste(round(ves_data$long, 3)), ")", "<br>",
                                               
                                               "Water Type:", data_reactive()$lake_type, "<br>")) %>% 
        
        addCircleMarkers(data = data_reactive(), lng = ~long, lat = ~lat,  color = "#35b779", radius = 1, opacity = 0.05, 
                         fillOpacity = 0.05, weight = 5,
                         label = paste('Site:', data_reactive()$id),
                         popup = paste("<B>Year:",input$site_year[1], "-", input$site_year[2], "<br>",
                                       
                                       "Site:", data_reactive()$id, "(", paste(round(ves_data$lat, 3)),
                                       ",", paste(round(ves_data$long, 3)), ")", "<br>",
                                       
                                       "Water Type:", data_reactive()$lake_type, "<br>",
                                       
                                       data_reactive()$species, "Median log(Bd) Load:", round(data_reactive()$med, 2), "<br>",
                                       
                                       data_reactive()$visual_life_stage, data_reactive()$species, "Count:", data_reactive()$sum_count, "<br>"),
                         
                         popupOptions(closeOnClick = T)) %>% 
        addLegend(position = c("bottomright"), title = "Organism Encounters", colors = c("#35b779", "#440154"), 
                  labels = c("Encounters", "No Encounters"))
      
      })
    
    
    observeEvent(input$clear, {
      updatePickerInput(session, "site_year", selected = "2021")
      updatePickerInput(session, "wilderness", selected = "")
      updatePickerInput(session, "species", selected = "")
      updatePickerInput(session, "stage", selected = "")
      updateCheckboxGroupButtons(session, "visits", selected = "")
      updateCheckboxGroupButtons(session, "clear", selected = "")
    })
    
    # observe events to update wilderness and years based on selection for leaflet map
    observeEvent(input$site_year, {
      
      updatePickerInput(session, inputId = "wilderness", 
                        choices = unique(ves_data$wilderness[ves_data$date <= input$site_year[2]
                                                             & ves_data$date >= input$site_year[1]]))
    })
    
    observeEvent(input$wilderness, {
      
      updatePickerInput(session, inputId = "species", 
                          choices = unique(ves_data$species[ves_data$date <= input$site_year[2]
                                                            & ves_data$date >= input$site_year[1] 
                                                            & ves_data$wilderness == input$wilderness]))
       
    })
    
    observeEvent(input$species, {
      
      updatePickerInput(session, inputId = "stage", 
                        choices = unique(ves_data$visual_life_stage[ves_data$date <= input$site_year[2]
                                                                    & ves_data$date >= input$site_year[1] 
                                                                    & ves_data$wilderness == input$wilderness 
                                                                    & ves_data$species == input$species]))
    })
    

This topic was automatically closed 54 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.