使用 ggmap 和 gganimate 创建“天桥”地图动画

Question

我有一个数据集，其中包含到达某个位置的人员、他们停留了多长时间以及他们的家庭位置。我想创建一个动画图表，将它们“飞”到目的地，并在旅行结束后将它们返回原点。但我不确定gganimate 是否可行。目前我似乎只能做一个“开始”和“结束”帧，虽然很难判断它是否没有足够的帧来执行预期的操作。

这是我目前所拥有的：

library(dplyr)
library(ggplot2)
library(ggmap)
library(gganimate)

#Coordinates
europecoords <- c(left = -23, bottom = 36, right = 27.87, top = 70.7)
londonareacoords <- c(left = -.7, bottom = 51, right = 0.2, top = 52)
londonpointcoords <- as.data.frame(list(lon = -.14, lat = 51.49))

#Get the map we'll use as the background
europe <- get_stamenmap(europecoords, zoom = 4, maptype = "toner-lite")

#Sample dataset configuration
numberofpoints <- 10
balance <- 0.1

#Set up an example dataset
ids <- seq(1:numberofpoints)
arrivalday <- sample(x = 30, size = numberofpoints, replace = TRUE)
staylength <- sample(x = 7, size = numberofpoints, replace = TRUE)
startlocationlondonarealon <- sample(x = seq(londonareacoords['left'] * 10, londonareacoords['right'] * 10), size = numberofpoints * balance, replace = TRUE) / 10
startlocationlondonarealat <- sample(x = seq(londonareacoords['bottom'] * 10, londonareacoords['top'] * 10), size = numberofpoints * balance, replace = TRUE) / 10
startlocationeuropelon <- sample(x = seq(europecoords['left'] * 10, europecoords['right'] * 10), size = (numberofpoints * (1 - balance)), replace = TRUE) / 10
startlocationeuropelat <- sample(x = seq(europecoords['bottom'] * 10, europecoords['top'] * 10), size = (numberofpoints * (1 - balance)), replace = TRUE) / 10
startlocationlon <- c(startlocationlondonarealon, startlocationeuropelon)
startlocationlat <- c(startlocationlondonarealat, startlocationeuropelat)

points <- as.data.frame(cbind(ID = ids, arrivalday, staylength, departureday = arrivalday + staylength, startlocationlon, startlocationlat))

#Map the sample dataset to check it looks reasonable
ggmap(europe) +
  geom_point(data = points, aes(x = startlocationlon, y = startlocationlat), col = "blue", size = 2) +
  geom_point(data = londonpointcoords, aes(x = lon, y = lat), col = "red")


#Separate the events out to rearrange, then glue them back together
event1 <- points %>%
  mutate(Event = "Day Before Arrival", Date = arrivalday - 1) %>%
  mutate(Lon = startlocationlon, 
         Lat = startlocationlat) %>%
  select(ID, Event, Date, Lon, Lat)

event2 <- points %>% 
  mutate(Event = "Arrival Date", Date = arrivalday) %>%
  mutate(Lon = londonpointcoords$lon[1],
         Lat = londonpointcoords$lat[1]) %>%
  select(ID, Event, Date, Lon, Lat)

event3 <- points %>% 
  mutate(Event = "Departure Date", Date = departureday) %>%
  mutate(Lon = londonpointcoords$lon[1],
         Lat = londonpointcoords$lat[1]) %>%
  select(ID, Event, Date, Lon, Lat)

event4 <- points %>%
  mutate(Event = "Day After Departure", Date = departureday + 1) %>%
  mutate(Lon = startlocationlon, 
         Lat = startlocationlat) %>%
  select(ID, Event, Date, Lon, Lat)

events <- rbind(event1, event2, event3, event4) %>%
  mutate(Event = factor(Event, ordered = TRUE, levels = c("Day Before Arrival", "Arrival Date", "Departure Date", "Day After Departure"))) %>%
  mutate(ID = factor(ID))

#Make an animation
ggmap(europe) +
  geom_point(data = events, aes(x = Lon, y = Lat, group = ID, col = ID), size = 2) +
  #geom_point(data = londonpointcoords, aes(x = lon, y = lat), col = "red") +
  transition_manual(Date) +
  labs(title = "Date: {frame}") +
  NULL

但正如我所说，这些点似乎不像只是出现和消失那样“飞行”。我应该使用不同的数据格式吗？过渡类型？帧数？ （我无法找到有关上述任何内容的文档，这也是我被卡住的部分原因......）

Answer 1

最终结果

代码

library(ggplot2)    
library(ggmap)
library(gganimate)
ggm <- ggmap(europe) +
    geom_point(data = events,
               aes(x = Lon, y = Lat,
                   colour = ID, group = ID, shape = Event),
               size = 3, alpha = 0.8) +
    transition_time(Date) + 
    labs(title = paste("Day", "{round(frame_time,0)}")) +
    shadow_wake(wake_length = 0.1)
animate(ggm, fps = 24, duration = 16) 

================================================ =========

一步一步

那里有很多活动部件。让我们分解一下：

0。加载库

library(ggplot2)    
library(ggmap)
library(gganimate)
library(ggrepel) # will be useful for data exploration in step 1

1。数据探索

ggplot(data = events, aes(x = ID, y = Date, colour = Event)) +
    geom_point()

我们看到，每架飞机的到达和离开事件都非常接近。此外，两者之间总是有几天的差距。这似乎是合理的。

让我们检查一下Date 变量：

> length(unique(events$Date))
[1] 24
> min(events$Date)
[1] 2
> max(events$Date)
[1] 33

好的，这意味着两件事：

1. 我们的数据点间距不均匀。
2. 我们没有所有Dates 的数据。

这两件事都会使动画部分颇具挑战性。

ggplot(data = unique(events[, 4:5]), aes(x = Lon, y = Lat)) + 
    geom_point()

此外，我们只有 11 个独特的位置（== 机场）。这可能会导致数据重叠。让我们按天绘制：

ggplot(data = unique(events[, 3:5]), aes(x = Lon, y = Lat, label = Date)) +
    geom_point() + 
    geom_text_repel()

是的，这会很有趣...中间的那个机场发生了很多事情。

2。基本动画

gga <- ggplot(data = events, aes(x = Lon, y = Lat)) +
    geom_point() +
    transition_time(Date)
animate(gga)

我们使用transition_time() 而不是transition_states()，因为前者用于线性时间变量（例如，秒、日、年）和自动插值，而后者则为用户提供了更多的手动控制。

3。让我们添加颜色

gga <- ggplot(data = events, aes(x = Lon, y = Lat, colour = ID)) +
    geom_point() +
    transition_time(Date)
animate(gga)

它开始看起来像什么了！

4。添加标题、透明度、增大尺寸

gga <- ggplot(data = events, aes(x = Lon, y = Lat, col = ID)) +
    geom_point(size = 3, alpha = 0.5) +
    transition_time(Date) + 
    labs(title = paste("Day", "{round(frame_time, 0)}"))

注意四舍五入的{round(frame_time, 0)}。尝试使用{frame_time} 看看会发生什么！

5。添加一些比萨饼

gga <- ggplot(data = events, aes(x = Lon, y = Lat, col = ID, group = ID, 
                                 shape = Event)) +
    geom_point(size = 3, alpha = 0.5) +
    transition_time(Date) + 
    labs(title = paste("Day", "{round(frame_time, 0)}")) +
    shadow_wake(wake_length = 0.05)
animate(gga)

看起来不错，让我们完成它！

6。添加地图，让动画变慢，调整一些细节

ggm <- ggmap(europe) +
    geom_point(data = events,
               aes(x = Lon, y = Lat,
                   colour = ID, group = ID, shape = Event),
               size = 3, alpha = 0.8) +
    transition_time(Date) + 
    labs(title = paste("Day", "{round(frame_time,0)}")) +
    shadow_wake(wake_length = 0.1)
animate(ggm, fps = 24, duration = 16) 

不会太破旧吧？附带说明：animate(ggm, nframes = 384) 对动画的影响与 fps = 24 和 duration = 16 的效果相同。

如果您有任何问题，请随时向我发表评论。 我会尽力帮助或澄清事情。