如何创建车辆沿路线从 A 移动到 B 的动画？

Question

下面是使用 R 中的 osrm 包查找从“纽约世贸中心一号”到“纽约麦迪逊广场公园”的路线、旅行时间和旅行距离的示例。（我从 Road Routing in R 学习） .这里的行程时间是 10.37 分钟。

我想创建一个可视化视频。

问。如何创建沿路线从“纽约世贸中心一号”到“纽约麦迪逊广场公园”的车辆（由标记表示）的动画？

理想情况下，我们应该知道每个路段的速度。但是让我们假设车辆在两个位置之间以恒定的速度（= 距离/时间）不间断地移动。

我们也可以简单地使用tmap 代替传单来创建动画。

library(sf)
library(dplyr)
library(tidygeocoder)
library(osrm)

# 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)

osroute <- osrm::osrmRoute(loc = data,
                           returnclass = "sf")

summary(osroute)



library(leaflet)

leaflet(data = data) %>% 
  addProviderTiles("CartoDB.Positron") %>% 
  addMarkers(label = ~address) %>% 
  addPolylines(data = osroute,
               label = "OSRM engine",
               color = "red")

Answer 1

作为@mrhellman 提出的tmap 方法的替代方案，我提供了基于ggplot、ggmap（用于底图）和gganimate 工作流的替代方案。

我发现通过 {gganimate} 创建的动画效果更可取，因为 {gganimate} 给了我更多的控制权 - 例如 shadow_wake 在我看来很好地说明了汽车沿线的运动。如果我没记错的话，tmap 在后台使用 gganimate。

ggmap 不支持 CartoDB 底图 - 例如上面使用的 Positron - 但我发现碳粉背景足够了。

请注意，ggmap 与 ggplot2::geom_sf() 的配合不太好，我发现将工作流程转换为旧的 ggplot2::geom_point() 方法更容易 - 即提取 x 和 y 坐标并通过 aes() 映射它们。

由于只有一条路线可以显示，因此计算transition_reveal() 中用于动画的技术变量seq 就足够了；如有必要（例如在单个动画中显示具有不同行程时间的更多路线时），这可能会被时间维度替换。

library(sf)
library(dplyr)
library(tidygeocoder)
library(osrm)

# 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)

osroute <- osrm::osrmRoute(loc = data,
                           returnclass = "sf")

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


library(ggplot2)
library(ggmap) # warning: has a naming conflict with tidygeocoder!
library(gganimate)

# ggmap does not quite like geom_sf(), 
# the "old school" geom_point will be easier to work with
osroute_xy <- osroute_sampled %>% 
  mutate(seq = 1:nrow(.),
         x = st_coordinates(.)[,"X"],
         y = st_coordinates(.)[,"Y"]) 

# basemap / the bbox depends on yer area of interest
NYC <- get_stamenmap(bbox = c(-74.05, 40.68, -73.9, 40.8),
                     zoom = 13,
                     maptype = "toner-background")

# draw a map 
animation <- ggmap(NYC) + 
  geom_point(data = osroute_xy,
             aes(x = x, y = y),
             color = "red",
             size = 4) +
  theme_void() +
  transition_reveal(seq) +
  shadow_wake(wake_length = 1/6)

# create animation
gganimate::animate(animation, 
                   nframes = 2*(nrow(osroute_xy)+1), 
                   height = 800, 
                   width = 760,
                   fps = 10, 
                   renderer = gifski_renderer(loop = T))

# save animation  
gganimate::anim_save('animated_nyc.gif')

Answer 2

这是一个{mapdeck} 方法，它为您提供交互式地图（如传单）和动画旅行，并且一次可以轻松处理数千次旅行

library(mapdeck)

set_token( secret::get_secret("MAPBOX") )

mapdeck(
  location = as.numeric( data[1, ]$geometry[[1]] ) ## for 'trips' you need to specify the location
  , zoom = 12
  , style = mapdeck_style("dark")
) %>%
  add_trips(
    data = sf
    , stroke_colour = "#FFFFFF" #white
    , trail_length = 12
    , animation_speed = 8
    , stroke_width = 50
  )

add_trips() 函数采用具有 Z 和 M 维度（z = 高度，m = 时间）的 sf 线串对象。所以你可以有一个与每个坐标相关联的时间戳

library(mpadeck)
library(sfheaders)


df_route <- sfheaders::sf_to_df(osroute, fill = TRUE)

## Assume 'duration' is constant
## we want the cumulative time along the rute
df_route$cumtime <- cumsum(df_route$duration)


## and we also need a Z component.
## since we don't know the elevation, I'm setting it to '0'
df_route$elevation <- 0

## Build the 'sf' object wtih the Z and M dimensions
sf <- sfheaders::sf_linestring(
  obj = df_route
  , x = "x"
  , y = "y"
  , z = "elevation"
  , m = "cumtime"
)

---

website 有更多详细信息。

Answer 3

使用您想要的点数对路线（LINESTRING）进行采样，然后使用lapply 函数制作地图对象，并使用tmap_animate 为它们设置动画。

在上面的代码中添加：

library(tmap)
library(gifski)

# sample osroute 50 times regularly, cast to POINT, return sf (not sfc) object
osroute_sampled <- st_sample(osroute, 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

m0 <- lapply(seq_along(1:nrow(osroute_sampled)), function(point){
  x <- osroute_sampled[point,]   ## bracketted subsetting to get only 1 point
  tm_shape(osroute) +            ## 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(m0, width = 300, height = 600, delay = 10)

自从我使用tmap 以来已经有一段时间了，所以我没有及时了解如何添加提供程序磁贴。将它们添加到 lapply 函数中应该不会太难。