|
代码依然是文本，不是图片，感兴趣的朋友可以直接试着玩儿，图片的还原度大概99%吧…… 论文链接：https://www.ncbi.nlm./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")) |
|
|
来自： hucy_Bioinfo > 《科研绘图》
