【科研绘图】R代码重现文献插图
代码依然是文本，不是图片，感兴趣的朋友可以直接试着玩儿，图片的还原度大概99%吧……
论文链接：https://www.ncbi.nlm.nih.gov/pubmed/?term=31170283
图1：森林图
# 加载 forestplot R package
library(forestplot)
# 数据
tabledata <- data.frame(
mean=c(NA,0.974, 0.923, 0.952, 0.764, 0.997, 0.949, 0.882, 0.902, 0.966, 0.931),
lower=c(NA,0.875, 0.853, 0.874, 0.696, 0.935, 0.880, 0.751, 0.857, 0.912, 0.908),
upper=c(NA, 1.084, 1.000, 1.038, 0.839, 1.062, 1.023, 1.037, 0.949, 1.024, 0.954))
# 文本
tabletext<-cbind(
c("Study" , "GerMIFSI", "GerMIFSII", "GerMIFSIII", "GerMIFSIV", "GerMIFSV", "GerMIFSVI", "Cardiogenics", "WTCCC", "MIGen", "FE meta-analysis"),
c("N CAD cases", "622", "1192", "1055", "954", "2437", "1637", "382", "1900", "2901","p = 1.52e-8"),
c("N Controls", "1551", "1256", "1441", "1136", "1574", "1180", "404", "2911", "3018",NA),
c("Odds ratio [95% CI]","0.974 [0.875, 1.084]", "0.923 [0.853, 1.000]", "0.952 [0.874, 1.038]", "0.764 [0.696, 0.839]", "0.997 [0.935, 1.062]", "0.949 [0.880, 1.023]", "0.882 [0.751, 1.037]", "0.902 [0.857, 0.949]", "0.966 [0.912, 1.024]","0.931 [0.908, 0.954]"))
# x轴坐标刻度细节
xticks <- seq(.6,1.2,by=.1)
xtlab <- c("0.600","0.700","0.800","0.900","1.000","1.100","1.200")
attr(xticks, "labels") <- xtlab
# 画图
forestplot(tabletext, # 文本
tabledata, # 数据
col=fpColors(box="black",line="black", summary="black", hrz_lines = "#444444"), # 图形样式设置
is.summary=c(TRUE,rep(FALSE,9),TRUE), # 设置字体样式
boxsize=tabledata$mean*0.15,
# 设置置信区间样式
ci.vertices=TRUE,
ci.vertices.height = 0.05,
lty.ci=1,
lwd.ci=1,
# 图形细节
colgap = unit(3,'mm'), # 调整列间距
graphwidth = unit(84,'mm'), # 设置图形宽度
mar = unit(c(.5,.4,.4,.3),'mm'), # 调整图形页边距
graph.pos = 4, # 森林图放在第4列
zero = 1, # 显示y=1的无效线（参考线）
lwd.zero = 1, # 设置无效线的宽度
hrzl_lines=list("2" = gpar(lty=1,lwd=1), # hrzl_lines向图中添加水平线：为True 或 gpar列表。
"11" = gpar(lty=1,lwd=1)), # 在第2行、11行之前加水平线
# 坐标轴细节
xlab="Odds Ratio", #x轴的标题
xticks = xticks,
lwd.xaxis =1,
txt_gp=fpTxtGp(label=gpar(cex=1),xlab=gpar(cex=1),ticks=gpar(cex=0.5)) # 所有文本元素的字体
)
图2：条图+森林图
# 推荐阅读：https://cloud.tencent.com/developer/article/1093077
library(ggplot2)
dataBar=data.frame(
label=c("1(Low)","2","3","4","5(High)"),
type=rep(c("case","control"),each=5),
freq=c(21, 20.2, 20.1, 19.4, 19.2, 19.1, 19.5, 19.9, 20.5, 20.7))
dataError<-data.frame(
label=c("1(Low)","2","3","4","5(High)"),
OR=c(1, 0.89, 0.89, 0.85, 0.79),
ORL=c(1, 0.82, 0.82, 0.79, 0.73),
ORU=c(1, 0.96, 0.96, 0.92, 0.86))
ggplot()+
geom_bar(data = dataBar, aes(x = label, y = freq, fill=type),stat = 'identity',position = "dodge")+
coord_cartesian(xlim=c(0.5,5.5),ylim=c(18,24.5),expand = 0)+ # coord - 使用的仍是所有数据，只是展示的仅该部分数据；如同用放大镜看数据
geom_point(data=dataError,aes(x=label,y=rescale(OR,c(21.5,23.8))),size=5,color="black")+ # OR在第一纵轴的映射范围
geom_errorbar(data=dataError,aes(x=label,ymin=rescale(ORL,c(20.8,23.8)),ymax=rescale(ORU,c(22.4,23.8))),color="black",width=.1,size=1.5)+ # ORH在第一纵轴的映射范围
geom_segment(data=dataError,aes(x=1,xend=5.55,y=23.8,yend=23.8),color="lightblue",lty=2,size=1,alpha=0.2)+
geom_segment(data=dataError,aes(x=5,xend=5.55,y=21.5,yend=21.5),color="lightblue",lty=2,size=1,alpha=0.2)+
scale_y_continuous(breaks=seq(18,24.6,by=1), name="Individuals (%)", labels=sprintf("%2.1f",seq(18,24.6,by=1)),
sec.axis = sec_axis( ~rescale(c(18,24.6),c(0.47,1.065)),
breaks=pretty_breaks(11)(seq(0.50,1.05,0.05)),
name = "CAD odds ratio",
labels=sprintf("%2.2f",seq(0.5,1.05,by=0.05))))+
# 去背景去网格
theme_light()+ # 浅背景框
# theme(panel.grid=element_blank())+ # 无网格线
theme(panel.border=element_rect(colour = "grey50"))+ # 边框颜色
theme(panel.grid.major.y = element_line(colour = "grey80"))+ # 主要的网格线及颜色
# 修改坐标轴标签
xlab("Genetic education score")+
theme(axis.title.x =element_text(face="bold",size=14), axis.title.y=element_text(face="bold",size=14))+
# 修改legend样式
scale_fill_discrete("",breaks=c("case","control"),labels=c("CAD cases (N = 13080)","Control (N = 14471)"))+
theme(legend.position=c(.85,.95))+
theme(legend.text=element_text(face="plain",size=12))+
theme(legend.background = element_rect(fill = NA))+ # 图例背景
theme(plot.margin = unit(c(2,3,2,3),"lines"))