r - 使用 setView 更新 Leaflet Map Shiny Dashboard

Question

我正在尝试创建一个 Shiny 的传单 map ，它会生成整个 map ，但会根据所选的输入放大特定坐标。如果我将其包含在渲染传单部分中，它会变得非常慢。因此我尝试使用观察。

编辑:添加了美国各州的示例。选择工作正常，但如何放大选择后的状态？

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)

如果您删除观察部分但不放大该州，仅显示整个 map ，则它会起作用。我怎样才能正确添加这个？

Answer 1

对于寻找答案的其他人，我能找到的唯一方法是向 UI 添加一个操作按钮并从那里调用它:

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)

当放大到更详细的 map 时，与以前相比，它可以立即工作