沿路线从 A 到 B 然后从 B 到 A 的车辆动画（在 B 处有一些等待时间）

Question

下面是动画车辆从 A 移动到 B 的示例。[由 @mrhellmann here 解决，也有可用的解决方案]

我想让车辆从 A 移动到 B，然后在 B 等待一段时间，然后返回 A。下面是包含行程动画（A-B 和 B-A）的代码。

1. 我们如何合并osroute_sampled_1 和osroute_sampled_2 来创建单个动画？

2. 另外，我们如何增加等待时间（让车辆在 B 处静止几秒钟？

注意 - 车辆可能无法返回 A，它可能会前往 C。因此使用相同的起点和目的地 (A) 通过 B 创建单一路线可能不起作用

# load packages
library(sf)
library(dplyr)
library(tidygeocoder)
library(osrm)
library(tmap)
library(gifski)


# 1. One World Trade Center, NYC
# 2. Madison Square Park, NYC
adresses <- c("285 Fulton St, New York, NY 10007", 
              "11 Madison Ave, New York, NY 10010")

# geocode the two addresses & transform to {sf} data structure
data <- tidygeocoder::geo(adresses, method = "osm") %>% 
  st_as_sf(coords = c("long", "lat"), crs = 4326)

# route from One World Trade Center to Madison Square
osroute_1 <- osrm::osrmRoute(loc = data,
                           returnclass = "sf")
# route from Madison Square to One World Trade Center
osroute_2 <- osrm::osrmRoute(loc = data %>% arrange(-row_number()),
                             returnclass = "sf")

summary(osroute_1)
summary(osroute_2)

# sample osroute 50 times regularly, cast to POINT, return sf (not sfc) object
osroute_sampled_1 <- st_sample(osroute_1, type = 'regular', size = 50) %>%
  st_cast('POINT') %>%
  st_as_sf() 

# sample osroute 50 times regularly, cast to POINT, return sf (not sfc) object
osroute_sampled_2 <- st_sample(osroute_2, type = 'regular', size = 50) %>%
  st_cast('POINT') %>%
  st_as_sf() 

# use lapply to crate animation maps. taken from reference page:
#  https://mtennekes.github.io/tmap/reference/tmap_animation.html
m1 <- lapply(seq_along(1:nrow(osroute_sampled_1)), function(point){
  x <- osroute_sampled_1[point,]   ## bracketted subsetting to get only 1 point
  tm_shape(osroute_1) +            ## full route
    tm_sf() +
    tm_shape(data) +             ## markers for start/end points
    tm_markers() +
    tm_shape(x) +                ## single point
    tm_sf(col = 'red', size = 3)
})

# Render the animation
tmap_animation(m1, width = 300, height = 600, delay = 10)


# use lapply to crate animation maps. taken from reference page:
#  https://mtennekes.github.io/tmap/reference/tmap_animation.html
m2 <- lapply(seq_along(1:nrow(osroute_sampled_2)), function(point){
  x <- osroute_sampled_2[point,]   ## bracketted subsetting to get only 1 point
  tm_shape(osroute_2) +            ## full route
    tm_sf() +
    tm_shape(data) +             ## markers for start/end points
    tm_markers() +
    tm_shape(x) +                ## single point
    tm_sf(col = 'red', size = 3)
})

# Render the animation
tmap_animation(m2, width = 300, height = 600, delay = 10)

Answer 1

要为动画添加时间戳，可以按照以下方法：

1. 创建一个sf 对象，其中包含与您的行程一样多的行和恒定坐标（最好是角落里的那个，可以通过st_bbox 找到）。
2. 将信息文本作为一列添加到此sf。
3. 在您的循环中添加另一个具有此计时的层 sf 并使用 tm_text 显示时间戳：

timings <- st_sf(geometry  = st_sfc(do.call(st_point, 
                                            list(unname(st_bbox(osroute_sampled_total)[3:2])))),
                 timestamp = seq(Sys.time(), by = "min", ## add whatever you want
                                 length.out = nrow(osroute_sampled_total)),
                 crs = st_crs(osroute_sampled_total))
m1 <- lapply(seq_along(1:nrow(osroute_sampled_total)), function(point){
  x <- osroute_sampled_total[point,]   ## bracketted subsetting to get only 1 point
  tm_shape(osroute_total) +            ## full route
    tm_sf() +
    tm_shape(data) +             ## markers for start/end points
    tm_markers() +
    tm_shape(x) +                ## single point
    tm_sf(col = 'red', size = 3) +
    tm_shape(timings[point, ]) +
       tm_text("timestamp", just = "right")
})

Answer 2

免责声明

以前从未真正与 sf 和朋友合作过，但在阅读文档后，我可以想象这样的解决方案可以满足您的需求。

想法

由于sf 实际上是扩展data.frames，它们自然带有rbind 功能。话虽如此，整个任务应该像rbind'将所有相关路径放在一起一样简单。至于等待时间，只需将sf 中的最后一行重复几次，这会给您一种车辆停在 B 的印象（以及返回途中的 A）。

代码

osroute_sampled_wait_1 <- osroute_sampled_1[rep(nrow(osroute_sampled_1), 10), ]
osroute_sampled_wait_2 <- osroute_sampled_2[rep(nrow(osroute_sampled_2), 10), ]
osroute_sampled_total <- rbind(osroute_sampled_1, osroute_sampled_wait_1, osroute_sampled_2, osroute_sampled_wait_2)
osroute_total <- rbind(osroute_1, osroute_2)

# use lapply to crate animation maps. taken from reference page:
#  https://mtennekes.github.io/tmap/reference/tmap_animation.html
m1 <- lapply(seq_along(1:nrow(osroute_sampled_total)), function(point){
  x <- osroute_sampled_total[point,]   ## bracketted subsetting to get only 1 point
  tm_shape(osroute_total) +            ## full route
    tm_sf() +
    tm_shape(data) +             ## markers for start/end points
    tm_markers() +
    tm_shape(x) +                ## single point
    tm_sf(col = 'red', size = 3)
})


# Render the animation
tmap_animation(m1, width = 300, height = 600, delay = 10)