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

SiD*_*SiD 5 r r-sp tmap osrm r-sf

下面是使用 R 中的包查找从“纽约世贸中心一号”到“纽约麦迪逊广场公园”的路线、旅行时间和旅行距离的示例osrm。(我是从R 中的 Road Routing中学到的 )。这里的行车时间是 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")

Run Code Online (Sandbox Code Playgroud)

Jin*_*cko 10

作为tmap@mrhellman 提出的方法的替代方法,我提供了一种基于ggplot, ggmap(用于底图)和gganimate基于工作流的替代方法。

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

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

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

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

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')
Run Code Online (Sandbox Code Playgroud)

纽约汽车的动画地图


Sym*_*xAU 7

这是一种{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
  )

Run Code Online (Sandbox Code Playgroud)

add_trips()函数采用具有sfZ 和 M 维(z = 高程,m = 时间)的线串对象。所以你可以有一个与每个坐标相关的时间戳

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

Run Code Online (Sandbox Code Playgroud)

网站有更多详细信息。