1.EAPC的计算
数据要求
计算的国家需要有1990-2019年期间每一年的标准率
计算原理
EAPC的前提是假设在观察的整个期间，每年的变化持续稳定。 计算方法：以年份为自变量;对死亡率(发生率)进行常用对数转化之后,取各年份的几何均数,以此几何均数数列为因变量,拟合直线,即:Y=b+aX,其中,Y=Lg(死亡率),X为年份,则EAPC=(10a次方-1)*100% 载入相关R包
library(tidyverse)
library(dplyr)载入数据
data <- read.csv('EC_nation.csv',header = T)
EAPC <- data %>% filter(age=='Age-standardized') %>%
filter(metric== 'Rate') %>%
filter(measure=='Incidence') %>% .[,c(2,7,8)]
head(EAPC) 课程示例来源 location year val
课程示例来源 1 Rwanda 1990 18.1869299
课程示例来源 2 Morocco 1990 1.4311735
课程示例来源 3 Equatorial Guinea 1990 11.5443252
课程示例来源 4 Nigeria 1990 0.8669125
课程示例来源 5 Latvia 1990 2.8957074
课程示例来源 6 Zimbabwe 1990 14.7724806首先以单个国家进行讲解
a <- EAPC %>% filter(location=='China')
head(a)课程示例来源 location year val
课程示例来源 1 China 1990 20.96601
课程示例来源 2 China 1991 21.03550
课程示例来源 3 China 1992 20.89134
课程示例来源 4 China 1993 20.86542
课程示例来源 5 China 1994 20.57809
课程示例来源 6 China 1995 20.44211a$y <- log(a$y)
head(a$y)课程示例来源 [1] 7.595890 7.596392 7.596894 7.597396 7.597898 7.598399mod_simp_reg<-lm(y~year,data=a)
summary(mod_simp_reg)课程示例来源
课程示例来源 Call:
课程示例来源 lm(formula = y ~ year, data = a)
课程示例来源
课程示例来源 Residuals:
课程示例来源 Min 1Q Median 3Q Max
课程示例来源 -1.689e-05 -6.452e-06 2.323e-06 7.541e-06 9.294e-06
课程示例来源
课程示例来源 Coefficients:
课程示例来源 Estimate Std. Error t value Pr(>|t|)
课程示例来源 (Intercept) 6.603e+00 3.643e-04 18123 <2e-16 ***
课程示例来源 year 4.989e-04 1.818e-07 2745 <2e-16 ***
课程示例来源 ---
课程示例来源 Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
课程示例来源
课程示例来源 Residual standard error: 8.617e-06 on 28 degrees of freedom
课程示例来源 Multiple R-squared: 1, Adjusted R-squared: 1
课程示例来源 F-statistic: 7.534e+06 on 1 and 28 DF, p-value: < 2.2e-16summary(mod_simp_reg)[["coefficients"]]课程示例来源 Estimate Std. Error t value Pr(>|t|)
课程示例来源 (Intercept) 6.6031294386 3.643419e-04 18123.443 1.599397e-100
课程示例来源 year 0.0004988831 1.817603e-07 2744.731 1.434434e-77summary(mod_simp_reg)[["coefficients"]][2,1] ##斜率课程示例来源 [1] 0.0004988831summary(mod_simp_reg)[["coefficients"]][2,2] ##斜率的标准误课程示例来源 [1] 1.817603e-07## 率的平均变化率
(exp(summary(mod_simp_reg)[["coefficients"]][2,1])-1)*100课程示例来源 [1] 0.04990076## 可信区间 mean+-1.96*se
(exp(summary(mod_simp_reg)[["coefficients"]][2,1]-1.96*summary(mod_simp_reg)[["coefficients"]][2,2])-1)*100课程示例来源 [1] 0.04986511(exp(summary(mod_simp_reg)[["coefficients"]][2,1]+1.96*summary(mod_simp_reg)[["coefficients"]][2,2])-1)*100课程示例来源 [1] 0.0499364建立循环语句计算每个国家的EAPC
EAPC <- data %>% filter(age=='Age-standardized') %>%
filter(metric== 'Rate') %>%
filter(measure=='Incidence') %>% .[,c(2,7,8)]
EAPC_cal <- data.frame(location=unique(EAPC$location),
EAPC=rep(0,times=length(unique(EAPC$location))),
LCI=rep(0,times=length(unique(EAPC$location))),
UCI=rep(0,times=length(unique(EAPC$location))))
for (i in 1:length(unique(EAPC$location))){
country_cal <- as.character(EAPC_cal[i,1])
a <- subset(EAPC, EAPC$location==country_cal)
a$y <- log(a$val)
mod_simp_reg<-lm(y~year,data=a)
estimate <- (exp(summary(mod_simp_reg)[["coefficients"]][2,1])-1)*100
low <- (exp(summary(mod_simp_reg)[["coefficients"]][2,1]-1.96*summary(mod_simp_reg)[["coefficients"]][2,2])-1)*100
high <- (exp(summary(mod_simp_reg)[["coefficients"]][2,1]+1.96*summary(mod_simp_reg)[["coefficients"]][2,2])-1)*100
EAPC_cal[i,2] <- estimate
EAPC_cal[i,3] <- low
EAPC_cal[i,4] <- high
}数据整理
EAPC_cal <- EAPC_cal %>% mutate(EAPC=round(EAPC,2),
LCI=round(LCI,2),
UCI=round(UCI,2))
EAPC_cal <- EAPC_cal %>% mutate(EAPC_CI = paste(EAPC, LCI,sep = '\n(')) %>%
mutate(EAPC_CI = paste(EAPC_CI, UCI,sep = ' to ')) %>%
mutate(EAPC_CI = paste0(EAPC_CI, ')'))
head(EAPC_cal)课程示例来源 location EAPC LCI UCI EAPC_CI
课程示例来源 1 Rwanda -2.64 -2.96 -2.32 -2.64\n(-2.96 to -2.32)
课程示例来源 2 Morocco 0.23 0.08 0.39 0.23\n(0.08 to 0.39)
课程示例来源 3 Equatorial Guinea -1.26 -1.51 -1.01 -1.26\n(-1.51 to -1.01)
课程示例来源 4 Nigeria 0.33 0.17 0.49 0.33\n(0.17 to 0.49)
课程示例来源 5 Latvia 0.55 0.26 0.84 0.55\n(0.26 to 0.84)
课程示例来源 6 Zimbabwe 0.06 -0.21 0.34 0.06\n(-0.21 to 0.34)咳咳咳，硬核广告
GBDR如何实现一行代码计算EAPC
# GBDR包如何实现一行代码计算EAPC
library(GBDR)
EC <- read.csv('IHME-GBD_2019_DATA-9bf5eaf2-1.csv')
result <- GBDeapc(EC,sex=T,rei=T,sep=' to ')# 结果展示
knitr::kable(head(result),digits=2,align = 'c')| location | measure | sex | cause | rei | EAPC | LCI | UCI | EAPC_95CI |
|---|---|---|---|---|---|---|---|---|
| High-middle SDI | DALYs (Disability-Adjusted Life Years) | Both | All causes | All risk factors | -2.02 | -2.18 | -1.85 | -2.02 |
| (-2.18 to -2.18) | ||||||||
| High-middle SDI | DALYs (Disability-Adjusted Life Years) | Both | All causes | All risk factors | -2.16 | -2.28 | -2.04 | -2.16 |
| (-2.28 to -2.28) | ||||||||
| High-middle SDI | DALYs (Disability-Adjusted Life Years) | Both | All causes | All risk factors | -2.06 | -2.21 | -1.91 | -2.06 |
| (-2.21 to -2.21) | ||||||||
| High-middle SDI | Deaths | Both | All causes | All risk factors | -1.81 | -1.97 | -1.65 | -1.81 |
| (-1.97 to -1.97) | ||||||||
| High-middle SDI | Deaths | Both | All causes | All risk factors | -2.09 | -2.24 | -1.93 | -2.09 |
| (-2.24 to -2.24) | ||||||||
| High-middle SDI | Deaths | Both | All causes | All risk factors | -1.92 | -2.08 | -1.75 | -1.92 |
| (-2.08 to -2.08) |
2.世界地图的拼接
以下图为例进行绘制 
载入相关R包
library(sf)
library(patchwork)
library(ggplot2)
library(tidyverse)载入数据
GBD <- read.csv("national HIV.csv")
location <- read.csv("location.csv")
GBD <- left_join(GBD,location,by="location")主图绘制
# shp数据的读取与配置
map <- st_read("世界国家.shp") #
map <- st_set_crs(map,4326)## 绘制数据读取
main_map_data <- left_join(map,GBD,by=c("NAME"="location3")) %>%
filter(measure=="Incidence") %>%
filter(year==2019) %>%
filter(sex=="Both")
head(main_map_data)课程示例来源 Simple feature collection with 6 features and 21 fields
课程示例来源 Geometry type: MULTIPOLYGON
课程示例来源 Dimension: XY
课程示例来源 Bounding box: xmin: -141 ymin: 41.38056 xmax: -11.31232 ymax: 83.62742
课程示例来源 Geodetic CRS: WGS 84
课程示例来源 OBJECTID NAME FENAME FCNAME SOC POP ELEMID
课程示例来源 1 1 <NA> <NA> <NA> <NA> 0 0
课程示例来源 2 1 <NA> <NA> <NA> <NA> 0 0
课程示例来源 3 1 <NA> <NA> <NA> <NA> 0 0
课程示例来源 4 1 <NA> <NA> <NA> <NA> 0 0
课程示例来源 5 2 GREENLAND Greenland <U+00B8><f1><c1><ea><U+003C> GRL 6 1
课程示例来源 6 3 CANADA Canada <U+00BC><d3><c4><U+00F4><f3> CAN 3166 2
课程示例来源 SHAPE_LENG SHAPE_AREA ID1 measure location sex
课程示例来源 1 154.0089 27.50754 1 Incidence Taiwan (Province of China) Both
课程示例来源 2 154.0089 27.50754 1 Incidence Guam Both
课程示例来源 3 154.0089 27.50754 1 Incidence Palestine Both
课程示例来源 4 154.0089 27.50754 1 Incidence South Sudan Both
课程示例来源 5 1359.5926 662.85536 2 Incidence Greenland Both
课程示例来源 6 3635.7366 1692.80859 3 Incidence Canada Both
课程示例来源 age cause metric year val upper lower
课程示例来源 1 Age-standardized HIV/AIDS Rate 2019 6.3710681 10.4462067 3.0948698
课程示例来源 2 Age-standardized HIV/AIDS Rate 2019 7.2915286 15.1831608 3.1779404
课程示例来源 3 Age-standardized HIV/AIDS Rate 2019 0.4226954 0.6285992 0.2908644
课程示例来源 4 Age-standardized HIV/AIDS Rate 2019 121.4051481 364.5104827 19.5385624
课程示例来源 5 Age-standardized HIV/AIDS Rate 2019 21.2943560 36.0669938 9.7201308
课程示例来源 6 Age-standardized HIV/AIDS Rate 2019 9.8149295 15.3842662 4.7848242
课程示例来源 location2 geometry
课程示例来源 1 <NA> MULTIPOLYGON (((-88.72527 4...
课程示例来源 2 <NA> MULTIPOLYGON (((-88.72527 4...
课程示例来源 3 <NA> MULTIPOLYGON (((-88.72527 4...
课程示例来源 4 <NA> MULTIPOLYGON (((-88.72527 4...
课程示例来源 5 Greenland MULTIPOLYGON (((-50.2286 62...
课程示例来源 6 Canada MULTIPOLYGON (((-84.91705 7...绘图
p <- main_map_data %>%
ggplot()+
geom_sf(aes(group=NAME,fill=val),color='black',size = 0.5) +
theme_void()+
scale_fill_distiller(palette="Spectral",# 色盘
name="ASR") +
labs(x="",y="",title="")+
theme(legend.position = c(0.1,0.2),
legend.title = element_text(color="black",
size = 10,
#family = "A",
#face = "bold"
),
plot.title = element_text(color="black",
size = 14,
#family = "A",
#face = "bold"
),
legend.text = element_text(color="black",
size = 10,
#family = "A",
#face = "bold"
),
panel.grid=element_blank(),
#legend.position = 'none',
axis.title.x = element_blank(),
axis.text.x = element_blank(),
axis.ticks.x = element_blank(),
axis.title.y = element_blank(),
axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
)
绘制小图
思路：考虑到shp文件读取的数据大小太大了，影响运行速度，所以小图中不涉及到中国区域的数据采用ggplot2自带的map数据
worldData <- map_data('world')
small_map_data <- GBD %>%
filter(measure=="Incidence") %>%
filter(year==2019) %>%
filter(sex=="Both")
small_map_data$location[small_map_data$location == 'United States of America'] = 'USA'
small_map_data$location[small_map_data$location == 'Russian Federation'] = 'Russia'
small_map_data$location[small_map_data$location == 'United Kingdom'] = 'UK'
small_map_data$location[small_map_data$location == 'Congo'] = 'Republic of Congo'
small_map_data$location[small_map_data$location == "Iran (Islamic Republic of)"] = 'Iran'
small_map_data$location[small_map_data$location == "Democratic People's Republic of Korea"] = 'North Korea'
small_map_data$location[small_map_data$location == "Taiwan (Province of China)"] = 'Taiwan'
small_map_data$location[small_map_data$location == "Republic of Korea"] = 'South Korea'
small_map_data$location[small_map_data$location == "United Republic of Tanzania"] = 'Tanzania'
small_map_data$location[small_map_data$location == "Bolivia (Plurinational State of)"] = 'Bolivia'
small_map_data$location[small_map_data$location == "Venezuela (Bolivarian Republic of)"] = 'Venezuela'
small_map_data$location[small_map_data$location == "Czechia"] = 'Czech Republic'
small_map_data$location[small_map_data$location == "Republic of Moldova"] = 'Moldova'
small_map_data$location[small_map_data$location == "Viet Nam"] = 'Vietnam'
small_map_data$location[small_map_data$location == "Lao People's Democratic Republic"] = 'Laos'
small_map_data$location[small_map_data$location == "Syrian Arab Republic"] = 'Syria'
small_map_data$location[small_map_data$location == "North Macedonia"] = 'Macedonia'
small_map_data$location[small_map_data$location == "Micronesia (Federated States of)"] = 'Micronesia'
small_map_data$location[small_map_data$location == "Macedonia"] = 'North Macedonia'
small_map_data$location[small_map_data$location == "Trinidad and Tobago"] = 'Trinidad'
a <- small_map_data[small_map_data$location == "Trinidad",]
a$location <- 'Tobago'
small_map_data <- rbind(small_map_data,a)
small_map_data$location[small_map_data$location == "Cabo Verde"] = 'Cape Verde'
small_map_data$location[small_map_data$location == "United States Virgin Islands"] = 'Virgin Islands'
small_map_data$location[small_map_data$location == "Antigua and Barbuda"] = 'Antigu'
a <- small_map_data[small_map_data$location == "Antigu",]
a$location <- 'Barbuda'
small_map_data <- rbind(small_map_data,a)
small_map_data$location[small_map_data$location == "Saint Kitts and Nevis"] = 'Saint Kitts'
a <- small_map_data[small_map_data$location == "Saint Kitts",]
a$location <- 'Nevis'
small_map_data <- rbind(small_map_data,a)
small_map_data$location[small_map_data$location == "Côte d'Ivoire"] = 'Ivory Coast'
small_map_data$location[small_map_data$location == "Saint Vincent and the Grenadines"] = 'Saint Vincent'
a <- small_map_data[small_map_data$location == "Saint Vincent",]
a$location <- 'Grenadines'
small_map_data <- rbind(small_map_data,a)
small_map_data$location[small_map_data$location == "Eswatini"] = 'Swaziland'
small_map_data$location[small_map_data$location == "Brunei Darussalam"] = 'Brunei'small_map_data <- full_join(worldData,small_map_data,by = c('region'='location')) %>%
filter(val != "NA")
dim(small_map_data)
head(small_map_data)课程示例来源 [1] 92595 17
课程示例来源 long lat group order region subregion measure sex
课程示例来源 1 74.89131 37.23164 2 12 Afghanistan <NA> Incidence Both
课程示例来源 2 74.84023 37.22505 2 13 Afghanistan <NA> Incidence Both
课程示例来源 3 74.76738 37.24917 2 14 Afghanistan <NA> Incidence Both
课程示例来源 4 74.73896 37.28564 2 15 Afghanistan <NA> Incidence Both
课程示例来源 5 74.72666 37.29072 2 16 Afghanistan <NA> Incidence Both
课程示例来源 6 74.66895 37.26670 2 17 Afghanistan <NA> Incidence Both
课程示例来源 age cause metric year val upper lower location2
课程示例来源 1 Age-standardized HIV/AIDS Rate 2019 2.346579 9.860539 0.1122461 Afghanistan
课程示例来源 2 Age-standardized HIV/AIDS Rate 2019 2.346579 9.860539 0.1122461 Afghanistan
课程示例来源 3 Age-standardized HIV/AIDS Rate 2019 2.346579 9.860539 0.1122461 Afghanistan
课程示例来源 4 Age-standardized HIV/AIDS Rate 2019 2.346579 9.860539 0.1122461 Afghanistan
课程示例来源 5 Age-standardized HIV/AIDS Rate 2019 2.346579 9.860539 0.1122461 Afghanistan
课程示例来源 6 Age-standardized HIV/AIDS Rate 2019 2.346579 9.860539 0.1122461 Afghanistan
课程示例来源 location3
课程示例来源 1 AFGHANISTAN
课程示例来源 2 AFGHANISTAN
课程示例来源 3 AFGHANISTAN
课程示例来源 4 AFGHANISTAN
课程示例来源 5 AFGHANISTAN
课程示例来源 6 AFGHANISTANfig <- small_map_data %>%
ggplot()+
geom_polygon(aes(x = long, y = lat,group = group,fill=val),
colour="black",size=0.5) +
theme_bw()+
scale_fill_distiller(palette="Spectral",# 色盘
name="ASR") +
theme(legend.position = 'none',
legend.title = element_blank(),
plot.title = element_text(color="black",
size = 10,
#family = "A",
#face = "bold"
),
legend.text = element_text(color="black",
size = 12,
#family = "A",
#face = "bold"
),
panel.grid=element_blank(),
panel.border = element_rect(color='black',
fill=NA,
size = 0.5),
#legend.position = 'none',
axis.title.x = element_blank(),
axis.text.x = element_blank(),
axis.ticks.x = element_blank(),
axis.title.y = element_blank(),
axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
)
绘制Caribbean and central America地区
p2 <- fig+ labs(x=" ",y="",title="Caribbean and central America")+
coord_cartesian(xlim = c(-92,-60),ylim = c(5,27))
绘制Persian Gulf地区
p3 <- fig+ labs(x=" ",y="",title="Persian Gulf")+
coord_cartesian(xlim = c(45,55),ylim = c(19,31))
绘制Balkan Peninsula地区
p4 <- fig+ labs(x=" ",y="",title="Balkan Peninsula")+
coord_cartesian(xlim = c(12,32),ylim = c(35,53))
绘制Sotheast Asia地区
p5 <- fig+ labs(x=" ",y="",title="Sotheast Asia")+
coord_cartesian(xlim = c(98,123),ylim = c(-10,8))
绘制West Africa地区
p6 <- fig+ labs(x=" ",y="",title="West Africa") +
coord_cartesian(xlim = c(-17,-7),ylim = c(7,20))
绘制Eastern Mediterranean地区
p7 <- fig+ labs(x=" ",y="",title="Eastern \nMediterranean")+
coord_cartesian(xlim = c(32,37),ylim = c(29,35))
绘制Northern Europe地区
p8 <- fig+ labs(x=" ",y="",title="Northern Europe") +
coord_cartesian(xlim = c(5,25),ylim = c(48,60))
使用patchwork进行拼图
思路
开始绘制
A= (p6|p7)/p8 
plot<- p +
(p2+p3+p4+p5+A+plot_layout(ncol = 5,widths=c(1.5,1,1.1,1.2,1)))+
plot_layout(ncol = 1,heights = c(9, 3)) 
咳咳咳，硬核广告
GBDR如何实现一行绘制GBD世界地图
# GBDR如何实现一行绘制GBD世界地图
library(GBDR)
GBD <- read.csv("national HIV.csv") %>%
filter(measure=="Incidence") %>%
filter(year==2019) %>%
filter(sex=="Both")
plot <- GBDworldmap(data=GBD)
双坐标轴的绘制
思路
双坐标轴的原理：一共两套数据，第一套数据先画出来，第一个y轴在左边；第二套数据是第一套的数据基础上将y轴上的数值转换成第一套的y轴数值，但需要保证转换后的第二套数据的y轴数值最大值需要小于第一套数据的y轴数值最大值
因此，我们需要计算第一套数据和第二套数据最大值的比值比，便于进行转换
数据载入
data <- read.csv('EC_nation.csv')
Number <- data %>% filter(age=='All Ages') %>%
filter(metric== 'Number') %>%
filter(location == "China") %>%
filter(measure=='Incidence')
ASR <- data %>% filter(age=='Age-standardized') %>%
filter(metric== 'Rate') %>%
filter(location == "China") %>%
filter(measure=='Incidence')
## ratio的目的是为了让副坐标轴的最大值能够落在主坐标轴的区间内
ratio <- max(ASR$val)/max(Number$val)
head(Number)课程示例来源 measure location sex age cause metric year val
课程示例来源 1 Incidence China Both All Ages Esophageal cancer Number 1990 173686.9
课程示例来源 2 Incidence China Both All Ages Esophageal cancer Number 1991 178919.4
课程示例来源 3 Incidence China Both All Ages Esophageal cancer Number 1992 182370.8
课程示例来源 4 Incidence China Both All Ages Esophageal cancer Number 1993 186876.4
课程示例来源 5 Incidence China Both All Ages Esophageal cancer Number 1994 189161.5
课程示例来源 6 Incidence China Both All Ages Esophageal cancer Number 1995 192971.1
课程示例来源 upper lower
课程示例来源 1 203391.3 112107.1
课程示例来源 2 208176.7 111573.9
课程示例来源 3 212073.8 113522.6
课程示例来源 4 214966.9 116275.1
课程示例来源 5 217391.1 119163.3
课程示例来源 6 218575.0 117945.6head(ASR)课程示例来源 measure location sex age cause metric year
课程示例来源 1 Incidence China Both Age-standardized Esophageal cancer Rate 1990
课程示例来源 2 Incidence China Both Age-standardized Esophageal cancer Rate 1991
课程示例来源 3 Incidence China Both Age-standardized Esophageal cancer Rate 1992
课程示例来源 4 Incidence China Both Age-standardized Esophageal cancer Rate 1993
课程示例来源 5 Incidence China Both Age-standardized Esophageal cancer Rate 1994
课程示例来源 6 Incidence China Both Age-standardized Esophageal cancer Rate 1995
课程示例来源 val upper lower
课程示例来源 1 20.96601 24.32625 13.62131
课程示例来源 2 21.03550 24.27982 13.29404
课程示例来源 3 20.89134 24.12736 13.22623
课程示例来源 4 20.86542 23.92326 13.11744
课程示例来源 5 20.57809 23.51216 13.09761
课程示例来源 6 20.44211 23.03363 12.73444ratio课程示例来源 [1] 8.102172e-05第一幅图
p <- ggplot(Number,aes(year,val))+
geom_col(aes(fill=sex),position = 'dodge',width = 0.8)+
geom_errorbar(aes(year,group=sex,ymin=lower,ymax=upper),
position = position_dodge(width = 0.8),
width=0.7,cex=0.5)+
labs(title = NULL,x='Year',y='Number of cases') +
theme_bw() +
theme(plot.title=element_text(hjust=0.5),
axis.text.x=element_text(vjust=1,size=8,color='black'),
axis.text.y=element_text(size=8,color='black'),
axis.title.y = element_text(size = 10),
axis.title.x = element_text(size = 10),
title = element_text(size = 10, hjust = 0.5),
legend.position = 'right')
第二幅图
q <- ggplot()+
theme_bw() +
labs(title = NULL,x='Year',y='ASR (per 100000 populations)') +
theme(plot.title=element_text(hjust=0.5),
axis.text.x=element_text(vjust=1,size=8,color='black'),
axis.text.y=element_text(size=8,color='black'),
axis.title.y = element_text(size = 10),
axis.title.x = element_text(size = 10),
title = element_text(size = 10, hjust = 0.5),
legend.position = 'right') +
geom_ribbon(data=ASR,
aes(x=year,ymin=lower,ymax=upper,
fill=sex),
alpha=0.1)+
geom_line(data=ASR,
aes(x=year,y=val,
color=sex))
将2套数据整合至一幅图中
plot <- ggplot(Number,aes(year,val))+
geom_col(aes(fill=sex),position = 'dodge',width = 0.8)+
geom_errorbar(aes(year,group=sex,ymin=lower,ymax=upper),
position = position_dodge(width = 0.8),
width=0.7,cex=0.5)+
labs(title = NULL,x='Year',y='Number of cases') +
theme_bw() +
theme(plot.title=element_text(hjust=0.5),
axis.text.x=element_text(vjust=1,size=8,color='black'),
axis.text.y=element_text(size=8,color='black'),
axis.title.y = element_text(size = 10),
axis.title.x = element_text(size = 10),
title = element_text(size = 10, hjust = 0.5),
legend.position = 'right') +
geom_ribbon(data=ASR,
aes(x=year,ymin=lower/ratio,ymax=upper/ratio,
fill=sex),
alpha=0.1)+
geom_line(data=ASR,
aes(x=year,y=val/ratio,
color=sex)) +
scale_y_continuous(sec.axis = sec_axis(~.*ratio,
name="ASR (per 100000 populations)"))
咳咳咳，硬核广告
GBDR如何实现一行绘制双坐标轴
# GBDR如何实现一行绘制GBD世界地图
library(GBDR)
data <- read.csv('EC_nation.csv')
plot <- ggDx(data,auto_ratio = TRUE,
x_axes = "year",
measure_name = "Incidence",
location_name = "China")
练习题
1.利用提供的GBD数据文件IHD_nation.csv计算204国家的EAPC，并将结果绘制成地图
2.利用提供的GBD数据文件绘制任一一个国家的双坐标轴图，并以sex作为group进行绘图
参考文献
- B F Hankey, L A Ries, C L Kosary, E J Feuer, R M Merrill, L X Clegg, B K Edwards,Partitioning linear trends in age-adjusted rates, Cancer Causes Control,2000 Jan;11(1):31-5