How to run multiple `mapdeck_view` calls sequentially?

Question

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)

Answer 1

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)