Requirements

Make sure that you have the all the packages installed.

Note: I don’t recommend using all these packages together.

library(anipaths) # animations and vulture dataset
library(ggplot2) # graphs
library(OpenStreetMap) # OpenStreetMap
library(soccermatics) # devtools::install_github("jogall/soccermatics") # data
library(move) #turn df into move data-class
library(moveVis) # animations
library(gganimate) # animations
library(viridisLite) #viridis palette

The vulture dataset

The package anipaths contains a collection of telemetry observations for turkey vultures originally analyzed in:

Dodge S, Bohrer G, Bildstein K, Davidson SC, Weinzierl R, Mechard MJ, Barber D, Kays R, Brandes D, Han J (2014) Environmental drivers of variability in the movement ecology of turkey vultures (Cathartes aura) in North and South America. Philosophical Transactions of the Royal Society B 20130195.
summary(vultures)
##                    timestamp     location.long      location.lat   
##  2011-06-02 18:00:00.000:    8   Min.   :-123.65   Min.   :-39.82  
##  2011-04-03 15:00:00.000:    7   1st Qu.: -82.38   1st Qu.:-13.72  
##  2011-04-03 21:00:00.000:    7   Median : -75.82   Median : 30.26  
##  2011-04-05 15:00:00.000:    7   Mean   : -79.42   Mean   : 16.01  
##  2011-04-05 18:00:00.000:    7   3rd Qu.: -63.69   3rd Qu.: 40.79  
##  2011-04-07 21:00:00.000:    7   Max.   : -48.58   Max.   : 52.42  
##  (Other)                :70111                                     
##  individual.local.identifier
##  Disney      : 9783         
##  Steamhouse 2: 9416         
##  Young Luro  : 7658         
##  Rosalie     : 7574         
##  Steamhouse 1: 5655         
##  Irma        : 5651         
##  (Other)     :24417
str(vultures)
## 'data.frame':    70154 obs. of  4 variables:
##  $ timestamp                  : Factor w/ 86343 levels "2003-11-14 16:00:00.000",..: 36265 36377 36378 36379 36380 36381 36382 36383 36394 36395 ...
##  $ location.long              : num  -74.9 -75.2 -75.2 -75.2 -75.2 ...
##  $ location.lat               : num  40.4 40.6 40.6 40.6 40.6 ...
##  $ individual.local.identifier: Factor w/ 19 levels "Argentina","Butterball",..: 5 5 5 5 5 5 5 5 5 5 ...
vultures$datetime <- as.POSIXct(as.character(vultures$timestamp))

# To use only one year of data
dataset <-
  vultures[format(vultures$datetime, "%Y") == 2009, c("individual.local.identifier",
  "location.lat",
  "location.long",
  "datetime")]
  
  dataset$individual.local.identifier <-
  as.factor(as.character(dataset$individual.local.identifier))
  
names(dataset) <- c("ID","lat","lon","datetime")
summary(dataset)
##             ID            lat              lon         
##  Rosalie     :5962   Min.   :-39.63   Min.   :-123.65  
##  Disney      :3159   1st Qu.: 25.58   1st Qu.:-123.14  
##  Young Luro  :2102   Median : 38.59   Median : -82.06  
##  Irma        :2047   Mean   : 28.46   Mean   : -93.69  
##  Steamhouse 2: 667   3rd Qu.: 43.72   3rd Qu.: -75.19  
##  Morongo     : 628   Max.   : 52.35   Max.   : -61.54  
##  (Other)     : 935                                     
##     datetime                  
##  Min.   :2009-03-01 01:00:00  
##  1st Qu.:2009-05-10 12:00:00  
##  Median :2009-07-26 00:00:00  
##  Mean   :2009-07-29 09:49:11  
##  3rd Qu.:2009-10-20 02:00:00  
##  Max.   :2009-12-31 23:00:00  
##

One graph for all points

ggplot(dataset, aes(x = lon, y = lat, colour = ID)) +
geom_point(size=0.1) +
  theme_bw()

Trajectories

ggplot(dataset, aes(x = lon, y = lat, colour = ID)) +
geom_path() +
  theme_bw()

Animation using gganimate

p <-
  ggplot(dataset,
  aes(x = lon, y = lat, colour = ID),
  height = 300,
  width = 300) +
  geom_path() +
  theme_bw() +
  transition_reveal(datetime) +
  labs(title = 'Date: {frame_along}')
  animate(p,
  nframes = 100,
  fps = 2,
  renderer = gifski_renderer(loop = FALSE))

  anim_save("vulture_gganimate.gif", p)
  
  p_mp4 <- animate(p, renderer = ffmpeg_renderer())
  anim_save("vulture_gganimate.mp4", p_mp4)

Now using a background map

map1 <- openmap(c(70, -140),
                c(-70, -30), zoom = 4, type = 'bing')
                # the first vector is the top left corner (in lat long), the second is the bottom right, zoom is the quality of the map zoom=1 is too blurry to be useful, and zoom=10 is only for like really close things and it takes forever.
                plot(map1)

                map2 <- openproj(map1, projection = '+init=epsg:4326')
                
                autoplot(map2) +
                geom_path(data = dataset, aes(x = lon, y = lat, colour = ID)) +
                theme_bw() +
                transition_reveal(datetime) +
                labs(title = 'Date: {frame_along}')

Animation with anipaths

delta.t <- "day"

anim_vultures <- animate_paths(
paths = dataset,
delta.t = delta.t,
coord = c("lon", "lat"),
Time.name = "datetime",
ID.name = "ID",
interval = 1 / 12,
background = map2,
htmlfile = 'vultures_anipath.html',
date.col = "white",
imgdir = "vulture",
img.name = "vulture"
)

anim_vultures_mp4 <- animate_paths(
paths = dataset,
delta.t = delta.t,
coord = c("lon", "lat"),
Time.name = "datetime",
ID.name = "ID",
interval = 1 / 12,
background = map2,
video.name = 'vultures_anipath.mp4',
date.col = "white",
method = "mp4",
imgdir = "vulture",
img.name = "vulture"
)

animation:::saveVideo(
anim_vultures,
movie.name = "vultures_anipath.gif",
imgdir = "vulture",
img.name = "vulture"
)

Animation with moveVis

There are duplicates. Let’s filter them out.

dataset$count <- 1:dim(dataset)[1]
test <- unlist(sapply(
unique(dataset$ID),
FUN = function(x) {
set_data <- dataset[dataset$ID == x, ]
set_data$count[which(duplicated(set_data$datetime) == FALSE)]
}
))

dataset_unique <- dataset[test, ]
vul_move <-
move(
x = dataset_unique$lon,
y = dataset_unique$lat,
time = dataset_unique$datetime,
proj = CRS("+proj=longlat +ellps=WGS84"),
animal = dataset_unique$ID
)

# align move_data to a uniform time scale
m <- align_move(vul_move,
res = 1,
digit = 0,
unit = "days")

# create spatial frames with a OpenStreetMap watercolour map
frames <-
frames_spatial(
m,
path_colours = viridis(length(unique(dataset_unique$ID))),
map_service = "osm",
map_type = "watercolor",
alpha = 0.5,
verbose = FALSE
) %>%
add_labels(x = "Longitude", y = "Latitude") %>% # add some customizations, such as axis labels
add_northarrow() %>%
add_scalebar() %>%
add_timestamps(m, type = "label") %>%
add_progress()
# frames[[100]] # preview one of the frames, e.g. the 100th frame


# animate frames
animate_frames(frames, out_file = "vulture_moveVis.gif", overwrite = TRUE)# animate frames
animate_frames(frames, out_file = "vulture_moveVis.mp4", overwrite = TRUE)

Let’s play soccer!

The soccer dataset is available thanks to

“Soccer video and player position dataset”: S. A. Pettersen, D. Johansen, H. Johansen, V. Berg-Johansen, V. R. Gaddam, A. Mortensen, R. Langseth, C. Griwodz, H. K. Stensland, and P. Halvorsen, in Proceedings of the International Conference on Multimedia Systems (MMSys), Singapore, March 2014, pp. 18-23

data(tromso)
head(tromso)
##                     t id       x       y
## 1 2013-11-07 22:05:13 16 35.3014 47.5268
## 2 2013-11-07 22:05:13 12 34.4418 38.5675
## 3 2013-11-07 22:05:13  3 71.1769 71.8776
## 4 2013-11-07 22:05:13 13 35.7741 22.4835
## 5 2013-11-07 22:05:13  8 53.2777 41.9188
## 6 2013-11-07 22:05:13 15 42.7315 42.2995
soccerPath(tromso)

# With anipaths
anim_soccer <- animate_paths(
paths = tromso,
n.frames = 100,
coord = c("x", "y"),
Time.name = "t",
ID.name = "id",
interval = 1 / 3,
htmlfile = 'soccer_anipaths.html',
date.col = "black",
imgdir = "soccer",
img.name = "soccer",
max.knots = 100
)
# There was an interpolation problem

# No interpolation with gganimate
p1_soccer <- soccerPitch() +
geom_point(data = tromso, aes(x = x, y = y, colour = id)) +
theme_void() +
transition_time(t)    +
labs(title = 'Date: {frame_time}')

p1_mp4 <-
animate(p1_soccer,
renderer = ffmpeg_renderer(),
nframes = 100,
fps = 4)

anim_save("soccer_gganimate.mp4", p1_mp4)

More to see?

rpostgisLT soon!

Acknowledgments

Thanks to Matthew E. Boone for help with maps and rpostgisLT.