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

Question

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

我想制作从 A 到 B 的车辆动画，然后在 B 等待一段时间，然后 return 到 A。下面是包含这两个行程（A-B 和 B-A）的动画的代码。

我们如何合并osroute_sampled_1和osroute_sampled_2来创建单个动画？
另外，如何增加等待时间（让车辆在B站静止几秒？

注意 - 车辆可能不会 return 到 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

免责声明

以前从未真正与 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)

Answer 2

要为动画添加时间戳，您可以采用以下方法：

创建一个 sf 对象，其行数与您的行程一样多，坐标不变（最好是角落里的那个，可以通过 st_bbox 找到）。
将信息文本作为一列添加到此 sf。
在您的循环中添加另一个具有此计时 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")
})

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

animation of vehicle from A to B and then B to A along the route (with some wait time at B)

r

sf

tmap

osrm

免责声明

想法

代码