1. Kaplan-Meier生存分析
Kaplan Meier是一种单因素生存分析,它可用于研究1个因素对于生存时间的影响。
参考:生存分析之Kaplan-Meier曲线都告诉我们什么
一般来说,我们做生存分析,会有(P<0.05)和(P>0.05)两种结果。KM plot在生物医学中很常见,主要用来做预后分析,比如可以根据表达量把病人分成两组,然后比较哪组病人预后好,进而可以得出基因表达量高低与病人预后好坏相关性的结论。(但凡是能把病人分成两个组的,都可以拿来做生存分析
,根据基因表达量,人种,性别,stage等等来分,都是可以的。)
画KM plot时,有时候会比较纠结怎样对病人进行分组,如何来设置分组的cutoff。一般来说常见的几种设置cutoff值得思路如下:
1:大多数情况下,根据表达量从低到高对样本进行排序,取前50%为低表达,后50%为高表达,然后画KM plot。
2:还有一些文章也会将样本表达量均分为三组或者四组。
3:一些文章也会选一些其它的cutoff,比如前1/3和后2/3,前25%和后25%(中间50%的数据去掉)。
参考:https://zhuanlan.zhihu.com/p/86307194#:~:text=KM%20plot
2. 结果解读
左图:KM-plot的横坐标是生存时间(可以是OS,也可以是PFS等),纵坐标是生存率。起点是随访开始的时间,曲线下降代表患者死亡,曲线上的+号表示删失(仍然存活的病人的最后随访时间)。p值是log-rank test的p值,衡量的绘制的曲线之间生存率有没有显著差别。
右上:左图的美化版,曲线的阴影表示置信区间。
右中:每个时间节点有多少人在随访中
右下:删失表格,右上图中每出现一个+,也就是删失,右下对应的位置就会有一个条图。纵轴是在该时间点删失的数目。
3. 数据整理⚠️
生存分析需要的输入数据有两个:表达矩阵数据和临床信息数据
生存分析只需要tumor数据,不要normal,将其去掉,新表达矩阵数据命名为exprSet;
clinical信息需要进一步整理,成为生存分析需要的格式,新临床信息数据命名为meta。
由于不同癌症的临床信息表格组织形式不同,这里的代码需要根据实际情况修改。
rm(list=ls())
options(stringsAsFactors = F)
load("TCGA-CHOL_gdc.Rdata")
load("TCGA-CHOL_symbol_exp.Rdata")
library(stringr)
3.1 整理表达矩阵与临床信息
- 整理表达矩阵
exprSet=exp[,Group=='tumor'] #只留下肿瘤样本
#前面的过滤标准比较宽松,这里可以再次过滤
k = apply(exprSet,1, function(x){sum(x==0)<=0.25*ncol(exprSet)});table(k)
# k
# FALSE TRUE
# 4631 25521
exprSet = log2(edgeR::cpm(exprSet[k,])+1) #标准化
dim(exprSet) #25521个基因,36个样本
# [1] 25521 36
- 整理临床信息
tmp = data.frame(colnames(clinical)) # 方便搜索列名
meta = clinical[,c(
'bcr_patient_barcode',
'vital_status',
'days_to_death',
'days_to_last_followup',
'race_list',
'days_to_birth',
'gender' ,
'stage_event'
)] # 挑出其中有用的列,重新生成数据框
dim(meta)
# [1] 48 8
head(meta)
# bcr_patient_barcode vital_status days_to_death days_to_last_followup race_list days_to_birth gender stage_event
# 1 TCGA-W5-AA2Q Alive 50 WHITE -25069 MALE 6thStage IIT2bN0M0
# 2 TCGA-W5-AA2O Dead 640 WHITE -21118 MALE 6thStage IT1N0M0
# 3 TCGA-W5-AA39 Dead 170 WHITE -29594 MALE 7thStage IIT2N0M0
# 4 TCGA-W6-AA0S Alive 352 WHITE -16951 FEMALE 7thStage IT1N0MX
# 5 TCGA-3X-AAVE Alive 203 ASIAN -21943 MALE 7thStage IIT2N0M0
# 6 TCGA-W5-AA2I Dead 1939 WHITE -24388 MALE 6thStage IT1N0M0
#其实days_to_last_followup应该是找age_at_initial_pathologic_diagnosis,这表格里没有,用days_to_birth计算一下年龄,暂且替代。
rownames(meta) <- meta$bcr_patient_barcode
meta[1:4,1:4]
#> bcr_patient_barcode vital_status days_to_death
#> TCGA-W5-AA2Q TCGA-W5-AA2Q Alive
#> TCGA-W5-AA2O TCGA-W5-AA2O Dead 640
#> TCGA-W5-AA39 TCGA-W5-AA39 Dead 170
#> TCGA-W6-AA0S TCGA-W6-AA0S Alive
#> days_to_last_followup
#> TCGA-W5-AA2Q 50
#> TCGA-W5-AA2O
#> TCGA-W5-AA39
#> TCGA-W6-AA0S 352
#简化meta的列名
colnames(meta)=c('ID','event','death','last_followup','race','age','gender','stage')
#空着的值改为NA
meta[meta==""]=NA
3.2 实现表达矩阵与临床信息的匹配
有的病人会有两个或两个以上的肿瘤样本,就有重复。两种可行的办法:
(1)以病人为中心,对表达矩阵的列按照病人ID去重复,每个病人只保留一个样本。(本文档)
(2)以样本为中心,把meta里的病人ID替换成样本ID,这样同一个病人的两个样本就会有两行完全一致的临床信息。(zz.R)
# 以病人为中心,表达矩阵按病人ID去重复
k = !duplicated(str_sub(colnames(exprSet),1,12));table(k)
# k
# TRUE
# 36
exprSet = exprSet[,k]
#调整meta的ID顺序与exprSet列名一致
meta=meta[match(str_sub(colnames(exprSet),1,12),meta$ID),]
identical(meta$ID,str_sub(colnames(exprSet),1,12))
# [1] TRUE
3.3 整理生存分析的输入数据
#1.1由随访时间和死亡时间计算生存时间(月)
table(meta$event)
#
# Alive Dead
# 20 16
meta$time = ifelse(meta$event=="Alive", meta$last_followup, meta$death)
meta$time = as.numeric(meta$time)/30
#1.2 根据生死定义event,活着是0,死的是1
meta$event=ifelse(meta$event=='Alive', 0, 1)
table(meta$event)
#
# 0 1
# 20 16
#1.3 年龄和年龄分组
meta$age=ceiling(abs(as.numeric(meta$age))/365)
meta$age_group=ifelse(meta$age>median(meta$age,na.rm = T),'older','younger')
table(meta$age_group)
#
# older younger
# 18 18
#1.4 stage
library(stringr)
head(meta$stage)
# [1] "6thStage IVT3N0M1" "7thStage IIIT3N0M0" "7thStage IIT2bNXMX"
# [4] "7thStage IT1N0M0" "7thStage IIT2N0M0" "7thStage IT1N0M0"
a = str_extract_all(meta$stage,"I|V");head(a) #提取分期信息
b = sapply(a,paste,collapse = "");head(b)
#> [1] "IV" "III" "II" "I" "II" "I"
meta$stage = b
# 去掉生存信息不全或者生存时间小于0.1(月)的病人,样本纳排标准不唯一,且差别很大
k1 = meta$time>=0.1;table(k1)
# k1
# FALSE TRUE
# 1 35
k2 = !(is.na(meta$time)|is.na(meta$event));table(k2)
# k2
# TRUE
# 36
exprSet = exprSet[,k1&k2]
meta = meta[k1&k2,]
save(meta,exprSet,proj,file = paste0(proj,"_sur_model.Rdata"))
4. 绘制生存曲线
# 格式:
sfit <- survfit(Surv(time,event)~group,data= meta)
# time指总生存期
# event是终点事件
# group是分组,是临床信息中的一列
# data是临床信息表格
rm(list = ls())
load("TCGA-CHOL_sur_model.Rdata")
library(survival)
library(survminer)
#年龄
sfit <- survfit(Surv(time, event)~age_group, data=meta)
ggsurvplot(sfit, conf.int=F, pval=TRUE)
ggsurvplot(sfit,palette = c("#E7B800", "#2E9FDF"),
risk.table =TRUE,pval =TRUE,
conf.int =TRUE,xlab ="Time in months",
ggtheme =theme_light(),
ncensor.plot = TRUE)
#性别年龄
sfit1=survfit(Surv(time, event)~gender, data=meta)
sfit2=survfit(Surv(time, event)~age_group, data=meta)
splots <- list()
splots[[1]] <- ggsurvplot(sfit1,pval =TRUE, data = meta, risk.table = TRUE)
splots[[2]] <- ggsurvplot(sfit2,pval =TRUE, data = meta, risk.table = TRUE)
arrange_ggsurvplots(splots, print = TRUE, ncol = 2, nrow = 1, risk.table.height = 0.4)
dev.off()
#> null device
#> 1
#单个基因
g = rownames(exprSet)[1]
meta$gene = ifelse(exprSet[g,]> median(exprSet[g,]),'high','low')
sfit1=survfit(Surv(time, event)~gene, data=meta)
ggsurvplot(sfit1,pval =TRUE, data = meta, risk.table = TRUE)
#多个基因
gs=rownames(exprSet)[1:4]
splots <- lapply(gs, function(g){
meta$gene=ifelse(exprSet[g,] > median(exprSet[g,]),'high','low')
sfit1=survfit(Surv(time, event)~gene, data=meta)
ggsurvplot(sfit1,pval =TRUE, data = meta, risk.table = TRUE)
})
arrange_ggsurvplots(splots, print = TRUE,
ncol = 2, nrow = 2, risk.table.height = 0.4)
5. 批量生存分析
参考:https://www.sohu.com/a/280105039_743978
5.1 logrank批量生存分析
logrankfile = paste0(proj,"_log_rank_p.Rdata")
if(!file.exists(logrankfile)){
log_rank_p <- apply(exprSet , 1 , function(gene){
# gene=exprSet[1,]
meta$group=ifelse(gene>median(gene),'high','low')
data.survdiff=survdiff(Surv(time, event)~group,data=meta)
p.val = 1 - pchisq(data.survdiff$chisq, length(data.survdiff$n) - 1)
return(p.val)
})
log_rank_p=sort(log_rank_p)
save(log_rank_p,file = logrankfile)
}
load(logrankfile)
table(log_rank_p<0.01)
#>
#> FALSE TRUE
#> 25430 91
table(log_rank_p<0.05)
#>
#> FALSE TRUE
#> 24859 662
# 挑一个p值小的基因来做KM_plot
g = names(log_rank_p)[1]
meta$gene = ifelse(exprSet[g,]> median(exprSet[g,]),'high','low')
sfit1=survfit(Surv(time, event)~gene, data=meta)
ggsurvplot(sfit1,pval =TRUE, data = meta, risk.table = TRUE)
5.2 cox批量生存分析
Cox 回归本质上是一种回归模型 ,它没有直接使用生存时间,而是使用了风险比( hazard ratio )作为因变量,该模型不用于估计生存率,而是用于因素分析也就是 找到某一个危险因素对结局事件发生的贡献度。
Cox 回归的重要统计指标: 风险比( hazard ratio)
• 当 HR>1 时,说明研究对象是一个危险因素。
• 当 HR<1 时,说明研究对象是一个保护因素。
• 当 HR=1 时,说明研究对象对生存时间不起作用。
coxfile = paste0(proj,"_cox.Rdata")
if(!file.exists(coxfile)){
cox_results <-apply(exprSet , 1 , function(gene){
#gene= exprSet[1,]
meta$gene = gene
#可直接使用连续型变量
m = coxph(Surv(time, event) ~ gene, data = meta)
#也可使用二分类变量
#meta$group=ifelse(gene>median(gene),'high','low')
#m=coxph(Surv(time, event) ~ group, data = meta)
beta <- coef(m)
se <- sqrt(diag(vcov(m)))
HR <- exp(beta)
HRse <- HR * se
#summary(m)
tmp <- round(cbind(coef = beta,
se = se, z = beta/se,
p = 1 - pchisq((beta/se)^2, 1),
HR = HR, HRse = HRse,
HRz = (HR - 1) / HRse,
HRp = 1 - pchisq(((HR - 1)/HRse)^2, 1),
HRCILL = exp(beta - qnorm(.975, 0, 1) * se),
HRCIUL = exp(beta + qnorm(.975, 0, 1) * se)), 3)
return(tmp['gene',])
#return(tmp['grouplow',])#二分类变量
})
cox_results=as.data.frame(t(cox_results))
save(cox_results,file = coxfile)
}
load(coxfile)
table(cox_results$p<0.01)
#>
#> FALSE TRUE
#> 25439 82
table(cox_results$p<0.05)
#>
#> FALSE TRUE
#> 24979 542
lr = names(log_rank_p)[log_rank_p<0.05];length(lr)
#> [1] 662
cox = rownames(cox_results)[cox_results$p<0.05];length(cox)
#> [1] 542
length(intersect(lr,cox))
#> [1] 132
代码来自2021生信技能树数据挖掘课