使用 setView 更新 Leaflet Map Shiny Dashboard答案

【问题标题】：Update Leaflet Map Shiny Dashboard with setView使用 setView 更新 Leaflet Map Shiny Dashboard
【发布时间】：2020-01-30 13:52:12
【问题描述】：

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

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

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)

如果您删除观察部分但不放大状态，它会起作用，只显示整个地图。如何正确添加？

【问题讨论】：

代码是否产生错误？还是地图只是坐在那里不做任何事情？
如果我删除了观察部分，我得到的地图就在那里。当我添加观察时，我得到“结果必须长度为 10000，而不是 0”错误
嗯，这很奇怪，我想知道这是否与您正在使用的数据有关（即子集出错）...您是否考虑通过保管箱共享它或更新示例以使用一些打包的运行data <- sf::st_read(system.file("shape/nc.shp", package="sf")) 之类的数据
查看更新示例
酷，我试试看！

标签： r shiny leaflet shinydashboard

【解决方案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)

当在更详细的地图上放大时，与以前相比，它立即生效

【讨论】：