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

Disclaimer

Never really worked with sf and friends before, but after reading the docs I could imagine a solution like this to fulfill your needs.

Idea

Since sf are in fact extended data.frames they naturally come with an rbind functionality. Having said that, the whole task should be as easy as rbind'ing all the relevant paths together. As for the waiting time, simply repeat the last row in the sf a couple of times, which would give you the impression of the vehicle stopping at B (and A on the way back).

Code

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

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