使用 gganimate 在 R 中制作动画地理地图

Question

我可以在 R 中生成一些看起来不错的等值线图，例如以下内容

library(tidyverse)
library(rnaturalearth) 
library(rnaturalearthdata)

set.seed(1234)

ww <- ne_countries(scale = "medium", returnclass = "sf")

ll <- ww$name %>% length

val <- sample(c("a","b","c","d"), ll, replace=T)
bb <- ne_download(type = "wgs84_bounding_box", category = "physical",
              returnclass = "sf")

ww <- ww %>% mutate(value=val)


gpl1 <- ggplot(data = ww) +
geom_sf(aes(fill=value),  col = "black", lwd = 0.3 )+
xlab(NULL) + ylab(NULL) +
ggtitle("World Export of Merchandise")+
geom_sf(data = bb, col = "grey", fill = "transparent") +
theme(plot.background = element_rect(fill = "white"),
      panel.background = element_rect(fill = 'white'),
      panel.grid.major = element_line(colour = "grey"),
      legend.position="top",
      plot.title = element_text(lineheight=.8, size=24, face="bold",
                                vjust=1),
      legend.text = element_text(vjust=.4,lineheight=1,size = 14),
      legend.title = element_text(vjust=1,lineheight=1, size=14,
                                  face="bold" ))+
coord_sf(crs = "+proj=eqearth +wktext") 

ggsave("test_world1.pdf", gpl1, width=6*1.618,height=5)

但是然后假设我有几年的数据，例如

values_years <- tibble(value=sample(c("a","b","c","d"), 4*ll, replace=T),
            years=sample(seq(4), 4*ll, replace=T))

有谁知道如何使用 gganimate 生成等值线图，其中国家/地区颜色会在展示不同年份时自动更改？ 我不是在寻找交互式可视化，而是类似这样的东西

https://www.blog.cultureofinsight.com/2017/09/animated-choropleth-maps-in-r/

只是我很难根据我的需要简化这个例子。 任何帮助表示赞赏！

Answer 1

我不是地理空间数据或 gganimate 方面的专家，但我通过执行以下操作设法获得了类似于您问题的答案的内容。 我们将以与您启动示例的方式类似的方式开始，但我们还加载了 gganimate 包。

library(tidyverse)
library(rnaturalearth) 
library(rnaturalearthdata)
library(gganimate) # also needs transformr

## Do all previous stuff
set.seed(1234)

ww <- ne_countries(scale = "medium", returnclass = "sf")

ll <- ww$name %>% length

val <- sample(c("a","b","c","d"), ll, replace=T)
bb <- ne_download(type = "wgs84_bounding_box", category = "physical",
                  returnclass = "sf")
ww <- ww %>% mutate(value=val)

然后，对于我们的每个时间点，我们复制数据并为每个形状、时间点和新的填充变量分配一个组。 分组是必要的，因为默认情况下，填充将决定分组，动画将显示所有国家/地区都在地图上跳跃。

newdf <- lapply(seq_len(5), function(i) {
  new <- ww
  new$group <- seq_len(nrow(new))
  new$value <- sample(letters[1:4], nrow(new), replace = TRUE)
  new$time <- i
  new
})
newdf <- do.call(rbind, newdf)

然后我们做一个情节。 主要区别在于我在geom_sf()中分配了一个组并添加了transition_time(time) 。 另外，我添加了一个副标题来跟踪动画状态。

gpl1 <- ggplot(data = newdf) +
  geom_sf(aes(fill=value, group = group),  col = "black", lwd = 0.3 )+
  xlab(NULL) + ylab(NULL) +
  ggtitle("World Export of Merchandise", subtitle = "{frame_time}")+
  geom_sf(data = bb, col = "grey", fill = "transparent") +
  theme(plot.background = element_rect(fill = "white"),
        panel.background = element_rect(fill = 'white'),
        panel.grid.major = element_line(colour = "grey"),
        legend.position="top",
        plot.title = element_text(lineheight=.8, size=24, face="bold",
                                  vjust=1),
        legend.text = element_text(vjust=.4,lineheight=1,size = 14),
        legend.title = element_text(vjust=1,lineheight=1, size=14,
                                    face="bold" )) +
  transition_time(time)
  # coord_sf(crs = "+proj=eqearth +wktext") # couldn't get this coord to work

然后我们制作动画：

ani <- animate(gpl1)

Answer 2

谢谢，但我想我找到了更简单的东西。

library(tidyverse)

library(rnaturalearth) 
library(rnaturalearthdata)

library(gganimate)

set.seed(1234)

ww_ini <- ne_countries(scale = "medium", returnclass = "sf")

ll <- ww_ini$name %>% length

val <- sample(c("a","b","c","d"), ll, replace=T)



bb <- ne_download(type = "wgs84_bounding_box", category = "physical",
              returnclass = "sf")

ww <- ww_ini %>%
mutate(value=val)


gpl1 <- ggplot(data = ww) +
geom_sf(aes(fill=value),  col = "black", lwd = 0.3 )+
xlab(NULL) + ylab(NULL) +
ggtitle("World Export of Merchandise")+
 geom_sf(data = bb, col = "grey", fill = "transparent") +
theme(plot.background = element_rect(fill = "white"),
      panel.background = element_rect(fill = 'white'),
      panel.grid.major = element_line(colour = "grey"),
      legend.position="top",
      plot.title = element_text(lineheight=.8, size=24, face="bold",
                                vjust=1),
      legend.text = element_text(vjust=.4,lineheight=1,size = 14),
      legend.title = element_text(vjust=1,lineheight=1, size=14,
                                  face="bold" ))+
coord_sf(crs = "+proj=eqearth +wktext") 

ggsave("test_world1.pdf", gpl1, width=6*1.618,height=5)



values_years <- tibble(name=rep(ww$name,4),
                   year=c(rep(1,ll), rep(2,ll), rep(3, ll), rep(4, ll)),
                   value=sample(c("a","b","c","d"),4* ll, replace=T))


 ww_ext <- left_join(ww_ini, values_years, by="name")



gpl2 <- ggplot(data = ww_ext) +
geom_sf(aes(fill=value),  col = "black", lwd = 0.3 )+
xlab(NULL) + ylab(NULL) +
ggtitle("World Export of Merchandise")+
 geom_sf(data = bb, col = "grey", fill = "transparent") +
theme(plot.background = element_rect(fill = "white"),
      panel.background = element_rect(fill = 'white'),
      panel.grid.major = element_line(colour = "grey"),
      legend.position="top",
      plot.title = element_text(lineheight=.8, size=24, face="bold",
                                vjust=1),
      legend.text = element_text(vjust=.4,lineheight=1,size = 14),
      legend.title = element_text(vjust=1,lineheight=1, size=14,
                                  face="bold" ))+
 coord_sf(crs = "+proj=eqearth +wktext") +

transition_manual(year )

anim <- animate(gpl2)

这仍然需要反复试验，尤其是在选择 transition_ 动词时。