I'm trying to create a shinyapp using mapdeck that maps a variable based on some attributes. Basically, I select a city and then select an activity and a time threshold to produce the desirable map. Reproducible code below (make sure to use a 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)
I want to use the cool map transitions provided by mapdeck, so I create a basemap with zero zoom and then use the mapdeck_view function inside my shiny::observer so I can have the nice transition whenever I open the map or select a different city. I set the views based on cities centroids.
The problem is that the view (and the transition) also updates whenever I change the zoom inside the same city and then select different attributes (different activities or a different time threshold). I wish there was a way to keep the map in the same zoom while I change attributes within the same city, having transition only when I change cities.
I tried to play with shiny::isolate inside my observer but didn't succeed (nothing happened in this case):
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,
)
})
Appreciate any help. Thanks!
I think you need the city input and the time & activity inputs in different observers. This appears to achieve your desired behaviour.
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,
)
})