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?

Does the code produce any errors? or does the map just sit there and not do anything? — Nate
If I remove the observe part I get the map which just sits there. When I add the observe I get the "Result must have length 10000, not 0" error — prmlmu
hmm that is weird, I wonder if it is something with the data you are using (i.e. subsetting gone wrong)...would you consider sharing it via dropbox or updating the example to run with some packaged data like data <- sf::st_read(system.file("shape/nc.shp", package="sf")) — Nate

prmlmu prmlmu · Accepted Answer · 2019-10-02T13:23:40

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

Update Leaflet Map Shiny Dashboard with setView

1 Answers