【R分享|实战】美国18年死亡率的分布情况（地图）-- 循环处理与绘图

“ 不求做的最好，但求做的更好。”   --科白君
"R实战"专题·第20篇
  编辑 | 科白维尼
  4651字 |11分钟阅读
本期推送内容
最近看到一张图，该图描述了美国1999-2016年（共18年）某种病的死亡率的分布情况。这张图值得我们学习的地方有两处：首先，这是一份连续时间尺度的数据，可以借此学习和训练循环函数的思维；其次，一共要绘制18张图，可以利用拼图包将其合并，进而复习巩固所学知识。今天主要讲解循环函数，希望能够给大家在突破路上提供一些帮助。
第一眼看到这张图，个人感触是既清晰又美观。
1）清楚每张图的具体年份，并且位置合理，使得布局紧凑；
2）从1999至2016年该病的死亡率逐渐加深，用鲜艳的色彩突出主题；
3）分布情况的标签使得更加清晰，总体来说值得大家学习和借鉴。
第二眼看到这张图，我会思考，如果是我要怎么画这张图呢？
1）如果是2年前的我，我可能会用R单独绘制每年的分布情况，再用PS进行拼图；
2）如今的我，会有所不同。第一遍，我也还是会按照原始的方法，将图一一绘制并用R包拼好（这个过程我会寻找数据处理的规律）。在绘制过程中，我发现连续18年的数据处理和绘图均可以改写成循环以便更简洁、明了、省时和省力。第二遍，我花费了一些时间将原本500多行的代码修改成循环代码，最后仅用了接近50行代码，这使得更清晰、更简洁、更便于流行，看起来很聪明的样子（当然，我也不是特别专业，相信会有更优化的代码，需要大家去摸索）。
这里，我想传达的是：学习R语言的最终目的，并不是仅仅为了复制他人代码满足自己的目的，而是能够编写相应的代码来完成（例如，自定义函数、循环函数、编写和创建R包等等）。当然，这个过程是需要积累和学习的。想要实现突破，个人感悟：1）R语言的基础知识得扎实和系统（推荐看书籍）；2）量变到质变，这是少不了的，这个过程属于思维和记忆的锻炼；3）思维的转变，当你已经能够轻松地看懂并模仿他人代码时，需要进一步学习更新，更深层次的知识（这里，特别指循环、定义函数、编写R包）。学习不能一蹴而就，但是R语言算是比较特殊的，它成就感来的比较快，比如今天学一个画图，自己能够模仿编写代码，这在短时间是可以实现的。
在公众号回复 关键词 "客服微信"，添加并备注进群学习可以获取对应的数据和全代码~
还有很多想说的话，未来咱们慢慢聊，今天进入主题：
主要讲解如何利用循环函数处理该图，不是为了让大家只针对这个图来学习，希望大家能够学习这种思维。
写一份代码最基本知识和过程：
1）代码注释必须有（更加清晰）；
2）从设置工作路径开始（这是你数据文件的位置）；
3）加载R包（为了运行所需要的函数），这里下载可以参考【R分享|实战】 新手福利~R包的安装与使用
4）读取数据；
# 清空当前环境变量
rm(list = ls())

# 设置工作路径
setwd()

# 加载R包
ps <- c('dplyr', 'maps', 'usmap', 'ggplot2', 'tidyverse', 'data.table') # 批量加载
lapply(ps, library, character.only=TRUE)

# 载入数据
population <- read_csv('NCHS_-_Drug_Poisoning_Mortality_by_County__United_States.csv')

5）处理数据；
# 由于本身数据的列名太长，重新定义第7列的列名
names(population)[7] <- 'death_rate'

# 获取R包自带数据的信息
county <- county.fips

# 合并数据
# %>% 通道符合表示然后，读取数据集时，不需要在函数中选择当前数据集作为对象（默认选中当前数据集）
death_merge <- population %>% left_join(county,by = c('FIPS'='fips')) # ?left_join 合并函数可以通过help查询学习
# 这里的FIPS是读取数据集的编号，与自带的美国数据集fips的编号对应合并
 
# 死亡率程度的颜色设定
cols = c("#A7CAEB", "#DFEDF8", "#F8EEC1", "#FFC166", "#FA842C", "#D91F15")

# 定义对应数据集中的死亡率范围
DR <- c("<2",'2-3.9','4-5.9','6-7.9','8-9.9',"10-11.9", "12-13.9", "14-15.9",
        "16-17.9", "18-19.9",'20-21.9','22-23.9','24-25.9','26-27.9','28-29.9','30+')

6）在写循环前我们对数据进行了一个总体处理；

# case_when是一个比较常用的函数，用来改变某列的变量
dr_total <- death_merge %>%
mutate(death_r=case_when( # 用mutate函数生成一列新的变量
  death_rate==DR[1]~1, # 例如，利用新定义的死亡率替换原有的死亡率便于后续画图上色。
  death_rate==DR[2]~1, # 这里就是将认为是一个死亡率范围的替换成一个颜色，即数字1~6。
  death_rate==DR[3]~2, # 与我们刚刚定义的6个颜色相匹配即可
  death_rate==DR[4]~2,
  death_rate==DR[5]~3,
  death_rate==DR[6]~3,
  death_rate==DR[7]~4,
  death_rate==DR[8]~4,
  death_rate==DR[9]~5,
  death_rate==DR[10]~5,
  death_rate==DR[11]~6,
  death_rate==DR[12]~6,
  death_rate==DR[13]~6,
  death_rate==DR[14]~6,
  death_rate==DR[15]~6,
  death_rate==DR[16]~6
))
7）循环开始；
因为这个数据是1999-2016共18年的数据，我的思路是根据每年先生成18个数据集，然后将他们拆分到每个数据集中，再用将他们打包成list合并，便于后续用到的函数（其要求对象是list数据结构）做准备。
# 重新命名新数据集第一列的列名
names(dr_total)[1] <- 'fips'

# 循环生成1999-2016年数据集便于后续画图
for (i in seq(1999,2016)){  # 循环是1999年-2016年
  datanames <- paste('D', i ,sep = '')  # 生成18个数据集的名称
  assign(datanames, filter(dr_total, Year==i))
} # filter（对上面dr_total数据集进行了按年的分割，生成了18个数据集）

# 用lapply 将18个数据集以list形式合并，便于后续绘图
death_rate_all <- lapply(paste0("D", 1999:2016), function(x) eval(as.name(x)))

8）循环绘图；

这里，真希望有一天我或者大家能够创建一个关于中国标准地图的数据集以及对应用来绘制中国地图的R包和函数！！！

我用了lapply这个函数来做批量画图，该函数比较常用。

lapply（x，FUN，...）

FUN：函数将被应用于X的每个元素。因此，常常可以与自定义函数联用做批处理。

大家仔细观察，其实函数的主要变化就是在data和label，因为这两个参数都与你的数据集有关系，label是根据每年的情况绘制不同年份的。其余参数都保持一致即可。

# 画图
# ?plot_usmap用于循环画18张美国死亡率分布图
all <- lapply(death_rate_all, function(x) plot_usmap(regions = "states", data= x, values = "death_r", color=alpha("white",0))+#option or correct
  scale_fill_gradientn(colours = c("#A7CAEB", "#DFEDF8", "#F8EEC1", "#FFC166", "#FA842C", "#D91F15"))+
  geom_text(data=x,aes(x=1100000,y=-2000000, label=x$`Year`[1]),size=3)+
  theme(legend.position = "none"))
# 函数的细节，各参数大家可以参考help。
# 注意data=x，x是function(x)，lable这里的x也是一样的，即death_rate_all。

9）拼图展示；拼图可以参考之前所学内容【R分享|实战】地表最全R拼图教程，告别AI和PS

# 拼图
library(patchwork)
all[[1]]+all[[2]]+ all[[3]]+all[[4]]+all[[5]]+all[[6]]+
  all[[7]]+all[[8]]+all[[9]]+all[[10]]+all[[11]]+all[[12]]+
  all[[13]]+all[[14]]+all[[15]]+all[[16]]+all[[17]]+all[[18]]+ plot_layout(nrow = 3, ncol=6)

10）添加图例完成绘制；

# 添加图例
# 这里两个R包可以上BiocManager平台或者Github平台下载
library(circlize)
library(ComplexHeatmap)

# 这部分是绘制图例的内容，不一一赘述了。大家可以通过help参看响应的参数讲解
color_need <- colorRamp2(breaks = c(0, 4, 8, 12, 16, 20, 24),
                         colors = c("#A7CAEB","#A7CAEB", "#DFEDF8", "#F8EEC1", "#FFC166", "#FA842C", "#D91F15"))

legend <- Legend(col_fun = color_need, title = "Overdose deaths per 100000", at=c (0, 4, 8, 12, 16, 20, 24),
                 labels = c(" ","4", "8", "12", "16","20"," "), title_position = "topcenter",
                 direction = "horizontal", title_gp = gpar(fontsize=8, fontface="bold"),
                 grid_height = unit(0.2, "cm"), legend_width = unit(6, "cm"))

draw(legend,x = unit(0.5, "npc"), y = unit(0.85, "npc"))

赞 (0)

相关推荐