R Shiny Leaflet: нажмите на Shape и Zoom to Bounds (используя пакет карт)
По причинам, я ограничен использованием пакета "maps" для генерации карт для листовочного приложения 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 ответа
Огромное спасибо @SymbolixAU и @JohnFriel, и я смог достичь той функциональности, которую искал. Ключом была установка идентификатора слоя. Код ниже позволяет мне приближаться к соответствующему уровню для каждого состояния. Кроме того, когда пользователь щелкает за пределами области формы, карта возвращается к карте по умолчанию "США" и уровню масштабирования.
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)
})
})
Разобравшись с предложением @JohnFriel, вы можете достичь этого, установив уровень масштабирования для каждого состояния, а затем используя щелчок, чтобы получить этот уровень масштабирования.
Чтобы это работало, вам нужно указать layerId значение (в addPolygons) так что листовка знает, на какую форму вы нажали. Вы можете получить доступ к 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)