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

Question

Below is an example of animating vehicle moving from A to B. [solved by @mrhellmann here, there are solutions also available]

I want to animate vehicle moving from A to B and then wait at B for sometime and then return to A. Below is the code which has animations of both the trip (A-B and B-A).

1. How can we merge osroute_sampled_1 and osroute_sampled_2 to create single animation?

2. Also, how can we add wait time (make vehicle stationary for few seconds at B?

Note - Vehicle may not return to A, it may go to C. So creating a single route using same origin and destination (A) via B may not work

# 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

To add a timestamp to the animation, you can follow this approach:

1. Create an sf object with as many rows as your trip and constant coordinates (preferably the one in the cornder, can be found out via st_bbox).
2. Add the informative text as a column to this sf.
3. In your loop add another layer with this timings sf and use tm_text to show the timestamp:

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