问用gganimate制作R中的动态地理地图
EN

Stack Overflow用户

提问于 2019-11-30 19:48:11

回答 2查看 2.6K关注 0票数 0

我可以在R中生成一些看起来不错的choropleth地图，例如，请参见以下内容

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来生成一个显示不同年份时国家颜色自动变化的choropleth地图？我不是在寻找交互式的viz，而是像这样的东西。

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

只是我很难简化这个例子来满足我的需求。如有任何帮助，我们不胜感激！

gganimate

ggplot2

DNS解析特惠

DNS解析提供智能解析、流量调度、安全防护等服务

回答 2

Stack Overflow用户

发布于 2019-12-01 13:53:44

我既不是地理空间数据专家，也不是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)

票数 1

Stack Overflow用户

发布于 2019-12-02 14:16:24

谢谢，但我想我找到了更简单的方法。

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)