How to create animation of vehicle moving form A to B along a route?

Question

below is an example of finding route, travel time and travel distance from 'One World Trade Center, NYC' to 'Madison Square Park, NYC' using osrm package in R. (I learnt it from Road Routing in R). The travel time here is 10.37 minutes.

I wanted to create an video for visualization.

Q. How can I create an animation of vehicle (represented by a marker) moving from 'One World Trade Center, NYC' to 'Madison Square Park, NYC' along the route ?

Ideally, we should know the speed in each road segment. But lets assume the vehicle moves non-stop at constant speed (= distance/time) between two location.

We can simply use tmap instead of leaflet also to create animation.

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

Quickwitted

Answer 1

As an alternative to the tmap approach proposed by @mrhellman I offer an alternative built on ggplot, ggmap (for the basemap) and gganimate based workflow.

I have found the outcome of animations created via {gganimate} preferable, as {gganimate} gives me more control - such as the shadow_wake that in my opinion nicely illustrates the movement of a car along the line. If I remember correctly tmap uses gganimate under the hood.

ggmap does not support CartoDB basemaps - such as the Positron used above - but I have found the toner background adequate.

Note that ggmap does not play quite nicely with ggplot2::geom_sf() and I have found it easier to transform my workflow to old ggplot2::geom_point() approach - i.e. extract the x and y coordinates and map them via aes().

As there is only a single route to display it should be sufficient to calculate a technical variable seq that is used in the transition_reveal() to animate; this may be replaced by a time dimension if & when necessary (such as when displaying more routes with different travel time in a single animation).

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

Spiro

Thank you very much @Jindra Lacko. I was wondering if you can help me build the final part of it - #68909420 – Quickwitted

Answer 2

Here's a {mapdeck} approach, which gives you an interactive map (like leaflet), and animated trips, and it can easily handle thousands of trips at a time

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
  )

the add_trips() function takes an sf linestring object with the Z and M dimensions (z = elevation, m = time). So you can have a timestamp assocaited with each coordinate

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

---

The website has more details.

Goodard

Thank you SymbolixAU. I was wondering if you can also look at the followup of this - #68909420 – Quickwitted

Answer 3

Sample the route (a LINESTRING) with the number of points you would like to have, then use an lapply function to make the map objects, and use tmap_animate to animate them.

Adding to your code above:

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)

It's been a while since I've used tmap, so I'm not up to date on adding provider tiles. Shouldn't be too hard for you to add those into the lapply function.

Gormand

Thank you mrhellmann for replying to this post so quickly. I was wondering if you can also look at the followup of this - #68909420 – Quickwitted