I'm making a mapdeck
map in an R shiny
app that features a button that takes the user to a list of locations. The user clicks on the actionButton
(Demo) and the observeEvent
function iterates over the list of locations, camera settings, etc and zooms to the locations using the movecam
function.
The problem I'm having is that the app doesn't wait for one zoom task to finish and immediately executes the next one. This results in only the last location being zoomed to. I tried making the app wait for the zoom tasks to finish using shinyjs::delay
and Sys.delay
in various places, but these functions don't seem to help in the way I need them. Any ideas?
I included a reproducible example that should zoom to three locations sequentially. You need to replace the dummy mapbox token for it to display a map, though.
library (mapdeck)
library (shiny)
library (shinyjs)
library (shinyWidgets)
ui <- shinyUI (pageWithSidebar (
headerPanel(title = "Demo"),
sidebarPanel = sidebarPanel (
actionButton ("demo", "Demo")
),
mainPanel = mainPanel (
useShinyjs (),
mapdeckOutput (outputId = "map", height = "900px", width = "100%")
)
))
movecam <- function (location, zoom, duration, transition = "fly", pitch,
bearing, delay)
{
print ("moving camera")
mapdeck_update (map_id = "map") %>%
mapdeck_view (location = location, zoom = zoom,
duration = duration, transition = transition,
pitch = pitch, bearing = bearing)
}
server <- function(input, output, session) {
observeEvent(input$demo, {
locations <- list (c (100, 30), # China
c (-75, -8), # Peru
c (23, -21)) # Botswana
zooms <- c (11, 12, 13)
durations <- c (3500, 2000, 5000)
pitches <- c (40, 50, 300)
bearings <- c (100, 400, 200)
for (i in seq_len (length (locations)))
{
delay <- durations [i]
if (i == 1)
delay <- 0
delay (delay,
movecam (location = locations [[i]], zoom = zooms [i],
duration = durations [i], transition = "fly", pitch = pitches [i],
bearing = bearings [i], delay = delay)
)
#Sys.sleep(delay / 1000)
}
})
output$map <- renderMapdeck({
mapdeck (token = "abcdef")
})
}
shinyApp (ui, server)
Until I find a proper solution, you can send a custom "message" to shiny to call the md_change_location()
Javascript function directly
library (mapdeck)
library (shiny)
ui <- shinyUI (pageWithSidebar (
headerPanel(title = "Demo"),
sidebarPanel = sidebarPanel (
actionButton ("demo", "Demo")
),
mainPanel = mainPanel (
tags$head(
tags$script(
"Shiny.addCustomMessageHandler('move_cam', function( args ) {
console.log('custom message');
var map_id = args[0];
var map_type = args[1];
var location = args[2];
var zoom = args[3];
var pitch = args[4];
var bearing = args[5];
var duration = args[6];
var transition = args[7];
md_change_location( map_id, map_type, location, zoom, pitch, bearing, duration, transition );
});"
)
),
mapdeckOutput (outputId = "map", height = "900px", width = "100%")
)
))
server <- function(input, output, session) {
observeEvent(input$demo, {
locations <- list (c (100, 30), # China
c (-75, -8), # Peru
c (23, -21)) # Botswana
zooms <- c (11, 12, 13)
durations <- c (3500, 2000, 5000)
pitches <- c (40, 50, 300)
bearings <- c (100, 400, 200)
for (i in seq_len (length (locations)))
{
print(paste0("going to ", paste0(locations[[i]], collapse = ",") ) )
args <- list( "map", "mapdeck", locations[[i]], zooms[i], pitches[i], bearings[i], durations[i], "fly" )
js_args <- jsonify::to_json( args, unbox = T )
session$sendCustomMessage(
"move_cam",
js_args
)
Sys.sleep(durations[i] / 1000)
}
})
output$map <- renderMapdeck({
mapdeck ()
})
}
shinyApp (ui, server)