測序上游分析系列：
mRNA-seq轉錄組二代測序從raw reads到表達矩陣：上中游分析pipeline
miRNA-seq小RNA高通量測序pipeline：從raw reads，鑒定已知miRNA-預測新miRNA，到表達矩陣【一】
miRNA-seq小RNA高通量測序pipeline：從raw reads，鑒定已知miRNA-預測新miRNA，到表達矩陣【二】
其他文章系列：ggplot2作圖篇：
（1）基于ggplot2的RNA-seq轉錄組可視化：總述和分文目錄
（2）測序結果概覽：基因表達量rank瀑布圖，高密度表達相關性散點圖，注釋特定基因及errorbar的表達相關性散點圖繪制
（3）單/多個基因在組間同時展示的多種選擇：分組小提琴圖、分組/分面柱狀圖、單基因蜂群點圖拼圖的繪制
（4）配對樣本基因表達趨勢：優化前后的散點連線圖+拼圖繪制
常見的TCGA數據挖掘辦法之一，是通過差異基因分析獲得差異表達基因，然后從中篩選出部分表達水平與患者生存相關聯的候選基因，對它們的表達水平進行多因素cox回歸構建風險模型，評估風險模型的預測能力（ROC曲線），并用Kaplan-Meier生存分析評估模型的風險評分是否有意義。
本例仍使用之前教程選擇的的TCGA-LUSC白色人種肺鱗癌表達譜數據。
TCGA數據下載整合操作見前文：從TCGA數據庫下載并整合清洗高通量腫瘤表達譜-臨床性狀數據
DESeq2差異分析見前文：TCGA數據整合后進行DESeq2差異表達分析和基于R的多種可視化
本文使用的數據為下載的HTSeq-counts數據，已經通過了整合和刪拾數據的清洗，并通過DESeq2完成了差異分析。本文用到的變量和對象為：
(1) dds_DE: the object generated by DESeq2. It contains the results of differential expression such as symbols of DE-genes and normalized counts.
(2) condition_table_cancer: the data frame containing the TCGA_IDs, overall_survival and vital status of cancer patients.
需要的R包：DESeq2包（轉錄組差異分析），survival包（cox回歸），survminer包（Kaplan-Meier Plot可視化），dplyr包（字符串處理），glmnet包（Lasso回歸），ggplot2包（數據可視化），GGally包（繪制相關性矩陣圖），rms包（計算VIF方差膨脹因子），survivalROC包（繪制time dependent ROC曲線），plotROC包（繪制ROC曲線）。
install.packages(c('DESeq2', 'survival', 'survminer', 'dplyr', 'glmnet', 'ggplot2', 'GGally', 'rms', 'survivalROC', 'plotROC'))
library('DESeq2')
library('survival')
library('survminer')
library('dplyr')
library('glmnet')
library('ggplot2')
library('GGally')
library('rms')
library('survivalROC')
library('plotROC')
1. 獲取差異表達基因，以及差異基因的標準化counts矩陣。
我們假設現在DESeq2已經做好差異分析，獲得了dds_DE object！
使用results函數獲取cancer組相對normal組差異表達p值<0.05的基因和相關信息。隨后選取符合|log2FoldChange|差異大于2（|FoldChange|大于4）和FDR<0.01的差異基因子集。resSigAll對象的rownames記錄了差異基因名信息。
隨后獲取基因的normalized counts matrix并做vst轉換，僅提取差異基因的normalized counts進行后續分析。
res_DE <- results(dds_DE, alpha=0.05,contrast=c("sample_type","cancer","normal"))
resOrdered <- res_DE[order(res_DE$padj),]
resSig <- subset(resOrdered,padj < 0.01)
resSigAll <- subset(resSig, (log2FoldChange < (-2)|log2FoldChange > 2))
rld <- vst(dds_DE, blind = T)
expr_norm <- assay(rld)
DESeq_norm_vst_for_survival <- expr_norm[resSigAll@rownames,]
2. 構建回歸分析所需的信息表。
采用Survival R包對下載數據進行回歸分析，需要構建一個至少包含樣本生存時間、刪失狀態的data frame。本例中，在數據整合建立condition_table時已經獲得了一個cancer patients的子集condition_table_cancer，直接使用它建立信息表，并合并潛在預后預測因子：候選基因的normalized counts（t()轉換至行為樣本，列為基因）。
注：survival包認定0為censored（無事件發生/刪失），1為diseased（有結局事件發生）。所以在本例中'Alive'轉換為0，'Dead'轉換為1。
此外有基因名中帶有R不被認可的dash '-'，所以將data frame中colnames的 '-' 轉換為下劃線 '_'。
library('dplyr')
survival_cancer <- condition_table_cancer
#Alive=0, Dead=1
survival_cancer$censoring_status <- gsub(survival_cancer$censoring_status, pattern = 'Alive', replacement = '0') %>%
gsub(pattern = 'Dead', replacement = '1') %>% as.numeric()
rownames(survival_cancer) <- survival_cancer$TCGA_IDs
survival_cancer <- cbind(survival_cancer, t(DESeq_norm_vst_for_survival)[survival_cancer$TCGA_IDs,])
#formula function in the next step will not recognize gene names like 'NKX1-2'. We have to change '-' to '_'.
colnames(survival_cancer) <- gsub(colnames(survival_cancer), pattern = '-', replacement = '_')
3. 對差異基因進行批量單因素COX回歸。
很多研究使用了先批量單因素COX回歸選出更少的候選基因，隨后進行多因素COX回歸建模的策略。雖然這個策略由于忽略了變量間的相互關系而非常有爭議，但是這里暫且不論策略對錯，我們先用代碼嘗試實現批量單因素COX回歸。
單因素COX回歸建模依賴于survival包coxph()函數，PH檢驗依賴于cox.zph()函數。這里的思路是自建一個函數，然后輸入需批量操作的基因名vector，和已經加入這些基因normalized counts的survival_cancer信息表。通過R特有的向量化操作lappy同時進行批量計算各基因的風險比，并檢驗變量是否符合cox等比例風險模型的前提PH假設，得到符合z值p值<0.05和符合PH假定（cox.zph檢驗p值>0.05）的基因。最終輸出含有gene名，單因素cox的β值，危險比HR，z值的p值，Wald檢驗和似然比檢驗p值的data frame。
注：gene名需要時刻注意，將'-'轉換為'_'才能與survival_cancer匹配。函數中已鑲嵌這個轉換。
#filter potential useful sig genes using univariate cox regression.
uni_cox_in_bulk <- function(gene_list, survival_info_df){
library('survival')
gene_list <- gsub(gene_list, pattern = '-', replacement = '_')
uni_cox <- function(single_gene){
formula <- as.formula(paste0('Surv(overall_survival, censoring_status)~', single_gene))
surv_uni_cox <- summary(coxph(formula, data = survival_cancer))
ph_hypothesis_p <- cox.zph(coxph(formula, data = survival_cancer))$table[1,3]
if (surv_uni_cox$coefficients[,5]<0.05 & ph_hypothesis_p>0.05){ #get the pvalue
single_cox_report <- data.frame('uni_cox_sig_genes'=single_gene,
'beta'=surv_uni_cox$coefficients[,1],
'Hazard_Ratio'=exp(surv_uni_cox$coefficients[,1]),
'z_pvalue'=surv_uni_cox$coefficients[,5],
'Wald_pvalue'=as.numeric(surv_uni_cox$waldtest[3]),
'Likelihood_pvalue'=as.numeric(surv_uni_cox$logtest[3]))
single_cox_report
}
}
uni_cox_list <- lapply(gene_list, uni_cox)
do.call(rbind, uni_cox_list)
}
uni_cox_df <- uni_cox_in_bulk(gene_list = resSigAll@rownames, survival_info_df = survival_cancer)
最終得到279個有意義的基因。輸出的data frame如圖：
Optional:
以上的代碼嵌套了兩次自定義函數，雖然不是最優化的做法，但較好地利用了R的向量化特性。如下代碼的目的是等價的，也是批量單因素cox回歸，但放棄了向量化，在R中使用了for循環，運行速度明顯慢于上方代碼。
uni_cox_sig_genes <- c()
beta_co <- c()
HR <- c()
z_p <- c()
Wald_p <- c()
Likelihood_p <- c()
for (candidate_gene in gsub(resSigAll@rownames, pattern = '-', replacement = '_')){
formula <- as.formula(paste0('Surv(overall_survival, censoring_status)~', candidate_gene))
surv_uni_cox <- summary(coxph(formula, data = survival_cancer))
ph_hypothesis_p <- cox.zph(coxph(formula, data = survival_cancer))$table[1,3]
if (surv_uni_cox$coefficients[,5]<0.05 & ph_hypothesis_p>0.05){ #get the pvalue
uni_cox_sig_genes <- append(uni_cox_sig_genes, candidate_gene)
beta_co <- append(beta_co, surv_uni_cox$coefficients[,1])
HR <- append(HR, exp(surv_uni_cox$coefficients[,1]))
z_p <- append(z_p, surv_uni_cox$coefficients[,5])
Wald_p <- append(Wald_p, as.numeric(surv_uni_cox$waldtest[3]))
Likelihood_p <- append(Likelihood_p, as.numeric(surv_uni_cox$logtest[3]))
}
}
uni_cox_df <- data.frame('uni_cox_sig_genes'=uni_cox_sig_genes, 'beta'=beta_co, 'Hazard_Ratio'=HR, 'z_pvalue'=z_p, 'Wald_pvalue'=Wald_p, 'Likelihood_pvalue'=Likelihood_p)
4. Lasso回歸篩選具有代表性的變量。
單因素回歸篩選出的變量仍舊較多，我們嘗試用Lasso回歸獲得較少有意義的變量。Lasso回歸的前提是變量數（這里是差異基因，n=2726）>樣本數（這里是cancer patients數，n=344），回歸的目的是使deviance最小化，結果是將不重要變量的系數壓縮為0，僅保留較少的重要變量系數不為0。
Lasso回歸依賴glmnet包。我個人下載這個包的時候遇到了R版本不匹配的問題，如果有朋友也遇到無法install.packages的問題，可以右轉github下載，或網頁版CRAN手動下載安裝，這里不多說。
注：glmnet需要輸入x的格式為矩陣（matrix），y的格式為double，否則會報錯。
#about glmnet: x should be in format of matrix, and time&status in y should be in double format.
x <- as.matrix(survival_cancer[,gsub(resSigAll@rownames, pattern = '-', replacement = '_')])
y <- survival_cancer[,c('overall_survival', 'censoring_status')]
names(y) <- c('time', 'status')
y$time <- as.double(y$time)
y$status <- as.double(y$status)
y <- as.matrix(survival::Surv(y$time, y$status))
lasso_fit <- cv.glmnet(x, y, family='cox', type.measure = 'deviance')
coefficient <- coef(lasso_fit, s=lasso_fit$lambda.min)
Active.Index <- which(as.numeric(coefficient) != 0)
active.coefficients <- as.numeric(coefficient)[Active.Index]
sig_gene_multi_cox <- rownames(coefficient)[Active.Index]
這一次我們僅僅獲得了4個candidates：
5. 利用篩選出來的少數candidates建立多因素COX回歸模型。
話不多說，依舊用survival包的cox.ph()建模，用coxzph()檢驗每個因子的PH假設。然后計算回歸模型中每個因子的VIF和相關系數，判斷因素間可能存在的共線性。通過PH假設和共線性檢驗的變量再進行第二次建模，隨后繪制COX回歸森林圖。
#perform the multi-variates cox regression using qualified genes.
formula_for_multivariate <- as.formula(paste0('Surv(overall_survival, censoring_status)~', paste(sig_gene_multi_cox, sep = '', collapse = '+')))
multi_variate_cox <- coxph(formula_for_multivariate, data = survival_cancer)
#check if variances are supported by PH hypothesis.
ph_hypo_multi <- cox.zph(multi_variate_cox)
#The last row of the table records the test results on the GLOBAL model. Delete it.
ph_hypo_table <- ph_hypo_multi$table[-nrow(ph_hypo_multi$table),]
#Remove variances not supported by ph hypothesis and perform the 2nd regression.
formula_for_multivariate <- as.formula(paste0('Surv(overall_survival, censoring_status)~', paste(rownames(ph_hypo_table)[ph_hypo_table[,3]>0.05], sep = '', collapse = '+')))
multi_variate_cox_2 <- coxph(formula_for_multivariate, data = survival_cancer)
到這里我們可以發現4個candidates中有1個未通過coxzph()的檢驗，只有3個基因納入了第二次的建模。
關于檢測變量間的共線性，需要綜合考慮：變量間的相關系數<0.5和vif平方根<2均被提出是可行的檢驗方法。
我們進行相關系數，vif的計算，并進行相關性矩陣的可視化。
#check the co-linearity between samples.
correlation <- cor(survival_cancer[,rownames(ph_hypo_table)[ph_hypo_table[,3]>0.05]], method = 'pearson')
library('GGally')
ggpairs(survival_cancer[,rownames(ph_hypo_table)[ph_hypo_table[,3]>0.05]],
axisLabels = 'show')+
theme_bw()+
theme(panel.background = element_rect(colour = 'black', size=1, fill = 'white'),
panel.grid = element_blank())
library('rms')
vif <- rms::vif(multi_variate_cox_2)
#Some people said if the square root of VIF >2, they might be co-linear.
sqrt(vif) < 2
可以得到結果：變量vif均未達到共線性的程度。不需進一步剔除。
相關性矩陣可視化結果如下：
接下來用森林圖可視化這個模型。
ggforest(model = multi_variate_cox_2, data = survival_cancer, main = 'Hazard ratios of candidate genes', fontsize = 1)
可視化結果如下，記錄了模型中各因子的危險比HR，置信區間，模型的AIC值，concordance index。結果說明模型中OR2W3為獨立的顯著危險因素，CHEK2為獨立的顯著保護因素，且整個cox模型也具有顯著意義：
6. 多方面評價cox模型的預測能力。
（1）Concordance index：
模型的一致性系數反映了其預測能力。C-index=0.5則完全隨機，=1為預測與實際完全一致。>=0.9為高，0.7-0.9間為中等，0.5-0.7間為低。
C_index <- multi_variate_cox_2$concordance['concordance']
if(C_index >= 0.9){
print('High accuracy')
}else{
if(C_index < 0.9 & C_index >= 0.7){
print('Medium accuracy')
}else{
print('Low accuracy')
}
}
Anyway, just have fun...
（2）time-dependent ROC curve:
ROC曲線用于反映預測模型的準確性和精確性，AUC曲線下面積越大，ROC曲線轉折點越靠近左上角，說明預測能力越好。一般認為AUC>=0.7可以夠看。
對于COX回歸，可以使用time-dependent ROC曲線檢測模型預測特定時間預后的能力。
COX建模的意義在于用模型計算出的risk score預測病人的生存狀態。首先用模型得到的系數計算每個樣本的risk score（gene1β1+gene2β2+gene3*β3）：
依舊是自建函數，輸入survival_cancer信息表，candidate genes vector和多因素cox回歸對象，輸出包含每個樣本risk score的risk_score_table.
#calculate the risk score of each sample.
riskscore <- function(survival_cancer_df, candidate_genes_for_cox, cox_report) {
library('dplyr')
risk_score_table <- survival_cancer_df[,candidate_genes_for_cox]
for(each_sig_gene in colnames(risk_score_table)){
risk_score_table$each_sig_gene <- risk_score_table[,each_sig_gene]*(summary(cox_report)$coefficients[each_sig_gene,1])
}
risk_score_table <- cbind(risk_score_table, 'total_risk_score'=exp(rowSums(risk_score_table))) %>%
cbind(survival_cancer_df[,c('TCGA_IDs','overall_survival','censoring_status')])
risk_score_table <- risk_score_table[,c('TCGA_IDs','overall_survival','censoring_status', candidate_genes_for_cox, 'total_risk_score')]
risk_score_table
}
candidate_genes_for_cox2 <- c(rownames(ph_hypo_table)[ph_hypo_table[,3]>0.05])
risk_score_table_multi_cox2 <- riskscore(survival_cancer, candidate_genes_for_cox2, multi_variate_cox_2)
這里我們自建函數，批量做3-5年多個時間點的ROC曲線，比較出AUC最大的時點。
multi_ROC <- function(time_vector, risk_score_table){
library('survivalROC')
single_ROC <- function(single_time){
for_ROC <- survivalROC(Stime = risk_score_table$overall_survival,
status = risk_score_table$censoring_status,
marker = risk_score_table$total_risk_score,
predict.time = single_time, method = 'KM')
data.frame('True_positive'=for_ROC$TP, 'False_positive'=for_ROC$FP,
'Cut_values'=for_ROC$cut.values, 'Time_point'=rep(single_time, length(for_ROC$TP)),
'AUC'=rep(for_ROC$AUC, length(for_ROC$TP)))
}
multi_ROC_list <- lapply(time_vector, single_ROC)
do.call(rbind, multi_ROC_list)
}
#We evaluate 11 AUCs between 3-5 years.
for_multi_ROC <- multi_ROC(time_vector = c(365*seq(3,5,0.2)), risk_score_table = risk_score_table_multi_cox2)
輸出的for_multi_ROC dataframe中含有每個時間點的True positive和False positive隨不同cut off值變化的趨勢。
不同時間點ROC曲線的可視化：
#visualization of the ROC curves of multiple time points.
pROC<-ggplot(for_multi_ROC, aes(x = False_positive, y = True_positive, label = Cut_values, color = Time_point)) +
geom_roc(labels = F, stat = 'identity', n.cuts = 0) +
geom_abline(slope = 1, intercept = 0, color = 'red', linetype = 2)+
theme_bw()+
theme(panel.background = element_rect(colour = 'black', size=1, fill = 'white'),
panel.grid = element_blank())+
annotate("text",x = 0.75, y = 0.15,
label = paste("AUC max = ", round(AUC_max, 2), '\n', 'AUC max time = ', AUC_max_time, ' days', sep = ''))
pROC
AUC max為0.63，可見其實預測能力都很差- -菜雞互啄罷了。只是案例操作，無妨。
(3) Kaplan-Meier生存分析。
Kaplan-Meier分析用于比較兩組之間的生存狀態。所以我們需要把計算出來的risk_score按照一個截點分為高/低風險組。
ROC曲線的另外一個功能就是可以用于risk score分組最佳截點的選擇。
首先選取AUC最大的時間點，使用這個時間點的ROC曲線進行Kaplan-Meier分析。
然后截取ROC曲線的轉折點，也就是真陽性和假陽性差值最大的點，作為risk score的cut-off值，高于這個值為高風險組，低于這個值為低風險組，并把信息并入risk_score_table中。
AUC_max <- max(for_multi_ROC$AUC)
#maybe AUCs are identical in different time points. So select the last time point indicating longer survival.
AUC_max_time <- for_multi_ROC$Time_point[which(for_multi_ROC$AUC == AUC_max)]
AUC_max_time <- AUC_max_time[!duplicated(AUC_max_time)]
AUC_max_time <- AUC_max_time[length(AUC_max_time)]
for_multi_ROC$Time_point <- as.factor(for_multi_ROC$Time_point)
#find the optimal cutoff value within the ROC curve of the optimal time point.
optimal_time_ROC_df <- for_multi_ROC[which(for_multi_ROC$Time_point == AUC_max_time),]
cut.off <- optimal_time_ROC_df$Cut_values[which.max(optimal_time_ROC_df$True_positive-optimal_time_ROC_df$False_positive)]
high_low <- (risk_score_table_multi_cox2$total_risk_score > cut.off)
high_low[high_low == TRUE] <- 'high'
high_low[high_low == FALSE] <- 'low'
risk_score_table_multi_cox2 <- cbind(risk_score_table_multi_cox2, high_low)
此時，已經將risk score這個連續變量轉變為了'high'和'low'的二分類變量。使用survival包建立KM分析對象，然后使用survminer包可視化作KM-plot并進行Log-rank分析。
注：為了最佳的可視化效果，根據之前獲得的最佳預測時間（本例為1825天=5年），將Overall_survival超過預測時間的樣本編輯一下，將生存時間改為1825天，生存狀態改為0。（可理解為觀察終點為5年，這些樣本在這個時點成功完成觀察而未發生事件）
#KM_plot generation.
library('survminer')
#first edit the status of patients with OS > AUC max time. (censoring status=0 (Alive), OS=365*5 days)
risk_score_table_multi_cox2$censoring_status[which(risk_score_table_multi_cox2$overall_survival > AUC_max_time)] <- 0
risk_score_table_multi_cox2$overall_survival[which(risk_score_table_multi_cox2$overall_survival > AUC_max_time)] <- AUC_max_time
fit_km <- survfit(Surv(overall_survival, censoring_status) ~high_low, data = risk_score_table_multi_cox2)
ggsurvplot(fit_km, conf.int = F,pval = T,legend.title="total risk score",
legend.labs=c(paste0('>',as.character(round(cut.off,2))), paste0('<=',as.character(round(cut.off,2)))), risk.table = T,
palette = c('red','blue'), surv.median.line = 'hv')
至此時，一整套生存分析就完成了！
寫這么多，我太難了...
