forestplot 绘制森林图

setwd('G:\\cancer\\figure')
library(forestplot)
options(digits = 2)
data1 = read.table('eFigure 3.txt',header = T,sep = '\t')
data1 = rbind(c('Type of cancer','Protein','Instructment variant', 'Beta_SMR','OR(95%CI)','NA','NA','NA','P_SMR','P_HEIDI','PPH4','P_sensitivity'),
              data1[1:13,])


data1[, 6:8] <- lapply(data1[, 6:8], as.numeric)
data1[2:16,9:12] = lapply(data1[2:16,9:12], as.numeric)

fig <- forestplot(
  data1[, c(1, 2,3,4,5,9,10,11,12)],   # 选择要在森林图中显示的数据列,第1、5、6列
  mean = data1[, 6],     # 指定均值数据列(HR),它将显示为森林图的小方块
  lower = data1[, 7],    # 指定95%置信区间的下限数据列
  upper = data1[, 8],    # 指定95%置信区间的上限数据列,这些数据将显示为线段穿过方块
  zero = 1, # 设置零线或参考线为HR=1,这是x轴的垂直线
  lwd.zero = 2,
  boxsize = 0.2, # 设置小方块的大小
  lwd.xaxis = 0.5,
  
  col = fpColors(box = 'black', 
                 lines = 'black'),
  lwd.ci = 1.5,
  lty.ci = 2,
  xticks = c(0,1,2,3),
  graph.pos = 6,# 指定森林图应该插入到图形中的位置,这里是第2列
  hrzl_lines = list(               # 水平线样式的设置
    "1" = gpar(lty = 1, lwd = 2),  # 均值线
    "2" = gpar(lty = 1, lwd = 2),           # 下限和上限之间的虚线
    "4" = gpar(lwd = 1, lty = 2),  # 下限和上限线
    '6' = gpar(lwd = 1, lty = 2),
    '10' = gpar(lwd = 1, lty = 2),
    '13' = gpar(lwd = 1, lty = 2)
  )
)
fig

setwd('G:\\cancer\\figure')
library(forestploter)
library(openxlsx)
data = read.xlsx('Table 1.xlsx',fillMergedCells = F)
data = read.table('Table 1.txt',header = T,sep = '\t',check.names = F)

#非计算列的NA值用空值替代

data$`Type of cancer` <- ifelse(is.na(data$`Type of cancer`), "", data$`Type of cancer`)
data$`Gene transcription` <- ifelse(is.na(data$`Gene transcription`), "", data$`Gene transcription`)
data$`DNA methylation`<- ifelse(is.na(data$`DNA methylation`), "", data$`DNA methylation`)
data$`Protein expression`<- ifelse(is.na(data$`Protein expression`), "", data$`Protein expression`)
data = format(data,justify = 'centre')

data$`OR1(95%CI)` <- paste(rep(" ", 20), collapse = " ")

data$`OR2(95%CI)` <- paste(rep(" ", 20), collapse = " ")
data$`OR3(95%CI)` <- paste(rep(" ", 20), collapse = " ")
data[,3:5] = lapply(data[,3:5], as.numeric)
data[,7:9] = lapply(data[,7:9], as.numeric)
data[,11:13] = lapply(data[,11:13], as.numeric)
data$`OR1(95%CI)` <- ifelse(is.na(data$OR1), "",
                           sprintf("%.2f (%.2f - %.2f)",
                                   data$OR1, data$low1, data$high1))
data$`OR2(95%CI)` <- ifelse(is.na(data$OR2), "",
                            sprintf("%.2f (%.2f - %.2f)",
                                    data$OR2, data$low2, data$high2))
data$`OR3(95%CI)` <- ifelse(is.na(data$OR3), "",
                            sprintf("%.2f (%.2f - %.2f)",
                                    data$OR3, data$low3, data$high3))

data$`OR11` <- paste(rep(" ", 20), collapse = " ")
data$`OR22` <- paste(rep(" ", 20), collapse = " ")
data$`OR33` <- paste(rep(" ", 20), collapse = " ")

tm <- forest_theme(base_size = 10,  #文本的大小
                   # Confidence interval point shape, line type/color/width
                   ci_pch = c(15,18,20),   # 可信区间点的形状
                   ci_col = c("#762a83",'#4daf4a','grey'),    # CI的颜色
                   ci_fill = c("blue",'green','red'), # CI中se点的颜色填充
                   legend_value = c('Transcription level','Methylation level','Protein level'),
                   ci_alpha = 0.8,        # CI透明度
                   ci_lty = 1,            # CI的线型
                   ci_lwd = 1.5,          # CI的线宽
                   ci_Theight = 0.2, # Set an T end at the end of CI  CI的高度,默认是NULL
                   # Reference line width/type/color   参考线默认的参数,中间的竖的虚线
                   refline_lwd = 1,       #中间的竖的虚线
                   refline_lty = 2,
                   refline_col = "#A0D600FF",
                   # Vertical line width/type/color  垂直线宽/类型/颜色   可以添加一条额外的垂直线,如果没有就不显示
                   vertline_lwd = ,              #可以添加一条额外的垂直线,如果没有就不显示
                   vertline_lty = "dashed",
                   vertline_col = "grey20",
                   # Change summary color for filling and borders   更改填充和边框的摘要颜色
                   summary_fill = "yellow",       #汇总部分大菱形的颜色
                   summary_col = "#4575b4",
                   # Footnote font size/face/color  脚注字体大小/字体/颜色
                   footnote_cex = 0.6,
                   footnote_fontface = "italic",
                   footnote_col = "red")


p <- forest(
  data[,c(1, 2,14,17, 6, 15,18, 10, 16,19)],        # 选择要在森林图中使用的数据列
  est = list(
    data$OR1,
    data$OR2,
    data$OR3
  ),
  lower = list(
    data$low1,
    data$low2,
    data$low3
  ), 
  upper = list(
    data$high1,
    data$high2,
    data$high3
  ),
  vert_line = c(4,7),# 添加垂直
  ci_column = c(4, 7, 10), 
  ci_lwd = 2,
  ci_pch = 15,
  ci_col = "#762a83",
  ci_fill = "blue",
  ci_alpha = 0.8,
  ci_lty = 1,
  ci_Theight = 0.2,
  ref_line = 1,
  xlim = list(c(0,3),c(0.3,1.5),c(0,3.5)),
  ticks_at = list(c(0,0.5, 1,1.5,2, 2.5), c(0.5, 1, 1.5,2),c(0,0.5, 1,1.5,2, 2.5,3.5)),
  theme = tm
)
p
pp <- add_border(p, part = "header", where = "bottom")
pp = add_border(pp,part = 'header',col =2:10 ,where = 'top',gp = gpar(lwd = 1, lty = 2))
pp = add_border(pp,row = c(1,8,13,15),where = 'bottom',gp = gpar(lwd = 1, lty = 1))
pp = add_border(pp,row = c(4,5),where = 'bottom',gp = gpar(lwd = 1, lty = 2))

pp <- insert_text(pp,
                  text = c('Transcription level','Methylation level','Protein level'),
                  col = c(3,6,9),
                  part = "header",
                  gp = gpar(fontsize = 14,fontface = 'bold'))
pp

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值