R数据可视化20:弦图

终于超过1k粉丝啦～之前说要小小庆祝一下，害怕直接放文章里会被封文章，所以福利大家可以见评论。前几周忙着答辩毕业事宜没有时间更新，虽然这几天也挺忙哈哈哈哈，不过还是要定期更新的。今天我们来讲一下弦图的绘制。（上一次画这个图要以年为时间单位计算了？）

什么是弦图（Chord Diagram）

弦图是一种展示数据之间相互关系的图形。弦图中的数据点以圆的形式呈放射状排列，并用线条来展示数据之间的联系。在弦图中，我们可以通过颜色和线条的粗细来展现不同类型联系和强度。这种联系有多种形式比如相关性，比如存在与否，比如迁入迁出等。

弦图是一种美学上令人愉悦的展现方式，换句话说，可以提升你文章或者报告的水准，让人有一种高大上的感觉。那么让我们先来看几个弦图的例子。

弦图的例子

使用弦图展示不同OTU在不同环境中的存在情况

当然除了表示相关性弦图也可以用于表示存在的情况。我们以这篇A Deeper Look into the Biodiversity of the Extremely Acidic Copahue volcano-Río Agrio System in Neuquén, Argentina文献为例，该研究探究了阿根廷一座火山的生物多样性。

上面的弦图就展现了不同的OTU在不同环境的存在情况。比如，研究发现OTU1存在于酸性矿山排水（AMD）、矿山（Mine）、河流（Riverine）、火山（Volcanic）等多个环境，其中在酸性矿山排水中的存在最多（连线最宽）。而关注不同的环境可以发现酸性矿山排水中主要存在OTU1、OTU5、OTU6、OTU7、OTU8、OTU20等微生物。

通常来说，当数据点不是很多的时候，弦图能很直观地展现出不同数据点之间的关系。但是当数据点过多的时候，可能弦图看起来就有一些混乱了，不过具体是否采用这种图，还是要看你想用图去表达什么结论。

当然了多幅弦图还能展现出不同组别或者不同时间点之间的差异，具体如何展现可以看我们今天的具体示例。

如何作弦图

1）需要什么样的数据
今天找到了一个酷炫的弦图例子还是个动图。该图用来展示1960年到2015年的全球移民情况。当然我们会画静态图+动图。
我只是一个代码搬运工，参考了国外网友写的代码：原代码请点击这里
我们要使用的数据来自于“migest”这个包。所以我们先安装该包然后读取数据。
我们要用的绘图工具是来自“circlize”包的chordDiagram()函数。
首先我们来看一下数据的准备。数据具体分为2部分，一部分是用于作图的具体移民数据，还有一部分是调整作图参数的文件。

install.packages('migest')#安装migest包
library(tidyverse)#使用该包提供的“read_csv()"功能
d0 <- read_csv(system.file("imr", "reg_flow.csv", package = "migest"))
 d0
# A tibble: 891 x 4
   year0 orig_reg     dest_reg                         flow
   <dbl> <chr>        <chr>                           <dbl>
 1  1960 Africa       Africa                        1377791
 2  1960 Africa       Eastern Asia                     5952
 3  1960 Africa       Eastern Europe & Central Asia    7303
 4  1960 Africa       Europe                         919252
 5  1960 Africa       Latin America & Caribbean       15796
 6  1960 Africa       Northern America                82463
 7  1960 Africa       Oceania                         32825
 8  1960 Africa       Southern Asia                   35603
 9  1960 Africa       Western Asia                   106580
10  1960 Eastern Asia Africa                          37301
# … with 881 more rows

可以看到该数据以5年为单位统计了不同地区的移民情况。实际上真正做弦图只需要后三列，也就是从哪去哪去了多少。
下面我们再来看作图参数的文件。migest包中也已经准备好了。

d1 <- read_csv(system.file("vidwp", "reg_plot.csv", package = "migest"))
d1
# A tibble: 9 x 5
  region                        order1 col1    reg1           reg2          
  <chr>                          <dbl> <chr>   <chr>          <chr>         
1 Northern America                   1 #40A4D8 Northern       America       
2 Africa                             2 #33BEB7 Africa         NA            
3 Europe                             3 #B2C224 Europe         NA            
4 Eastern Europe & Central Asia      4 #FECC2F Eastern Europe & Central Asia
5 Western Asia                       5 #FBA127 Western        Asia          
6 Southern Asia                      6 #F66320 Southern       Asia          
7 Eastern Asia                       7 #DB3937 Eastern        Asia          
8 Oceania                            8 #A463D7 Oceania        NA            
9 Latin America & Caribbean          9 #0C5BCE Latin America  & Caribbean

具体来说第一列就是地区的名字，第二列是顺序，第三列是作图所使用的颜色，第四和第五列大家可以猜猜看。
实际上，最后为了作图效果好看，有部分地区的名字过长，所以我们会分为2行来展示，第四和第五列就是为了实现这个目的。

2）如何作图
我们首先来做1960-1965年这段时间的图：

library(circlize)
test<-d0[d0$year0==1960,-1]#筛选数据
chordDiagram(x = test, 
             directional = 1, #表示线条的方向，0代表没有方向，1代表正向，-1代表反向，2代表双向
             order = d1$region,
             grid.col = d1$col1, #颜色的设定
             annotationTrack = "grid",#diy添加label和axis
             transparency = 0.25,#线条的透明度
             annotationTrackHeight = c(0.05, 0.1),#外面一圈的宽度
             direction.type = c("diffHeight","arrows"), #线条是否带有箭头
             link.arr.type = "big.arrow",#另一个选择是巨丑无比的尖头
             diffHeight  = -0.04#外圈和中间连线的间隔
            )
# 添加labels and axis
circos.track(track.index = 1, bg.border = NA, 
             panel.fun = function(x, y) {
               xlim = get.cell.meta.data("xlim")
               sector.index = get.cell.meta.data("sector.index")
               reg1 = d1 %>% filter(region == sector.index) %>% pull(reg1)
               reg2 = d1 %>% filter(region == sector.index) %>% pull(reg2)
               circos.text(x = mean(xlim), y = ifelse(is.na(reg2), 3, 4),labels = reg1, facing = "bending", cex =0.8)
               circos.text(x = mean(xlim), y = 2.75, labels = reg2, facing = "bending", cex = 0.8)
               circos.axis(h = "top", labels.cex = 0.6,labels.niceFacing = FALSE, labels.pos.adjust = FALSE)
})

1960-1965年的人口迁移

然后我们可以写一个循环生成多张图然后制作成gif。我们可以根据时间点将数据切割。

library(tweenr)
d2 <- d0 %>%
  mutate(corridor = paste(orig_reg, dest_reg, sep = " -> ")) %>%
  select(corridor, year0, flow) %>%
  mutate(ease = "linear") %>%
  tween_elements(time = "year0", group = "corridor", ease = "ease", nframes = 10) 


d2 <- d2 %>%
  separate(col = .group, into = c("orig_reg", "dest_reg"), sep = " -> ") %>%
  select(orig_reg, dest_reg, flow, everything())

d2$flow<-d2$flow/1e06

# create a directory to store the individual plots
dir.create("./plot-gif/")

library(circlize)
for(f in unique(d2$.frame)){
  png(file = paste0("./plot-gif/globalchord", f, ".png"), height = 7, width = 7, 
      units = "in", res = 500)
  
  # intialise the circos plot
  circos.clear()
  par(mar = rep(0, 4), cex=1)
  circos.par(start.degree = 90, track.margin=c(-0.1, 0.1), 
             gap.degree = 4, points.overflow.warning = FALSE)
  
  # plot the chord diagram
  chordDiagram(x = d2[d2$.frame==f,1:3], directional = 1, order = d1$region,
               grid.col = d1$col1, annotationTrack = "grid",
               transparency = 0.25,  annotationTrackHeight = c(0.05, 0.1),
               direction.type = c("diffHeight", "arrows"), link.arr.type = "big.arrow",
               diffHeight  = -0.04, link.sort = TRUE, link.largest.ontop = TRUE)
  
  # add labels and axis
  circos.track(track.index = 1, bg.border = NA, panel.fun = function(x, y) {
    xlim = get.cell.meta.data("xlim")
    sector.index = get.cell.meta.data("sector.index")
    reg1 = d1 %>% filter(region == sector.index) %>% pull(reg1)
    reg2 = d1 %>% filter(region == sector.index) %>% pull(reg2)
    
    circos.text(x = mean(xlim), y = ifelse(is.na(reg2), 3, 4),
                labels = reg1, facing = "bending", cex = 1.1)
    circos.text(x = mean(xlim), y = 2.75, labels = reg2, facing = "bending", cex = 1.1)
    circos.axis(h = "top", labels.cex = 0.8,
                labels.niceFacing = FALSE, labels.pos.adjust = FALSE)
  })
  
  
  # close plotting device
  dev.off()
}


library(magick)

img <- image_read(path = "./plot-gif/globalchord0.png")
for(f in unique(d2$.frame)[-1]){
  img0 <- image_read(path = paste0("./plot-gif/globalchord",f,".png"))
  img <- c(img, img0)
  message(f)
}

img1 <- image_scale(image = img, geometry = "720x720")

ani0 <- image_animate(image = img1, fps = 10)
image_write(image = ani0, path = "./globalchord.gif")

globalchord.gif