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