Question

我正在R mapdeck应用中制作shiny地图，该应用的功能是将用户带到位置列表的按钮。用户单击actionButton（演示），然后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)

Answer 1

在找到合适的解决方案之前，您可以发送自定义“消息”以闪亮地直接调用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)

如何依次运行多个`mapdeck_view`调用？

1 个答案: