R Shiny Leaflet：单击形状并缩放到边界（使用地图包）
2017-03-13
4963
由于某些原因，我只能使用“maps”包为以 leaflet 为中心的 R Shiny 应用程序生成地图（即，我不能使用形状文件、栅格等。它必须是地图对象）；但是，我遇到了一些我想添加的功能的障碍。
我的目标是允许用户单击美国的一个州，并让应用程序缩放到该州的边界。我找到了一个不太好的解决方案，但我真正需要的是使用 fitBounds() 或 setMaxBounds()；但是，我不知道如何检索从鼠标单击事件中选择的州的边界。
截至目前，我已经使用 setView() 为许多州找到了“相当不错”的缩放级别。但是，对于大州和小州，这根本行不通。
代码如下：
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)
})
})
2个回答
扩展@JohnFriel 的建议，您可以通过设置每个州的缩放级别，然后使用单击来获取该缩放级别来实现此目的。
要使其工作，您需要指定
layerId
值（在
addPolygons
中），以便 leaflet 知道您单击了哪个形状。然后，您可以从此 id 访问
zoom
值
查看我添加到代码中的更改的注释
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)
SymbolixAU
2017-03-13
非常感谢@SymbolixAU 和@JohnFriel，我能够实现我所寻找的功能。关键是设置“图层”ID。下面的代码允许我缩放到每个州的适当级别。此外，当用户点击形状区域外时，地图将恢复为默认的“美国”地图和缩放级别。
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)
})
})
sehock
2017-03-14