rshinyr-leaflet

leafletProxy only triggering on input change


I have a leaflet map which renders different polygons based off of a picker input. For some reason, leafletProxy will only render if the picker is changed, even though the observe({}) event it's wrapped inside will trigger when the app loads. Is there some way I can fix this?

The map is also slow to update when the picker is changed - is there a way for me to speed this up, just as an aside?

I've included a very simplified version of the code I'm using here. Unfortunately, the data is sensitive so I cannot share it.

library(shiny)
library(shinythemes)
library(shinydashboard)
library(shinydashboardPlus)
library(shinyjs)
library(shinyWidgets)
library(leaflet)
library(tidyverse)
library(feather)
library(sf)
library(viridis)

ui <- fluidPage(
  useShinyjs(),
  
  theme = shinytheme("cerulean"),

  useShinydashboard(),
  
  tabsetPanel(
    tabPanel(
      "Tab 1",
      pickerInput(
        width = "100%", 
        inputId = "indicator_input",
        label = "Select an indicator on the map:", 
        choices = list(
         "Choice 1", "Choice 2", "Choice 3"
        ),
        options = list(`style` = "btn-primary")
      ),
      leafletOutput("example1")
    )
  )

   
)

# Define server logic required to draw a histogram
server <- function(input, output, session) {
  #Label object
  example_labels <- reactive({
    labels <- paste0(

      "<strong>", "Polygon name: ", "</strong>", shapedata$polygon_name,"<br>",

      "<strong>", "Indicator 1: ", "</strong>",
      shapedata$indicator_1, "%", "<br>",

      "<strong>", "Indicator 2: ", "</strong>",
      shapedata$indicator_2, "%", "<br>"
    ) %>% lapply(htmltools::HTML)
    return(cald_labels)
  })
  
  # Start initial leaflet render
  output$example1 <- renderLeaflet({
    glimpse("Loaded")
    leaflet(shapedata) %>%
      addProviderTiles(leaflet::providers$Esri.WorldImagery) %>%
      setView(lng = 133.7751, lat = -25.2744, zoom = 4)
    
  }) # end leaflet output
  
  observe({
    glimpse("Observe triggered")
    map_pal <- colorBin(palette = mako(10), 
                        domain = shapedata[[input$indicator_input]], 
                        bins=10,
                         na.color = "grey", 
                         reverse = TRUE)
    leafletProxy(
      "example1",
      data = shapedata
    ) %>%
      addPolygons(
        layerId = shapedata$polygon_name,
        fillColor = ~map_pal(shapedata[[input$indicator_input]]),
        weight = 2,
        color = "white",
        fillOpacity = 0.9,
        label = example_labels(),
        labelOptions = labelOptions(#labels
          style = list("font-weight" = "normal",
                       padding = "3px 3px"),
          textsize = "10px",
          direction = "auto")
      ) %>%
      clearControls() %>%
      addLegend(pal = map_pal, 
                title = "Decile", 
                opacity = 0.9, 
                values = ~shapedata[[input$indicator_input]],
                labels = c(min(input$indicator_input), max(input$indicator_input)),
                position = "topright")
  })
}

# Run the application 
shinyApp(ui = ui, server = server)

Solution

  • The issue was caused by the same problem, and solved by the same solution, as here.