生存模型的構建方法包括:
1. Lasso回歸;
2. Cox多因素回歸;
3. 隨機森林;
4. 支持向量機
可以把log_rank_test或cox篩選出的基因單獨做模型構建,也可以取交集之后再做模型構建。
1. Lasso回歸(機器學習算法)
目的:從若干個基因中挑選真正對生存有影響的基因。
Lasso回歸可以對這些基因進行統計和打分,從而挑出關鍵基因。
1.1 準備輸入數據(表達矩陣數據和臨床信息數據)
load("TCGA-KIRC_sur_model.Rdata")
ls()
exprSet[1:4,1:4]
meta[1:4,1:4]
1.2 構建lasso回歸模型
輸入數據是表達矩陣(僅含tumor樣本)和每個病人對應的生死(順序必須一致)。
x=t(exprSet) #轉換成基因在列
y=meta$event #結局
library(glmnet)
- 1.2.1 挑選合適的λ值
Lambda 是構建模型的重要參數。他的大小關系著模型選擇的基因個數
#調優參數
set.seed(1006)
#??不設置的話,每次運行時后面的結果(選出的基因)會不斷變化。這也就是說,如果文獻中使用了Lasso回歸,是沒有辦法復現結果的。
cv_fit <- cv.glmnet(x=x, y=y) #cv.glmnet()就是一個調優參數的過程
plot(cv_fit)
圖的橫軸是選擇的λ值,圖最上方的數字代表選擇對應的λ值時,模型所使用的基因數。
兩條虛線分別指示了兩個特殊的λ值,一個是lambda.min,一個是lambda.1se,這兩個值之間的lambda都認為是可用的。lambda.1se構建的模型最簡單,即使用的基因數量少,而lambda.min則準確率更高一點,使用的基因數量更多一點。
#系數圖
fit <- glmnet(x=x, y=y) #glmnet是構建模型的
plot(fit,xvar = "lambda")
這張圖中的每一條線代表一個基因。橫坐標和上面那張圖一樣是log Lambda,縱坐標是系數。從左往右看,系數一直在0附近的,不管λ是幾都不會被選到。
這兩張圖就是Lasso回歸最經典的兩張圖。
- 1.2.2 用這兩個λ值重新建模
兩個都構建一下,再比較哪個模型更好。實際操作也可直接選擇lambda.min到lambda.1se中的任意一個λ值構建模型,λ值的選擇不是固定的。
model_lasso_min <- glmnet(x=x, y=y,lambda=cv_fit$lambda.min) # 得到的模型是一個列表
model_lasso_1se <- glmnet(x=x, y=y,lambda=cv_fit$lambda.1se) # 得到的模型是一個列表
View(model_lasso_1se) #從中選一個查看一下格式
選中的基因與系數存放于模型的子集beta中,beta是一個稀疏矩陣,用到的基因有一個s0值(系數值),沒用的基因只記錄了“.”(系數是0),所以可以用下面代碼挑出用到的基因。
head(model_lasso_min$beta,20)
choose_gene_min=rownames(model_lasso_min$beta)[as.numeric(model_lasso_min$beta)!=0] #as.numeric不等于0的基因就是有系數的也就是被選中了的基因。
choose_gene_1se=rownames(model_lasso_1se$beta)[as.numeric(model_lasso_1se$beta)!=0]
length(choose_gene_min)
# [1] 35 ##選到了35個基因
length(choose_gene_1se)
# [1] 11 ##選到了11個基因
save(choose_gene_min,file = "lasso_choose_gene_min.Rdata")
-
1.2.3 模型預測
使用predict函數
進行模型預測(提供模型和數據就可以得到預測結果)
newx參數是預測對象。輸出結果lasso.prob是一個矩陣,第一列是min的預測結果,第二列是1se的預測結果,預測結果是概率,或者說百分比,不是絕對的0和1。
將每個樣本的生死和預測結果放在一起,直接cbind即可。
lasso.prob <- predict(cv_fit, newx=x, s=c(cv_fit$lambda.min,cv_fit$lambda.1se) )
re=cbind(y ,lasso.prob)
head(re)
# y 1 2
# TCGA-A3-3307-01A-01T-0860-13 0 0.1151638 0.2300976
# TCGA-A3-3308-01A-02R-1324-13 0 0.4020126 0.3591050
# TCGA-A3-3311-01A-02R-1324-13 1 0.2906333 0.2954458
# TCGA-A3-3313-01A-02R-1324-13 1 0.3831590 0.3456060
# TCGA-A3-3316-01A-01T-0860-13 0 0.3284941 0.3113726
# TCGA-A3-3317-01A-01T-0860-13 0 0.3832764 0.3342198
## y是每個病人,1和2是給的lamda值是min和1se的時候,模型給每個病人計算出來的預測值評分是多少
re=as.data.frame(re)
colnames(re)=c('event','prob_min','prob_1se')
#將真實結局event和預測值合并在一起
re$event=as.factor(re$event)
- 1.2.4 模型評估(繪制ROC曲線)
計算AUC取值范圍在0.5-1之間,越接近于1越好。可以根據預測結果繪制ROC曲線。
library(ROCR)
library(caret)
#min
pred_min <- prediction(re[,2], re[,1])
auc_min = performance(pred_min,"auc")@y.values[[1]]
perf_min <- performance(pred_min,"tpr","fpr")
plot(perf_min,colorize=FALSE, col="blue")
lines(c(0,1),c(0,1),col = "gray", lty = 4 )
text(0.8,0.2, labels = paste0("AUC = ",round(auc_min,3)))
#1se
pred_1se <- prediction(re[,3], re[,1])
auc_1se = performance(pred_1se,"auc")@y.values[[1]]
perf_1se <- performance(pred_1se,"tpr","fpr")
plot(perf_1se,colorize=FALSE, col="red")
lines(c(0,1),c(0,1),col = "gray", lty = 4 )
text(0.8,0.2, labels = paste0("AUC = ",round(auc_1se,3)))
把兩個模型的圖畫一起
plot(perf_min,colorize=FALSE, col="blue")
plot(perf_1se,colorize=FALSE, col="red",add = T)
lines(c(0,1),c(0,1),col = "gray", lty = 4 )
text(0.8,0.3, labels = paste0("AUC = ",round(auc_min,3)),col = "blue")
text(0.8,0.2, labels = paste0("AUC = ",round(auc_1se,3)),col = "red")
ggplot繪圖(和上面的圖含義一樣,ggplot2畫的圖更好看,繪圖也更靈活)
tpr_min = performance(pred_min,"tpr")@y.values[[1]]
tpr_1se = performance(pred_1se,"tpr")@y.values[[1]]
dat = data.frame(tpr_min = perf_min@y.values[[1]],
fpr_min = perf_min@x.values[[1]],
tpr_1se = perf_1se@y.values[[1]],
fpr_1se = perf_1se@x.values[[1]])
library(ggplot2)
ggplot() +
geom_line(data = dat,aes(x = fpr_min, y = tpr_min),color = "blue") +
geom_line(aes(x=c(0,1),y=c(0,1)),color = "grey")+
theme_bw()+
annotate("text",x = .75, y = .25,
label = paste("AUC of min = ",round(auc_min,2)),color = "blue")+
scale_x_continuous(name = "fpr")+
scale_y_continuous(name = "tpr")
ggplot() +
geom_line(data = dat,aes(x = fpr_min, y = tpr_min),color = "blue") +
geom_line(data = dat,aes(x = fpr_1se, y = tpr_1se),color = "red")+
geom_line(aes(x=c(0,1),y=c(0,1)),color = "grey")+
theme_bw()+
annotate("text",x = .75, y = .25,
label = paste("AUC of min = ",round(auc_min,2)),color = "blue")+
annotate("text",x = .75, y = .15,label = paste("AUC of 1se = ",round(auc_1se,2)),color = "red")+
scale_x_continuous(name = "fpr")+
scale_y_continuous(name = "tpr")
- 1.2.5 切割數據構建模型并預測
對數據進行切割,一組做訓練集
,使用表達矩陣和臨床信息用來構建模型。一組做測試集
,輸入表達矩陣來對結局進行預測,測序構建的模型預測的結果。
用R包caret切割數據,生成的結果是一組代表列數的數字,用這些數字來給表達矩陣和meta取子集即可。
library(caret) #機器學習R包,可以比較科學的拆分數據。
set.seed(12345679)
sam<- createDataPartition(meta$event, p = .5,list = FALSE) #根據event來切分,一半一半和7比3都可以
head(sam)
train <- exprSet[,sam] #切分表達矩陣,sam是一組,非sam是另一組。
test <- exprSet[,-sam]
train_meta <- meta[sam,] #切分臨床信息
test_meta <- meta[-sam,]
#看一下,不要讓臨床信息差的太多
prop.table(table(train_meta$stage))
prop.table(table(test_meta$stage))
prop.table(table(test_meta$race))
prop.table(table(train_meta$race))
切割后的train數據集建模
#計算lambda
x = t(train)
y = train_meta$event
cv_fit <- cv.glmnet(x=x, y=y)
plot(cv_fit)
#構建模型
model_lasso_min <- glmnet(x=x, y=y,lambda=cv_fit$lambda.min)
model_lasso_1se <- glmnet(x=x, y=y,lambda=cv_fit$lambda.1se)
#挑出基因
head(model_lasso_min$beta)
choose_gene_min=rownames(model_lasso_min$beta)[as.numeric(model_lasso_min$beta)!=0]
choose_gene_1se=rownames(model_lasso_1se$beta)[as.numeric(model_lasso_1se$beta)!=0]
length(choose_gene_min)
# [1] 18
length(choose_gene_1se)
# [1] 3
模型預測
用訓練集構建模型,預測測試集的生死,注意newx參數變了。
lasso.prob <- predict(cv_fit, newx=t(test), s=c(cv_fit$lambda.min,cv_fit$lambda.1se) )
re=cbind(event = test_meta$event ,lasso.prob)
re=as.data.frame(re)
colnames(re)=c('event','prob_min','prob_1se')
re$event=as.factor(re$event)
head(re)
再畫ROC曲線
library(ROCR)
library(caret)
# 訓練集模型預測測試集
#min
pred_min <- prediction(re[,2], re[,1])
auc_min = performance(pred_min,"auc")@y.values[[1]]
perf_min <- performance(pred_min,"tpr","fpr")
#1se
pred_1se <- prediction(re[,3], re[,1])
auc_1se = performance(pred_1se,"auc")@y.values[[1]]
perf_1se <- performance(pred_1se,"tpr","fpr")
tpr_min = performance(pred_min,"tpr")@y.values[[1]]
tpr_1se = performance(pred_1se,"tpr")@y.values[[1]]
dat = data.frame(tpr_min = perf_min@y.values[[1]],
fpr_min = perf_min@x.values[[1]],
tpr_1se = perf_1se@y.values[[1]],
fpr_1se = perf_1se@x.values[[1]])
ggplot() +
geom_line(data = dat,aes(x = fpr_min, y = tpr_min),color = "blue") +
geom_line(data = dat,aes(x = fpr_1se, y = tpr_1se),color = "red")+
geom_line(aes(x=c(0,1),y=c(0,1)),color = "grey")+
theme_bw()+
annotate("text",x = .75, y = .25,
label = paste("AUC of min = ",round(auc_min,2)),color = "blue")+
annotate("text",x = .75, y = .15,label = paste("AUC of 1se = ",round(auc_1se,2)),color = "red")+
scale_x_continuous(name = "fpr")+
scale_y_continuous(name = "tpr")
2. Cox多因素回歸
如果Lasso回歸挑出的基因數目還是太多,就可以通過Cox多因素回歸再進行篩選。
使用Lasso回歸挑出的基因作為Cox多因素回歸的輸入數據,使用逐步回歸法
去挑選可選范圍內最好的模型。(通常來說做數據挖掘的文章構建模型的話最后一步都是多因素Cox)
2.1 準備輸入數據
if(!require(My.stepwise))install.packages("My.stepwise")
load("TCGA-KIRC_sur_model.Rdata") #KIRC整理好的生存數據
load("lasso_choose_gene_min.Rdata") #Lasso回歸選出的35個基因(這里沒有區分lnc和mRNA)
2.2 構建coxph模型
將用于建模的基因(例如lasso回歸選中的基因)從表達矩陣中取出來,可作為列添加在meta表格的后面,組成的數據框賦值給dat。
library(stringr)
e=t(exprSet[choose_gene_min,]) #從矩陣中取出Lasso回歸選出的35個基因
colnames(e)= str_replace_all(colnames(e),"-","_") #因為miRNA的名字中有減號-,而cox的公式中有加號,會造成干擾,因此需要將基因名中的-替換成_。
dat=cbind(meta,e)
dat$gender=as.numeric(factor(dat$gender)) #把levels轉換成數字作為輸入
dat$stage=as.numeric(factor(dat$stage))
colnames(dat) #dat矩陣行是樣本,列是感興趣的臨床信息和挑出的35個基因
# [1] "ID" "event" "death" "last_followup" "race"
# [6] "age" "gender" "stage" "time" "age_group"
# [11] "hsa_mir_101_1" "hsa_mir_1179" "hsa_mir_1185_1" "hsa_mir_1248" "hsa_mir_1269"
# [16] "hsa_mir_1277" "hsa_mir_1305" "hsa_mir_130a" "hsa_mir_130b" "hsa_mir_144"
# [21] "hsa_mir_149" "hsa_mir_181b_2" "hsa_mir_181c" "hsa_mir_18a" "hsa_mir_223"
# [26] "hsa_mir_2276" "hsa_mir_27b" "hsa_mir_28" "hsa_mir_3149" "hsa_mir_34c"
# [31] "hsa_mir_3613" "hsa_mir_3614" "hsa_mir_365_2" "hsa_mir_3651" "hsa_mir_3667"
# [36] "hsa_mir_3676" "hsa_mir_376b" "hsa_mir_3917" "hsa_mir_548q" "hsa_mir_612"
# [41] "hsa_mir_627" "hsa_mir_676" "hsa_mir_9_2" "hsa_mir_939" "hsa_mir_95"
逐步回歸法構建最優模型(從若干個因素中挑選出更關鍵的)
library(survival)
library(survminer)
library(My.stepwise)
vl <- colnames(dat)[c(6,7,8,11:ncol(dat))] #選擇感興趣的輸入因素,這里選了列名中從age開始到最后一列的35個因素作為輸入
My.stepwise.coxph(Time = "time",
Status = "event",
variable.list = vl, #從這些因素中挑選更關鍵的因素,輸出結果中最后一個模型是最好的
data = dat)
使用輸出結果里的最后一個模型(逐步回歸法經過若干次迭代后選出的最好的模型)
# 復制輸出結果中的最后一個公式
model = coxph(formula = Surv(time, event) ~ stage + hsa_mir_223 + age +
hsa_mir_34c + hsa_mir_3917 + hsa_mir_3651 + hsa_mir_144 +
hsa_mir_2276 + hsa_mir_3667 + hsa_mir_3149 + hsa_mir_627 +
hsa_mir_101_1, data = dat)
逐步回歸法最重要的是選出了~后面的這些因素,作為它認為的最優因素組合來構建模型,~后的因素也可以通過其它方式挑選,公式還是一樣的寫法。
2.3 模型可視化-森林圖
ggforest(model,data = dat)
森林圖繪圖更多參考:http://www.lxweimin.com/p/58c90b2f3910
2.4 模型預測
fp <- predict(model,newdata = dat)
library(Hmisc) #使用Hmisc包中的函數計算C Index
options(scipen=200)
with(dat,rcorr.cens(fp,Surv(time, event))) #用1-返回的C Index值是我們所說的C Index,也就是上面森林圖中標出的0.81
# C Index Dxy S.D. n missing uncensored
# 0.19234306 -0.61531388 0.03361968 516.00000000 0.00000000 158.00000000
# Relevant Pairs Concordant Uncertain
# 89174.00000000 17152.00000000 176550.00000000
C-index用于計算生存分析中的COX模型預測值與真實之間的區分度(discrimination),也稱為Harrell's concordanceindex。C-index在0.5-1之間。0.5為完全不一致,說明該模型沒有預測作用,1為完全一致,說明該模型預測結果與實際完全一致。
2.5 切割數據構建模型并預測
-
2.5.1 切割數據
用R包caret切割數據,生成的結果是一組代表列數的數字,用這些數字來給表達矩陣和meta取子集即可。
library(caret)
set.seed(12345679)
sam<- createDataPartition(meta$event, p = .5,list = FALSE)
train <- exprSet[,sam]
test <- exprSet[,-sam]
train_meta <- meta[sam,]
test_meta <- meta[-sam,]
-
2.5.2 切割后的train數據集建模
和上面的建模方法一樣。
e=t(train[choose_gene_min,])
colnames(e)= str_replace_all(colnames(e),"-","_")
dat=cbind(train_meta,e)
dat$gender=as.numeric(factor(dat$gender))
dat$stage=as.numeric(factor(dat$stage))
colnames(dat)
#install.packages("My.stepwise")
# library(My.stepwise)
# vl <- colnames(dat)[c(6,7,8,11:ncol(dat))]
# My.stepwise.coxph(Time = "time",
# Status = "event",
# variable.list = vl,
# data = dat)
model = coxph(formula = Surv(time, event) ~ stage + hsa_mir_223 + age +
hsa_mir_34c + hsa_mir_181b_2 + hsa_mir_3614, data = dat)
- 2.5.3 模型可視化
ggforest(model, data =dat)
- 2.5.4 用切割后的數據test數據集驗證模型
e=t(test[choose_gene_min,])
colnames(e)= str_replace_all(colnames(e),"-","_")
test_dat=cbind(test_meta,e)
test_dat$gender=as.numeric(factor(test_dat$gender))
test_dat$stage=as.numeric(factor(test_dat$stage))
fp <- predict(model,newdata = test_dat)
library(Hmisc)
with(test_dat,rcorr.cens(fp,Surv(time, event)))
# C Index Dxy S.D. n missing
# 0.22565299 -0.54869403 0.04919064 258.00000000 0.00000000
# uncensored Relevant Pairs Concordant Uncertain
# 75.00000000 21440.00000000 4838.00000000 44858.00000000
3 隨機森林
3.1 準備輸入數據
輸入數據是腫瘤樣本表達矩陣exprSet和臨床信息meta
load("TCGA-KIRC_sur_model.Rdata")
library(randomForest)
library(ROCR)
library(genefilter)
library(Hmisc)
3.2 構建隨機森林模型
輸入數據是表達矩陣(僅含tumor樣本)和對應的生死。(和Lasso回歸一樣)
x=t(exprSet)
y=meta$event
#構建模型,一個叫randomForest的函數,運行時間很長,存Rdata跳過
tmp_rf="TCGA_KIRC_miRNA_rf_output.Rdata"
if(!file.exists(tmp_rf)){
rf_output=randomForest(x=x, y=y,importance = TRUE, ntree = 10001, proximity=TRUE )
save(rf_output,file = tmp_rf)
}
load(file = tmp_rf)
#top30的基因
varImpPlot(rf_output, type=2, n.var=30, scale=FALSE,
main="Variable Importance (Gini) for top 30 predictors",cex =.7)
隨機森林算法篩選基因不像Lasso回歸那么絕對,不是直接分是用到了還是沒用到,隨機森林只能幫我們把基因的重要性進行排名 ,要選前多少個基因是我們自己定的。(這里選了前30,如上圖)
rf_importances=importance(rf_output, scale=FALSE)
head(rf_importances)
# %IncMSE IncNodePurity
# hsa-let-7a-1 1.852761e-04 0.1787383
# hsa-let-7a-2 2.167420e-04 0.1916623
# hsa-let-7a-3 2.218169e-04 0.1858544
# hsa-let-7b 7.399404e-05 0.1628646
# hsa-let-7c 7.658155e-05 0.1635053
# hsa-let-7d 1.974099e-04 0.2382185
#解釋量top30的基因,和圖上是一樣的,從下往上看。
choose_gene=rownames(tail(rf_importances[order(rf_importances[,2]),],30)) #選前30個基因,這個數值可變
3.3 模型預測和評估
rf.prob <- predict(rf_output, x) #rf.prob是預測值,越接近于0就表示模型預測這個人活著,越接近于1就表示模型預測這個人死了。
re=cbind(y ,rf.prob) #預測值和真實值放在一起查看比較
head(re)
# y rf.prob
# TCGA-A3-3307-01A-01T-0860-13 0 0.1364447
# TCGA-A3-3308-01A-02R-1324-13 0 0.1793771
# TCGA-A3-3311-01A-02R-1324-13 1 0.6709712
# TCGA-A3-3313-01A-02R-1324-13 1 0.7742376
# TCGA-A3-3316-01A-01T-0860-13 0 0.2035863
# TCGA-A3-3317-01A-01T-0860-13 0 0.1619938
ROC曲線(隨機森林如果不做另外一個數據的驗證,它的AUC值是1,所以繪制ROC曲線沒有什么意義)
library(ROCR)
#library(caret)
pred <- prediction(re[,2], re[,1])
auc = performance(pred,"auc")@y.values[[1]]
auc
# [1] 1
3.4 切割數據構建模型并預測
- 3.4.1 切割數據
用R包caret切割數據,生成的結果是一組代表列數的數字,用這些數字來給表達矩陣和meta取子集即可。
library(caret)
set.seed(12345679)
sam<- createDataPartition(meta$event, p = .5,list = FALSE)
train <- exprSet[,sam]
test <- exprSet[,-sam]
train_meta <- meta[sam,]
test_meta <- meta[-sam,]
- 3.4.2 切割后的train數據集建模
和上面的建模方法一樣。
#建模
x = t(train)
y = train_meta$event
tmp_rf="TCGA_KIRC_miRNA_t_rf_output.Rdata"
if(!file.exists(tmp_rf)){
rf_output=randomForest(x=x, y=y,importance = TRUE, ntree = 10001, proximity=TRUE )
save(rf_output,file = tmp_rf)
}
load(file = tmp_rf)
choose_gene=rownames(tail(rf_importances[order(rf_importances[,2]),],30))
head(choose_gene)
# [1] "hsa-mir-511-1" "hsa-mir-155" "hsa-mir-409" "hsa-mir-1185-1"
# [5] "hsa-mir-1277" "hsa-mir-149"
3.5 模型預測
用訓練集構建模型,預測測試集的生死。
x = t(test)
y = test_meta$event
rf.prob <- predict(rf_output, x)
re=cbind(y ,rf.prob)
re=as.data.frame(re)
colnames(re)=c('event','prob')
re$event=as.factor(re$event)
再看AUC值。
library(ROCR)
# 訓練集模型預測測試集
pred <- prediction(re[,2], re[,1])
auc= performance(pred,"auc")@y.values[[1]]
auc
# [1] 0.7121311
模型還可以。
4 支持向量機(Support Vector Machine, SVM)
前三種預測方法都是可以把建模時所 使用的基因挑出來,也可以寫出公式,SVM比前三種方法要簡單很多。
4.1 準備輸入數據
load("TCGA-KIRC_sur_model.Rdata")
library(ROCR)
library(genefilter)
library(Hmisc)
library(e1071) #SVM的包名
4.2 構建支持向量機模型
-
4.2.1 切割數據
用R包caret切割數據,生成的結果是一組代表列數的數字,用這些數字來給表達矩陣和meta取子集即可。
library(caret)
set.seed(12345679)
sam<- createDataPartition(meta$event, p = .5,list = FALSE)
train <- exprSet[,sam]
test <- exprSet[,-sam]
train_meta <- meta[sam,]
test_meta <- meta[-sam,]
- 4.2.2 train數據集建模
x=t(train)
y=as.factor(train_meta$event)
model = svm(x,y,kernel = "linear")
summary(model)
#
# Call:
# svm.default(x = x, y = y, kernel = "linear")
#
#
# Parameters:
# SVM-Type: C-classification
# SVM-Kernel: linear
# cost: 1
#
# Number of Support Vectors: 176
#
# ( 108 68 )
#
#
# Number of Classes: 2
#
# Levels:
# 0 1
-
4.2.3 模型預測
用訓練集構建模型,預測測試集的生死。不同于其他模型,這個預測結果是分類變量,直接預測生死,而不是prob。
x=t(test)
y=as.factor(test_meta$event)
pred = predict(model, x)
table(pred,y)
# y
# pred 0 1
# 0 142 47
# 1 41 28
上面的結果列的0和1是預測的存活和死亡,行的0和1是真實的存活和死亡。預測值是0的有142+41個,預測值是1的有47+28個。真實是0的有142+47個,真實是1的有41+28個。41(false negative)和47(false positive)就屬于誤判。
代碼來自2021生信技能樹數據挖掘課