Update Leaflet Map Shiny Dashboard with setView

Question

I am trying to create a leaflet map in shiny which generates the whole map, but zooms in on specific coordinates based on the input selected. If I include this in the render leaflet section it becomes extremely slow. I'm therefore trying to use observe.

Edit: Added example with US states. The select works fine, but how can I zoom in on a state once selected?

library(spData)
data(us_states)
us_states <- us_states 

# Add lat/long
library(dplyr)
library(sf)
us_geom <- as.data.frame(us_states %>% st_coordinates()) %>%
           group_by(L3) %>%
           summarise(lat = mean(Y), long = mean(X))
us_states$lat <- us_geom$lat
us_states$long <- us_geom$long
us_states$REGION <- as.character(us_states$REGION)
us_states$NAME <- as.character(us_states$NAME)
us_states2 <- as_Spatial(us_states)
us_states2 <- as.data.frame(us_states2@data)

# Add pallette for leaflet
pal <- colorBin("RdYlBu", domain = c(0,1000000), bins = 12, reverse = 
                                                      TRUE)

ui <- dashboardPage(
      skin = "red",
    dashboardHeader(title = "Dashboard"),
    dashboardSidebar(
    selectInput('select_region', 'Region: ', choices = 
             unique(as.character(us_states$REGION))),
    uiOutput("select_state")
       ),
   dashboardBody(
    fluidRow(column(width = 12, leafletOutput(outputId = "mymap")))
   )
)

server <- function(input, output) {

     output$select_state <- renderUI({
         selectInput("User1", "State: ", choices = 
           as.character(us_states2[us_states2$REGION==input$select_region,
                                                            "NAME"]))
     })



     data_input <- reactive({
                     us_states  %>% 
                     dplyr::filter(REGION == input$select_region &
                               NAME == input$User1 ) 
     })

     data_input2 <- reactive({
                     us_states2  %>% 
                     dplyr::filter(REGION == input$select_region &
                               NAME == input$User1 ) 
     })


     output$mymap <- renderLeaflet({
                   leaflet(us_states) %>%
                   addTiles() %>%
                   addPolygons(
                    fillColor = ~pal(total_pop_10))
     })

     observe({
          leafletProxy("mymap")   %>%
              setView(
              lng = as.numeric(data_input2() %>% select(long)),
              lat = as.numeric(data_input2() %>% select(lat)),
              zoom = 7)
     })


}

shinyApp(ui, server)

It works if you remove the observe section but does not zoom in on the state, just shows the whole map. How can I add this correctly?

Answer 1

For anyone else looking for an answer, the only way I can find to do it is to add an action button to the UI and call it from there:

ui <- dashboardPage(
  skin = "red",
  dashboardHeader(title = "Dashboard"),
  dashboardSidebar(
    selectInput('select_region', 'Region: ', choices = 
    unique(as.character(us_states$REGION))),
    uiOutput("select_state"),
    actionButton("update_view", "update_view")
  ),
  dashboardBody(
    fluidRow(column(width = 12, leafletOutput(outputId = "mymap")))
  )

)

server <- function(input, output, session) {

   output$select_state <- renderUI({
   selectInput("User1", "State: ", choices = 
     as.character(us_states2[us_states2$REGION==input$select_region,
                                                            "NAME"]))
  })


   data_input <- reactive({
      us_states  %>% 
      dplyr::filter(REGION == input$select_region &
                    NAME == input$User1 ) 
  })

  data_input2 <- reactive({
        us_states2  %>% 
          dplyr::filter(REGION == input$select_region &
                        NAME == input$User1 ) 
  })


  output$mymap <- renderLeaflet({
        leaflet(us_states) %>%
         addTiles() %>%
         addPolygons(
         fillColor = ~pal(total_pop_10)) }) 


  observeEvent(input$update_view, {

      leafletProxy("mymap", session)   %>%
             setView(
               lng = as.numeric(data_input2() %>% select(long)),
               lat = as.numeric(data_input2() %>% select(lat)),
               zoom = 7  )
 })


}

shinyApp(ui, server)

When scaled up on a much more detailed map it works instantly compared with before