程序员经验分享-hwhale

R mapbox / 带有动画和 shapefile 的绘图

2024-05-02

我正在制作一个动画，显示地图上绘制的空间数据，并带有基于日期的动画滑块。除此之外，我想绘制一个随时间变化的形状文件。 我的动画在没有 shapefile 的情况下也能正常工作。绘制标记和形状文件不会显示形状文件（似乎是两者之间的某种脱节add_sf和layout我不明白的规格），并且还破坏了动画。如何才能使这些协同工作？我想我需要坚持plot_ly规范（相对于plot_mapbox）使我的实际情节的其他组成部分一起工作（here https://stackoverflow.com/questions/77145055/r-plotly-display-image-on-hover-in-a-map/77145696?noredirect=1#comment136069467_77145696 and here https://stackoverflow.com/questions/76906457/plotly-map-and-plot-with-shared-animation).

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}")))))

Add-On

要更改跟踪的顺序，必须做两件事：文字跟踪顺序和分配给每个帧的跟踪索引。我原来的答案中的所有内容仍然适用，但代替fixer()， 这是fixer2()

fixer2 <- function(plt1, plt2) {
  # change the order of the traces (considering fixer())
  # where plt1 has frames and plt2 does not
  # get lines' trace from plt2, add to plt1 as the first trace
  # change the 'trace' index in each frame in plt1$x$frames
  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(plt2$x$data[lines2], plt1$x$data) # add data diff order
  lapply(1:length(plt1$x$frames), function(j) {    # change frames trace index
    plt1$x$frames[[j]]$traces <<- 1 + plt1$x$frames[[j]]$traces
  }) # this assumes scatter is one color
  plt1   # return modified plot
}
fixer2(p1, p2)

原始答案（附加组件之前）

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

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

然后我有一个你可知道？ and a 也许这看起来会好一点，如果......

The plot

我创建了两个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 and 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 is 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)
本文内容由网友自发贡献，版权归原作者所有，本站不承担相应法律责任。如您发现有涉嫌抄袭侵权的内容，请联系:hwhale#tublm.com(使用前将#替换为@)

r

Animation

plotly

mapbox

R mapbox / 带有动画和 shapefile 的绘图 的相关文章

随机推荐

热门标签