R 地图框/绘图，带有动画和形状文件

Question

我正在制作一个动画，显示地图上绘制的空间数据，并带有基于日期的动画滑块。除此之外，我想绘制一个随时间变化的形状文件。 我的动画在没有 shapefile 的情况下也能正常工作。绘制标记和 shapefile 不会显示 shapefile（似乎是

add_sf

和我不理解的

layout

规范之间的某种脱节），并且还会破坏动画。如何才能使这些协同工作？我认为我需要坚持使用

plot_ly

规范（而不是

plot_mapbox

）以使实际绘图的其他组件协同工作（这里 和 这里）。

library(sf)
library(dplyr)
library(plotly)

nc <- st_read(system.file("shape/nc.shp", package="sf")) %>%
      select(AREA) %>%
       sf::st_cast("MULTILINESTRING") %>%
       sf::st_cast("LINESTRING")
df <- expand.grid(x = seq(-76, -84, -2), y = seq(34, 36, 1),
                  Date = seq(as.Date("2000-01-01"), as.Date("2000-04-01"), by = "1 day")) %>%
      mutate(x = rnorm(n(), x, 1),
              y = rnorm(n(), y, 1),
             Date = as.factor(Date))


df %>%
  plot_ly(lon = ~x, lat = ~y, frame = ~Date, 
          type = "scattermapbox", mode = "markers") %>%
  ######### this line breaks the animation and doesn't show the sf. Uncomment to check
  #########add_sf(data = nc, inherit = FALSE, color = I("white")) %>%
  layout(mapbox = list(style = "white-bg", sourcetype = 'raster', zoom = 4,
                     center = list(lon = -80 ,lat= 35),
                     layers = list(list(below = 'traces', sourcetype = "raster",
                                        source = list("https://basemap.nationalmap.gov/arcgis/rest/services/USGSImageryOnly/MapServer/tile/{z}/{y}/{x}"))))) 

Answer 1

我猜您正在寻找的是动画期间北卡罗来纳州各县的静态轮廓。如果这是一个准确的假设，那么这将起作用。我尝试了几种不同的方法，因为我不明白为什么 Plotly 在翻译中如此迷失。但是，我只能通过解决方法使其正常运行（相对于绘图参数或类似的东西）。

首先，我将向您展示我的解决方案。

然后我有一个你知道吗？和一个也许这看起来会更好一点，如果...

剧情

我创建了两个

scattermapbox

图并将它们与 UDF 组合起来。我基本上使用了你的代码，但同时制作了两个

scattermapbox

（而不是一个

scattermapbox

和一个

add_sf

）。

library(sf)
library(dplyr)
library(plotly)

nc <- st_read(system.file("shape/nc.shp", package="sf")) %>%
  select(AREA) %>%
  sf::st_cast("MULTILINESTRING") %>%
  sf::st_cast("LINESTRING")

df <- expand.grid(x = seq(-76, -84, -2), y = seq(34, 36, 1),
                  Date = seq(as.Date("2000-01-01"), as.Date("2000-04-01"), by = "1 day")) %>%
  mutate(x = rnorm(n(), x, 1),
         y = rnorm(n(), y, 1),
         Date = as.factor(Date))


p1 <- plot_ly(data = df, lon = ~x, lat = ~y, frame = ~Date, 
              type = "scattermapbox", mode = "markers") %>%
  layout(mapbox = list(style = "white-bg", sourcetype = 'raster', zoom = 4,
                       center = list(lon = -80 ,lat= 35),
                       layers = list(list(below = 'traces', sourcetype = "raster",
                                          source = list("https://basemap.nationalmap.gov/arcgis/rest/services/USGSImageryOnly/MapServer/tile/{z}/{y}/{x}"))))) 

p2 <- plot_ly(data = nc, type = "scattermapbox", color = I("white")) %>%
  layout(mapbox = list(style = "white-bg", sourcetype = 'raster', zoom = 4,
                       center = list(lon = -80 ,lat= 35),
                       layers = list(list(below = 'traces', sourcetype = "raster",
                                          source = list("https://basemap.nationalmap.gov/arcgis/rest/services/USGSImageryOnly/MapServer/tile/{z}/{y}/{x}"))))) 

在 UDF 中，我从

lines

图中获取

data = nc

轨迹，并将该数据添加到另一个图中。

fixer <- function(plt1, plt2) {
  # where plt1 has frames and plt2 does not
  # get lines' trace from plt2
  # add lines' trace data to plt1$x$data 
  plt1 <- plotly_build(plt1); plt2 <- plotly_build(plt2)  # prep by building
  lines2 <- lapply(1:length(plt2$x$data), function(i) {
    if(plt2$x$data[[i]]$mode == "lines") {   # extract index for combined plot
      return(i)
    }
  }) %>% unlist()
  plt1$x$data <- append(plt1$x$data, plt2$x$data[lines2]) # add data to plt1
  plt1   # return modified plot
}
fixer(p1, p2)

你知道吗？

您使用

nc

和

select

对

st_cast

数据做了一些额外的工作。然而，这项工作并没有改变任何东西......我不确定目标是什么。

要创建相同的地图，您可以保留数据不变并将

fill = "none"

添加到轨迹中。

这是一个直观的解释。

nc2 <- st_read(system.file("shape/nc.shp", package="sf"))

p3 <- plot_ly(data = nc2, fill = "none", type = "scattermapbox", color = I("white")) %>%
  layout(mapbox = list(style = "white-bg", sourcetype = 'raster', zoom = 4,
                       center = list(lon = -80 ,lat= 35),
                       layers = list(list(below = 'traces', sourcetype = "raster",
                                          source = list("https://basemap.nationalmap.gov/arcgis/rest/services/USGSImageryOnly/MapServer/tile/{z}/{y}/{x}"))))) 
fixer(p1, p3)

如果...看起来可能会好一点

我注意到线条太粗，很难看清动画，所以我想我应该添加

scattermapbox

中的默认线条是

line = list(width = 2)

。在此变体中，我使用原始

nc

数据并将线宽减半。 （不过还是很招摇。）

p4 <- plot_ly(data = nc2, fill = "none", type = "scattermapbox", color = I("white"), 
              line = list(width = 1)) %>%
  layout(mapbox = list(style = "white-bg", sourcetype = 'raster', zoom = 4,
                       center = list(lon = -80 ,lat= 35),
                       layers = list(list(below = 'traces', sourcetype = "raster",
                                          source = list("https://basemap.nationalmap.gov/arcgis/rest/services/USGSImageryOnly/MapServer/tile/{z}/{y}/{x}"))))) 
fixer(p1, p4)

所有代码全部

这里将所有代码（上面分解）集中在一个地方（更容易复制+粘贴等等）。

library(sf)
library(dplyr)
library(plotly)

nc <- st_read(system.file("shape/nc.shp", package="sf")) %>%
  select(AREA) %>%
  sf::st_cast("MULTILINESTRING") %>%
  sf::st_cast("LINESTRING")

df <- expand.grid(x = seq(-76, -84, -2), y = seq(34, 36, 1),
                  Date = seq(as.Date("2000-01-01"), as.Date("2000-04-01"), by = "1 day")) %>%
  mutate(x = rnorm(n(), x, 1),
         y = rnorm(n(), y, 1),
         Date = as.factor(Date))

#---------------------------- basic fix ----------------------------
p1 <- plot_ly(data = df, lon = ~x, lat = ~y, frame = ~Date, 
              type = "scattermapbox", mode = "markers") %>%
  layout(mapbox = list(style = "white-bg", sourcetype = 'raster', zoom = 4,
                       center = list(lon = -80 ,lat= 35),
                       layers = list(list(below = 'traces', sourcetype = "raster",
                                          source = list("https://basemap.nationalmap.gov/arcgis/rest/services/USGSImageryOnly/MapServer/tile/{z}/{y}/{x}"))))) 

p2 <- plot_ly(data = nc, type = "scattermapbox", color = I("white")) %>%
  layout(mapbox = list(style = "white-bg", sourcetype = 'raster', zoom = 4,
                       center = list(lon = -80 ,lat= 35),
                       layers = list(list(below = 'traces', sourcetype = "raster",
                                          source = list("https://basemap.nationalmap.gov/arcgis/rest/services/USGSImageryOnly/MapServer/tile/{z}/{y}/{x}"))))) 


fixer <- function(plt1, plt2) {
  # where plt1 has frames and plt2 does not
  # get lines' trace from plt2
  # add lines' trace data to plt1$x$data 
  plt1 <- plotly_build(plt1); plt2 <- plotly_build(plt2)  # prep by building
  lines2 <- lapply(1:length(plt2$x$data), function(i) {
    if(plt2$x$data[[i]]$mode == "lines") {   # extract index for combined plot
      return(i)
    }
  }) %>% unlist()
  plt1$x$data <- append(plt1$x$data, plt2$x$data[lines2]) # add data to plt1
  plt1   # return modified plot
}
fixer(p1, p2)


#---------------------- using NC data as is-------------------------
nc2 <- st_read(system.file("shape/nc.shp", package="sf"))

p3 <- plot_ly(data = nc2, fill = "none", type = "scattermapbox", color = I("white")) %>%
  layout(mapbox = list(style = "white-bg", sourcetype = 'raster', zoom = 4,
                       center = list(lon = -80 ,lat= 35),
                       layers = list(list(below = 'traces', sourcetype = "raster",
                                          source = list("https://basemap.nationalmap.gov/arcgis/rest/services/USGSImageryOnly/MapServer/tile/{z}/{y}/{x}"))))) 
fixer(p1, p3)

#----------- basic NC data & different line aesthetics -------------
p4 <- plot_ly(data = nc2, fill = "none", type = "scattermapbox", color = I("white"), 
              line = list(width = 1)) %>%
  layout(mapbox = list(style = "white-bg", sourcetype = 'raster', zoom = 4,
                       center = list(lon = -80 ,lat= 35),
                       layers = list(list(below = 'traces', sourcetype = "raster",
                                          source = list("https://basemap.nationalmap.gov/arcgis/rest/services/USGSImageryOnly/MapServer/tile/{z}/{y}/{x}"))))) 
fixer(p1, p4)