Использование plotlyProxy для обновления трассировки plot_mapbox в приложении Shiny

Question

Я занимаюсь разработкой приложения R Shiny для визуализации позиций объектов во времени. Цель состоит в том, чтобы использовать ползунок времени для постепенного «воспроизведения» позиций вперед и назад, чтобы понять схемы движения. В настоящее время я сопоставляю позиции с использованием plotly и функции plot_mapbox, потому что мне нравится интерфейс, удобные всплывающие подсказки, возможность подключения к другим графикам с помощью crosstalk и т. Д. Однако я изо всех сил пытаюсь определить, как использовать plotlyProxy чтобы не перерисовывать всю карту (вместе с повторным увеличением) с каждым шагом по времени.

Пример приложения приведен ниже (хотя я понимаю, что для этого потребуется бесплатный ключ Mapbox). Ниже я также включил версию приложения, которая использует leaflet и leafletProxy, которая работает в некоторой степени (она перерисовывает всю трассу с каждым временным шагом, но по крайней мере не перерисовывает всю карту, что хорошо) , Note: points are added to the eastern end of the trace

Я рассмотрел несколько примеров использования plotlyProxy для обновления трассировок, но я не смог адаптировать их к этой ситуации. https://plot.ly/r/plotlyproxy/. Используйте plotlyProxy для добавления нескольких трассировок при изменении данных Может ли кто-нибудь помочь уточнить, как я могу использовать plotlyProxy для обновления сопоставления в этой конкретной ситуации?

Кроме того, как ясно из примера листовки, обновление по-прежнему включает перерисовку всей трассы (полилинии, точки). Есть ли лучшая реализация, которая бы добавляла только новую линию / точку, а не всю трассу?

Пример Plotly

library(tidyverse)
library(shiny)
library(plotly)
library(shinydashboard)


#######################
# Define Sample Data
#######################

set.seed(45)
df <- tibble(
    date_times = seq.POSIXt(from = as.POSIXct('2017-01-01',
                                               tz = 'UTC'), 
                             to = as.POSIXct('2017-01-15', 
                                             tz = 'UTC'),
                             by = 10800),
    lon = c(seq(-170, -90, 
                 length.out = 113) + 
                 rnorm(n = 113, 
                       mean = 2, 
                       sd = 1)),
    lat = c(seq(-5, 10, 
                 length.out = 113) + 
                 rnorm(n = 113, 
                       mean = 2, 
                       sd = 1)),
    speed = abs(rnorm(n = 113, 
                       mean = 6, 
                       sd = 2))
)



#############################################
# Define UI for application
#############################################

tz = 'UTC'

ui <- dashboardPage(
  dashboardHeader(
    title = "Track",
    titleWidth = 100
  ),
  dashboardSidebar(sliderInput("date_slide", "Dates",
    min = as.POSIXct("2017-01-01", tz = tz), 
    max = as.POSIXct("2017-02-01", tz = tz),
    value = c(as.POSIXct("2017-01-01", tz = tz), 
              as.POSIXct("2017-01-05", tz = tz)), 
    step = 10800,
    timeFormat = "%F %T", 
    timezone = "+0000", 
    animate = animationOptions(interval = 500)
  )),
  dashboardBody(
    fluidRow(
      column(
        width = 12,
        box(
          width = NULL,
          height = 700,
          solidHeader = FALSE,
          status = "primary",
          plotlyOutput("map", height = "650px")
        )
      )
    )
  )
)

#############################################
# Define SERVER logic for application
#############################################
server <- function(input, output, session) {

  ###########################################
  # ADD YOUR MAXBOX KEY HERE OR IN .Renviron #
  ###########################################
  # Sys.setenv('MAPBOX_TOKEN' = 'mapbox_key')

  filterData <- reactive({
    req(df)
    df[as.POSIXct(df$date_times) > input$date_slide[1] & 
           as.POSIXct(df$date_times) < input$date_slide[2], ]
  })

  dataset_sf <- reactive({
    data_file_sf <- sf::st_as_sf(filterData(), coords = c("lon", "lat"))
    data_file_sf
  })

  output$map <- renderPlotly({
    plot_mapbox() %>%
      # add_sf(data = land_sf, plot = FALSE, fill = TRUE, showlegend = FALSE) %>%
      add_sf(
        data = dataset_sf(),
        mode = "markers+lines",
        color = ~speed,
        hoverinfo = "text",
        text = ~ paste(date_times)
      ) %>%
      layout(mapbox = list(
        zoom = 2,
        center = list(
          lon = ~ mean(df$lon),
          lat = ~ mean(df$lat)
        ),
        style = "dark"
      ))
  })
}

#############################################
# Run the application
#############################################
shinyApp(ui = ui, server = server)

Пример листовки (использует тот же набор данных, что и выше)

tz = 'UTC'

library(tidyverse)
library(shiny)
library(leaflet)


#############################################
# Define UI for application
#############################################

ui <- bootstrapPage(
       tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
       leafletOutput("map", width = "100%", height = "100%"),
       absolutePanel(top = 10, right = 10,
                    sliderInput('date_slide','Dates',
                                min = as.POSIXct('2017-01-01', tz = tz), 
                                max = as.POSIXct('2017-02-01', tz = tz),
                                value = c(as.POSIXct('2017-01-01', tz = tz),
                                          as.POSIXct('2017-01-05', tz = tz)), 
                                step = 10800,
                                timeFormat = "%F %T",
                                timezone = "+0000", 
                                animate = animationOptions(interval = 500))
    )
)


#############################################
# Define SERVER logic for application
#############################################
server <- function(input, output, session) {


    filterData <- reactive({
        df[as.POSIXct(df$date_times) > input$date_slide[1] & 
               as.POSIXct(df$date_times) < input$date_slide[2],]

    })



    observe({

        pal <- colorNumeric(
        palette = "viridis",
        domain = filterData()$speed)

        leafletProxy("map", data = filterData()) %>%
            clearMarkers() %>%
            clearShapes() %>%
            addPolylines(
                lng = ~lon,
                lat = ~lat, 
                color = '#365474', 
                weight = 2) %>%
        addCircles(
          radius = 10,
          color =  ~pal(speed),
          stroke = FALSE,
          fillOpacity = 0.8
        )
    })

    output$map <-
        renderLeaflet({
            leaflet() %>%
                addProviderTiles("CartoDB.DarkMatter") %>%
                fitBounds(-170,-20,-90,20)
        })
}

#############################################
# Run the application
#############################################
shinyApp(ui = ui, server = server)