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/。 Use plotlyProxy to add multiple traces when data changes有人可以帮助您说明在这种特殊情况下如何使用plotlyProxy更新映射吗？

此外，如传单示例所示，更新仍然涉及重绘整个迹线（折线，点）。有没有更好的实现，它只会添加新的线/点而不是整个轨迹？

密谋示例

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)

使用plotlyProxy更新Shiny应用中的plot_mapbox跟踪

0 个答案: