由于原因，我只能使用＆＃34;地图＆＃34;包以生成以传单为中心的R Shiny应用程序的地图（即我不能使用形状文件，栅格等。它必须是地图对象）;但是，我遇到了一些我希望添加的功能。
我的目标是允许用户点击美国的州并让应用缩放到州的边界。我找到了一个不太实际的解决方案，但我真正需要的是使用fitBounds（）或setMaxBounds（）;但是，我不知道如何检索从鼠标单击事件中选择的状态的边界。
截至目前，我已经找到了一个非常好的＆＃34;使用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)
})
})
答案 0 :(得分：0)
扩展@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)
答案 1 :(得分：0)
非常感谢@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)
})
})