1

我正在mapdeckR 应用程序中制作地图，该shiny应用程序具有一个按钮，可将用户带到位置列表。用户单击actionButton(Demo)，该observeEvent函数会遍历位置列表、相机设置等，并使用该movecam函数缩放到位置。

我遇到的问题是该应用程序不会等待一个缩放任务完成并立即执行下一个缩放任务。这导致仅缩放到最后一个位置。我尝试让应用程序等待缩放任务完成使用shinyjs::delay并Sys.delay在各个地方完成，但这些功能似乎对我需要它们的方式没有帮助。有任何想法吗？

我包含了一个可重现的示例，该示例应按顺序缩放到三个位置。不过，您需要替换虚拟地图框标记才能显示地图。

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)
4

1 回答 1

2

在我找到合适的解决方案之前，您可以向闪亮发送自定义“消息”以md_change_location()直接调用 Javascript 函数

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)
于 2019-07-25T23:32:35.430 回答