R Shiny Leaflet：单击形状并缩放到边界（使用地图包）

Question

由于某些原因，我仅限于使用 "maps" 包为以传单为中心的 R Shiny 应用程序生成地图（即我不能使用形状文件、栅格等。它必须是地图对象） ;但是，我运行陷入困境，我想添加一些功能。

我的目标是让用户点击美国的一个州，然后让应用缩放到该州的边界。我找到了一个不是真正的解决方案，但我真正需要的是使用 fitBounds() 或 setMaxBounds();但是，我不知道如何检索从鼠标单击事件中选择的状态的范围。

截至目前，我已经使用 setView() 为许多状态找到了 "pretty good" 缩放级别。但是，对于大国和小国，这根本行不通。

代码如下：

ui.R

 library(shiny)
 library(leaflet)

 shinyUI(fluidPage(
      fluidRow(
           tags$style(type = "text/css", "#livemap {height: calc(100vh - 80px) !important;}"),
           leafletOutput("livemap")
      )
 ))

server.R

 library(shiny)
 library(leaflet)
 library(maps)

 shinyServer(function(input, output){
      output$livemap <- renderLeaflet({
          mapStates <- map("state", fill = TRUE, plot = FALSE)

          leaflet(mapStates) %>%
               addTiles() %>%
               addPolygons(color = "#444444",
                           weight = 1,
                           smoothFactor = 0.5,
                           opacity = 1.0,
                           fillOpacity = 0.5,
                           fillColor = terrain.colors(50, alpha = 1),
                           highlightOptions = highlightOptions(color = "black", weight = 2, bringToFront = TRUE))
      })
      observe({
           click <- input$livemap_shape_click
           proxy <- leafletProxy("livemap")
           if(is.null(click))
                return()
           proxy %>% setView(lng = click$lng, lat = click$lat, zoom = 7)
      })
 })

Answer 1

扩展@JohnFriel 的建议，您可以通过为每个状态设置缩放级别，然后使用单击获得该缩放级别来实现此目的。

为此，您需要指定 layerId 值（在 addPolygons) 中，以便传单知道您点击了哪个形状。然后您可以访问 zoom 值来自这个 id

查看我为更改添加到代码中的注释

library(shiny)
library(leaflet)
library(maps)

ui <- shinyUI(fluidPage(
    fluidRow(
        tags$style(type = "text/css", "#livemap {height: calc(100vh - 80px) !important;}"),
        leafletOutput("livemap")
    )
))


server <- shinyServer(function(input, output){
    output$livemap <- renderLeaflet({
        mapStates <- map("state", fill = TRUE, plot = FALSE)

        ## chuck on a zoom
        mapStates$zoom <- sample(5:8, size = length(mapStates$name), replace = T)

        leaflet(mapStates) %>%
            addTiles() %>%
            addPolygons(color = "#444444",
                                    weight = 1,
                                    layerId = ~mapStates$name,   ## LayerID defined
                                    smoothFactor = 0.5,
                                    opacity = 1.0,
                                    fillOpacity = 0.5,
                                    fillColor = terrain.colors(50, alpha = 1),
                                    highlightOptions = highlightOptions(color = "black", weight = 2, 
                                                                                                            bringToFront = TRUE))
    })

    observe({
        click <- input$livemap_shape_click
        if(is.null(click))
            return()

        ## use the click to access the zoom and set the view according to these
        ## the click$id is now returned with the 'name' of the state
        ## because we specified it in the LayerId argument
        idx <- which(mapStates$name == click$id)
        z <- mapStates$zoom[[idx]]

        leafletProxy("livemap") %>% 
            setView(lng = click$lng, lat = click$lat, zoom = z)
    })
})

shinyApp(ui, server)

Answer 2

非常感谢@SymbolixAU 和@JohnFriel，我能够实现我正在寻找的功能。关键是设置 "layer" ID。下面的代码允许我缩放到每个州的适当级别。此外，当用户在形状区域外单击时，地图将恢复为默认的 "USA" 地图和缩放级别。

ui.R

 library(shiny)
 library(leaflet)

 shinyUI(fluidPage(
      fluidRow(
           tags$style(type = "text/css", "#livemap {height: calc(100vh - 80px) !important;}),
           leafletOutput("livemap")
      )
  ))

server.R

  library(shiny)
  library(leaflet)
  library(maps)

  shinyServer(function(input, output){
       output$livemap <- renderLeaflet({
            mapStates <- map("state", fill = TRUE, plot = FALSE)
            mapStates$zoom <- c(7.3, 7.1, 7.5, 6.2, 7.2, 9.2, 4.0, 7.0,
                                7.3, 6.5, 7.0, 7.4, 7.5, 7.5, 7.8, 7.4,
                                7.1, 8.3, 8.6, 8.6, 8.6, 7.0, 7.0, 6.7,
                                7.3, 7.2, 7.0, 7.5, 6.6, 7.8, 8.0, 7.0,
                                7.2, 7.2, 7.2, 7.2, 7.6, 7.6, 7.6, 7.4,
                                7.6, 7.6, 7.2, 7.6, 9.4, 7.8, 7.4, 7.6,
                                6.2, 7.0, 8.0, 7.6, 7.6, 7.6, 7.3, 7.3,
                                7.3, 7.3, 7.3, 7.6, 7.2, 7.2)
           leaflet(mapStates) %>%
                addTiles() %>%
                addPolygons(color = "#444444",
                            weight = 1,
                            layer = ~mapStates$names,
                            smoothFactor = 0.5,
                            opacity = 1.0,
                            fillOpacity = 0.5,
                            fillColor = terrain.colors(50, alpha = 1),
                            highlightOptions = highlightOptions(color = "black",
                                                                weight = 2,
                                                                bringToFront = TRUE))
       })
       # Observe click on shapes (i.e., states)
       observe({
            click <- input$livemap_shape_click
            if(is.null(click))
                 return()
            idx <- which(mapStates$names == click$id)
            # Get zoom level for the state
            z <- mapStates$zoom[[idx]]
            # Get state name to render new map
            idx <- mapStates$names[[idx]]
            mapInd <- map("county", idx, fill = TRUE, plot = FALSE)

            leafletProxy("livemap") %>%
                 clearShapes() %>%
                 addPolygons(data = mapInd,
                             color = "#444444",
                             weight = 1,
                             smoothFactor = 0.5,
                             opacity = 1.0,
                             fillOpacity = 0.5,
                             fillColor = terrain.colors(10, alpha = 1)) %>%
                 setView(lng = ((mapInd$range[[1]] + mapInd$range[[2]])/2),
                         lat = ((mapInd$range[[3]] + mapInd$range[[4]])/2),
                         zoom = z)
       })
       # Observe click outside of shapes (i.e., reset the map to the "USA" original)
       observe({
            click <- input$livemap_click
            if(is.null(click))
                 return()
            leafletProxy("livemap") %>%
                 clearShapes() %>%
                 addPolygons(data = mapStates,
                             color = "#444444",
                             weight = 1,
                             layer = ~mapStates$names,
                             smoothFactor = 0.5,
                             opacity = 1.0,
                             fillOpacity = 0.5,
                             fillColor = terrain.colors(50, alpha = 1),
                             highlightOptions = highlightOptions(color = "black",
                                                                 weight = 2,
                                                                 bringToFront = TRUE)) %>%
                 setView(lng = ((mapStates$range[[1]] + mapStates$range[[2]])/2),
                         lat = ((mapStates$range[[3]] + mapStates$range[[4]])/2),
                         zoom = 4)
       })

  })

R Shiny Leaflet：单击形状并缩放到边界（使用地图包）

R Shiny Leaflet: Click on Shape and Zoom to Bounds (using maps package)

maps

r

mouseevent

leaflet

shiny