在 shiny|mapdeck 中更改属性时保持地图缩放(在同一城市内)
Keep map zoom (inside same city) while changing attributes in shiny|mapdeck
我正在尝试使用 mapdeck
创建一个基于某些属性映射变量的 shinyapp。基本上,我 select 一个城市,然后 select 一个 activity 和一个时间阈值来生成理想的地图。下面的可重现代码(确保使用 mapbox API):
library(shiny)
library(dplyr)
library(mapdeck)
library(sf)
ui <- shinyUI(fluidPage(
selectInput(inputId = "city",
label = h1("Pick city:"),
choices = c("Belo Horizonte" = "bho",
"Fortaleza" = "for"),
selected = "bho"),
selectInput(inputId = "activity",
label = h1("Pick activity:"),
choices = c("TT", "ST"),
selected = "TT"),
sliderInput(inputId = "time",
label = h1("Pick time threshold:"),
min = 30, max = 120,
step = 30, value = 30,
animate = TRUE),
mapdeckOutput("map")
)
)
# SERVER --------------------------------------------------------------------------------------
# Define a server for the Shiny app
server <- shinyServer(function(input, output) {
data <- readRDS(url("https://github.com/kauebraga/misc/raw/master/data.rds"), "rb")
centroids <- data.frame(sigla_muni = c("for", "bho"),
lon = c(-38.52770, -43.95988),
lat = c( -3.785656, -19.902739))
# register mapbox api key
mapdeck::set_token("YOUR_API")
# reactive for the city
city_filtered <- reactive({
data %>% filter(sigla_muni == input$city)
})
# reactive for the activity
activity_filtered <- reactive({
city_filtered() %>% dplyr::filter(activity == input$activity)
})
# Reactive for time threshold
time_filtered <- reactive({
activity_filtered() %>% dplyr::filter(time_threshold == input$time)
})
# initialize baseMap
output$map <- renderMapdeck({
mapdeck(location = c(-43.95988, -19.902739), zoom = 0)
})
#
observe({
centroids_city <- filter(centroids, sigla_muni == input$city)
mapdeck_update(map_id = "map") %>%
mapdeck_view(location = c(centroids_city$lon, centroids_city$lat), zoom = 10,
duration = 3000,
transition = "fly")
a <- mapdeck_update(map_id = "map") %>%
add_polygon(
data = time_filtered(),
fill_colour = "value",
fill_opacity = 200,
layer_id = "acess",
palette = "inferno",
update_view = FALSE,
focus_layer = FALSE,
)
})
}
)
shinyApp(ui = ui, server = server)
我想使用 mapdeck
提供的炫酷地图转换,所以我创建了一个零缩放底图,然后在我的 shiny::observer
中使用 mapdeck_view
函数,这样我就可以拥有每当我打开地图或 select 一个不同的城市时,都会有很好的过渡。我根据城市质心设置视图。
问题是,每当我在同一城市内更改缩放比例然后 select 不同的属性(不同的活动或不同的时间阈值)时,视图(和过渡)也会更新。我希望有一种方法可以在同一城市内更改属性时使地图保持相同的缩放比例,仅在更改城市时才进行转换。
我尝试在我的观察者中使用 shiny::isolate
但没有成功(在这种情况下什么也没发生):
observe({
isolate({
centroids_city <- filter(centroids, sigla_muni == input$city)
mapdeck_update(map_id = "map") %>%
mapdeck_view(location = c(centroids_city$lon, centroids_city$lat), zoom = 10,
duration = 3000,
transition = "fly")
})
a <- mapdeck_update(map_id = "map") %>%
add_polygon(
data = time_filtered(),
fill_colour = "value",
fill_opacity = 200,
layer_id = "acess_cum",
palette = "inferno",
update_view = FALSE,
focus_layer = FALSE,
)
})
感谢任何帮助。谢谢!
我认为您需要在不同的观察者中输入城市和时间 & activity 输入。这似乎实现了您想要的行为。
observe({
centroids_city <- filter(centroids, sigla_muni == input$city)
mapdeck_update(map_id = "map") %>%
mapdeck_view(location = c(centroids_city$lon, centroids_city$lat), zoom = 10,
duration = 3000,
transition = "fly")
})
observeEvent({c(input$time, input$activity, input$city)},{
print(" -- changing -- ")
sf <- time_filtered()
print( unique( sf$sigla_muni ) )
print( unique( sf$time_threshold ) )
print( unique( sf$activity ) )
mapdeck_update(map_id = "map") %>%
add_polygon(
data = sf,
fill_colour = "value",
fill_opacity = 200,
layer_id = "acess",
palette = "inferno",
update_view = FALSE,
focus_layer = FALSE,
)
})
我正在尝试使用 mapdeck
创建一个基于某些属性映射变量的 shinyapp。基本上,我 select 一个城市,然后 select 一个 activity 和一个时间阈值来生成理想的地图。下面的可重现代码(确保使用 mapbox API):
library(shiny)
library(dplyr)
library(mapdeck)
library(sf)
ui <- shinyUI(fluidPage(
selectInput(inputId = "city",
label = h1("Pick city:"),
choices = c("Belo Horizonte" = "bho",
"Fortaleza" = "for"),
selected = "bho"),
selectInput(inputId = "activity",
label = h1("Pick activity:"),
choices = c("TT", "ST"),
selected = "TT"),
sliderInput(inputId = "time",
label = h1("Pick time threshold:"),
min = 30, max = 120,
step = 30, value = 30,
animate = TRUE),
mapdeckOutput("map")
)
)
# SERVER --------------------------------------------------------------------------------------
# Define a server for the Shiny app
server <- shinyServer(function(input, output) {
data <- readRDS(url("https://github.com/kauebraga/misc/raw/master/data.rds"), "rb")
centroids <- data.frame(sigla_muni = c("for", "bho"),
lon = c(-38.52770, -43.95988),
lat = c( -3.785656, -19.902739))
# register mapbox api key
mapdeck::set_token("YOUR_API")
# reactive for the city
city_filtered <- reactive({
data %>% filter(sigla_muni == input$city)
})
# reactive for the activity
activity_filtered <- reactive({
city_filtered() %>% dplyr::filter(activity == input$activity)
})
# Reactive for time threshold
time_filtered <- reactive({
activity_filtered() %>% dplyr::filter(time_threshold == input$time)
})
# initialize baseMap
output$map <- renderMapdeck({
mapdeck(location = c(-43.95988, -19.902739), zoom = 0)
})
#
observe({
centroids_city <- filter(centroids, sigla_muni == input$city)
mapdeck_update(map_id = "map") %>%
mapdeck_view(location = c(centroids_city$lon, centroids_city$lat), zoom = 10,
duration = 3000,
transition = "fly")
a <- mapdeck_update(map_id = "map") %>%
add_polygon(
data = time_filtered(),
fill_colour = "value",
fill_opacity = 200,
layer_id = "acess",
palette = "inferno",
update_view = FALSE,
focus_layer = FALSE,
)
})
}
)
shinyApp(ui = ui, server = server)
我想使用 mapdeck
提供的炫酷地图转换,所以我创建了一个零缩放底图,然后在我的 shiny::observer
中使用 mapdeck_view
函数,这样我就可以拥有每当我打开地图或 select 一个不同的城市时,都会有很好的过渡。我根据城市质心设置视图。
问题是,每当我在同一城市内更改缩放比例然后 select 不同的属性(不同的活动或不同的时间阈值)时,视图(和过渡)也会更新。我希望有一种方法可以在同一城市内更改属性时使地图保持相同的缩放比例,仅在更改城市时才进行转换。
我尝试在我的观察者中使用 shiny::isolate
但没有成功(在这种情况下什么也没发生):
observe({
isolate({
centroids_city <- filter(centroids, sigla_muni == input$city)
mapdeck_update(map_id = "map") %>%
mapdeck_view(location = c(centroids_city$lon, centroids_city$lat), zoom = 10,
duration = 3000,
transition = "fly")
})
a <- mapdeck_update(map_id = "map") %>%
add_polygon(
data = time_filtered(),
fill_colour = "value",
fill_opacity = 200,
layer_id = "acess_cum",
palette = "inferno",
update_view = FALSE,
focus_layer = FALSE,
)
})
感谢任何帮助。谢谢!
我认为您需要在不同的观察者中输入城市和时间 & activity 输入。这似乎实现了您想要的行为。
observe({
centroids_city <- filter(centroids, sigla_muni == input$city)
mapdeck_update(map_id = "map") %>%
mapdeck_view(location = c(centroids_city$lon, centroids_city$lat), zoom = 10,
duration = 3000,
transition = "fly")
})
observeEvent({c(input$time, input$activity, input$city)},{
print(" -- changing -- ")
sf <- time_filtered()
print( unique( sf$sigla_muni ) )
print( unique( sf$time_threshold ) )
print( unique( sf$activity ) )
mapdeck_update(map_id = "map") %>%
add_polygon(
data = sf,
fill_colour = "value",
fill_opacity = 200,
layer_id = "acess",
palette = "inferno",
update_view = FALSE,
focus_layer = FALSE,
)
})