r - 车辆从 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。因此通过 B 创建使用相同起点和目的地 (A) 的单一路线可能行不通

# 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 对象，其中包含与您的行程一样多的行和恒定坐标(最好是 cornder 中的那个，可以通过 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")
})