Switch to unified view

a b/RNA-seq/Functions/RCC.ICB.analysis.R
1
source(file = "/home/longzhilin/Analysis_Code/SurvivalAnalysis/Cox.function.R")
2
3
RCC.icb.analysis <- function(signature.list, expresionMatrix, clincal.info){
4
    library(ggpubr)    
5
    signature.list.score <- lapply(names(signature.list), function(y){
6
7
        genes <- signature.list[[y]]
8
        programName <- y
9
        index <- match(genes, rownames(expresionMatrix))
10
        if(length(na.omit(index)) < length(index)){
11
            cat(y, " lack ", genes[which(is.na(index))], " gene\n")
12
        }
13
        signature.score <- colMeans(expresionMatrix[na.omit(index),])
14
15
        ICB.treatment.idx <- which(clincal.info$Arm == "NIVOLUMAB")
16
        signature.score.icb <- signature.score[ICB.treatment.idx]
17
        clincal.info.icb <- clincal.info[ICB.treatment.idx,]
18
        plot.data.icb <- data.frame(score = signature.score.icb, Cohort = clincal.info.icb$Cohort, Benefit = clincal.info.icb$Benefit)
19
        p <- ggboxplot(plot.data.icb, x = "Cohort", y = "score", color = "Benefit", xlab = "", ylab = "Signature score", title = paste0("ICB threapy", "-", programName), add = "jitter") + stat_compare_means(aes(group = Benefit), label = "p.format")
20
        print(p)
21
22
23
        index <- which(plot.data.icb$Benefit=="ICB")
24
        plot.data.icb.CB.VS.ICB <- plot.data.icb[-index,]
25
        p <- ggboxplot(plot.data.icb.CB.VS.ICB, x = "Cohort", y = "score", color = "Benefit", xlab = "", ylab = "Signature score", title = paste0("ICB threapy", "-", programName), add = "jitter") + stat_compare_means(aes(group = Benefit), label = "p.format")
26
        print(p)    
27
28
        mTOR.treatment.idx <- which(clincal.info$Arm == "EVEROLIMUS")
29
        signature.score.mTOR <- signature.score[mTOR.treatment.idx]
30
        clincal.info.mTOR <- clincal.info[mTOR.treatment.idx,]
31
        plot.data.mTOR <- data.frame(score = signature.score.mTOR, Cohort = clincal.info.mTOR$Cohort, Benefit = clincal.info.mTOR$Benefit)
32
        p <- ggboxplot(plot.data.mTOR, x = "Cohort", y = "score", color = "Benefit", xlab = "", ylab = "Signature score", title = paste0("mTOR threapy", "-", programName), add = "jitter") + stat_compare_means(aes(group = Benefit), label = "p.format")
33
        print(p)
34
35
        index <- which(plot.data.mTOR$Benefit=="ICB")
36
        plot.data.mTOR.CB.VS.ICB <- plot.data.mTOR[-index,]
37
        p <- ggboxplot(plot.data.mTOR.CB.VS.ICB, x = "Cohort", y = "score", color = "Benefit", xlab = "", ylab = "Signature score", title = paste0("mTOR threapy", "-", programName), add = "jitter") + stat_compare_means(aes(group = Benefit), label = "p.format")
38
        print(p)        
39
40
        #survival plot
41
        #Based on median grouping
42
        survival.res <- sapply(c("CM-009", "CM-010", "CM-025"), function(x){
43
44
            index <- which(clincal.info.icb$Cohort == x)
45
            clincal.info.icb.cohort <- clincal.info.icb[index,]
46
            signature.score.icb.cohort <- signature.score.icb[index]
47
48
            mid.score.icb <- median(signature.score.icb.cohort)
49
            icb.label <- rep("High score", length(signature.score.icb.cohort))
50
            icb.label[which(signature.score.icb.cohort<=mid.score.icb)] <- "Low score"
51
            if(length(table(icb.label)) <= 1){
52
                cox.res <- "NA"
53
            }else{
54
                if(x == "CM-025"){
55
                    # different treatment
56
57
                    icb.clincal.OS <- data.frame(Patient_ID = clincal.info.icb.cohort$RNA_ID, event = clincal.info.icb.cohort$OS_CNSR, time = clincal.info.icb.cohort$OS, sample.label = icb.label)
58
                    p1 <- plot.surv(icb.clincal.OS, risk.table = T, HR = T, ylab = "Overall Survival", main = paste0("ICB ", programName, " ", x), surv.median.line = "hv", xlab = "Time (Month)")
59
                    print(p1)
60
                    icb.clincal.PFS <- data.frame(Patient_ID = clincal.info.icb.cohort$RNA_ID, event = clincal.info.icb.cohort$PFS_CNSR, time = clincal.info.icb.cohort$PFS, sample.label = icb.label)
61
                    p1 <- plot.surv(icb.clincal.PFS, risk.table = T, HR = T, ylab = "Progression-Free Survival", main = paste0("ICB ", programName, " ", x), surv.median.line = "hv", xlab = "Time (Month)")
62
                    print(p1)
63
                    
64
                    cox.clincal.data <- data.frame(Patient_ID = clincal.info.icb.cohort$RNA_ID, time = clincal.info.icb.cohort$OS, event = clincal.info.icb.cohort$OS_CNSR, sample.label = icb.label, Sex = clincal.info.icb.cohort$Sex, Age = clincal.info.icb.cohort$Age, Prior_Therapies = clincal.info.icb.cohort$Number_of_Prior_Therapies, Metastasis = clincal.info.icb.cohort$Tumor_Sample_Primary_or_Metastasis)
65
                    cox.clincal.data <- na.omit(cox.clincal.data)
66
                    icb.cox.OS <- Cox.function(time = cox.clincal.data$time, event = cox.clincal.data$event, clinical.data = cox.clincal.data)
67
                    cox.clincal.data <- data.frame(Patient_ID = clincal.info.icb.cohort$RNA_ID, time = clincal.info.icb.cohort$PFS, event = clincal.info.icb.cohort$PFS_CNSR, sample.label = icb.label, Sex = clincal.info.icb.cohort$Sex, Age = clincal.info.icb.cohort$Age, Prior_Therapies = clincal.info.icb.cohort$Number_of_Prior_Therapies, Metastasis = clincal.info.icb.cohort$Tumor_Sample_Primary_or_Metastasis)
68
                    cox.clincal.data <- na.omit(cox.clincal.data)
69
                    icb.cox.PFS <- Cox.function(time = cox.clincal.data$time, event = cox.clincal.data$event, clinical.data = cox.clincal.data)
70
71
                    ####mTOR 
72
                    mid.score.mTOR <- median(signature.score.mTOR)
73
                    mTOR.label <- rep("High score", length(signature.score.mTOR))
74
                    mTOR.label[which(signature.score.mTOR<=mid.score.mTOR)] <- "Low score"
75
                    mTOR.clincal.OS <- data.frame(Patient_ID = clincal.info.mTOR$RNA_ID, event = clincal.info.mTOR$OS_CNSR, time = clincal.info.mTOR$OS, sample.label = mTOR.label)
76
77
                    p1 <- plot.surv(mTOR.clincal.OS, risk.table = T, HR = T, ylab = "Overall Survival", main = paste0("mTOR ", programName, " ", x), surv.median.line = "hv", xlab = "Time (Month)")
78
                    print(p1)
79
                    mTOR.clincal.PFS <- data.frame(Patient_ID = clincal.info.mTOR$RNA_ID, event = clincal.info.mTOR$PFS_CNSR, time = clincal.info.mTOR$PFS, sample.label = mTOR.label)
80
                    p1 <- plot.surv(mTOR.clincal.PFS, risk.table = T, HR = T, ylab = "Progression-Free Survival", main = paste0("mTOR ", programName, " ", x), surv.median.line = "hv", xlab = "Time (Month)")
81
                    print(p1)
82
83
                    cox.clincal.data <- data.frame(Patient_ID = clincal.info.mTOR$RNA_ID, time = clincal.info.mTOR$OS, event = clincal.info.mTOR$OS_CNSR, sample.label = mTOR.label, Sex = clincal.info.mTOR$Sex, Age = clincal.info.mTOR$Age, Prior_Therapies = clincal.info.mTOR$Number_of_Prior_Therapies, Metastasis = clincal.info.mTOR$Tumor_Sample_Primary_or_Metastasis)
84
                    cox.clincal.data <- na.omit(cox.clincal.data)
85
                    mTOR.cox.OS <- Cox.function(time = cox.clincal.data$time, event = cox.clincal.data$event, clinical.data = cox.clincal.data)
86
                    cox.clincal.data <- data.frame(Patient_ID = clincal.info.mTOR$RNA_ID, time = clincal.info.mTOR$PFS, event = clincal.info.mTOR$PFS_CNSR, sample.label = mTOR.label, Sex = clincal.info.mTOR$Sex, Age = clincal.info.mTOR$Age, Prior_Therapies = clincal.info.mTOR$Number_of_Prior_Therapies, Metastasis = clincal.info.mTOR$Tumor_Sample_Primary_or_Metastasis)
87
                    cox.clincal.data <- na.omit(cox.clincal.data)
88
                    mTOR.cox.PFS <- Cox.function(time = cox.clincal.data$time, event = cox.clincal.data$event, clinical.data = cox.clincal.data)
89
90
                    cox.res <- list(icb.OS = icb.cox.OS, icb.PFS = icb.cox.PFS, mTOR.OS = mTOR.cox.OS, mTOR.PFS = mTOR.cox.PFS)
91
                }else{
92
93
                    icb.clincal.OS <- data.frame(Patient_ID = clincal.info.icb.cohort$RNA_ID, event = clincal.info.icb.cohort$OS_CNSR, time = clincal.info.icb.cohort$OS, sample.label = icb.label)
94
                    p1 <- plot.surv(icb.clincal.OS, risk.table = T, HR = T, ylab = "Overall Survival", main = paste0(programName, " ", x), surv.median.line = "hv", xlab = "Time (Month)")
95
                    print(p1)
96
                    icb.clincal.PFS <- data.frame(Patient_ID = clincal.info.icb.cohort$RNA_ID, event = clincal.info.icb.cohort$PFS_CNSR, time = clincal.info.icb.cohort$PFS, sample.label = icb.label)
97
                    p1 <- plot.surv(icb.clincal.PFS, risk.table = T, HR = T, ylab = "Progression-Free Survival", main = paste0(programName, " ", x), surv.median.line = "hv", xlab = "Time (Month)")
98
                    print(p1)
99
100
                    cox.clincal.data <- data.frame(Patient_ID = clincal.info.icb.cohort$RNA_ID, time = clincal.info.icb.cohort$OS, event = clincal.info.icb.cohort$OS_CNSR, sample.label = icb.label, Sex = clincal.info.icb.cohort$Sex, Age = clincal.info.icb.cohort$Age)
101
                    cox.clincal.data <- na.omit(cox.clincal.data)
102
                    icb.cox.OS <- Cox.function(time = cox.clincal.data$time, event = cox.clincal.data$event, clinical.data = cox.clincal.data)
103
                    cox.clincal.data <- data.frame(Patient_ID = clincal.info.icb.cohort$RNA_ID, time = clincal.info.icb.cohort$PFS, event = clincal.info.icb.cohort$PFS_CNSR, sample.label = icb.label, Sex = clincal.info.icb.cohort$Sex, Age = clincal.info.icb.cohort$Age)
104
                    cox.clincal.data <- na.omit(cox.clincal.data)
105
                    icb.cox.PFS <- Cox.function(time = cox.clincal.data$time, event = cox.clincal.data$event, clinical.data = cox.clincal.data)
106
107
                    cox.res <- list(icb.OS = icb.cox.OS, icb.PFS = icb.cox.PFS)
108
                }
109
            }     
110
            return(cox.res)
111
        })
112
        
113
    })
114
    names(signature.list.score) <- names(signature.list)
115
    return(signature.list.score)
116
}
117
118
plot.surv <- function(clinical.data, upper.time = NULL, xscale = 1, xlab = "Time", median.time = TRUE, 
119
                      surv.median.line = "none", HR = FALSE, risk.table = TRUE, pval = TRUE, 
120
                      conf.int = FALSE, main = NULL, ylab = "Survival probability", colors = c("#D95319", "#3B6793","#EA4335","#4285F4","#34A853","#000000")) {
121
  
122
#Load related R packages
123
  require(survival)
124
  require(survminer)
125
  require(RColorBrewer)
126
  require(gridExtra)
127
128
  #Determine the unit of event type and time
129
  # survival.event <- survival.event[1];
130
  # unit.xlabel <- unit.xlabel[1];
131
132
  #If upper.time is set, the samples whose survival time exceeds upper.time will be removed
133
  if (!is.null(upper.time)) clinical.data <- clinical.data[clinical.data$time <= upper.time,]
134
135
  #set color
136
  if (!is.factor(clinical.data$sample.label)) 
137
    clinical.data$sample.label <- as.factor(clinical.data$sample.label)
138
  
139
  t.name <- levels(clinical.data$sample.label)
140
  
141
if (length(t.name)> 6) stop("Sample grouping>6, exceeding the function acceptance range")
142
  t.col <- colors[1:length(t.name)]
143
  
144
# Construct a living object
145
   km.curves <- survfit(Surv(time, event)~sample.label, data=clinical.data)
146
  
147
   # Calculate HR value and 95% CI
148
  if (length(t.name) == 2) {
149
    if (HR) {
150
      cox.obj <- coxph(Surv(time, event)~sample.label, data=clinical.data)
151
      tmp <- summary(cox.obj)
152
      HRs <- round(tmp$coefficients[ ,2], digits = 2)
153
      HR.confint.lower <- round(tmp$conf.int[,"lower .95"], 2)
154
      HR.confint.upper <- round(tmp$conf.int[,"upper .95"], 2)
155
      HRs <- paste0(HRs, " (", HR.confint.lower, "-", HR.confint.upper, ")")      
156
    }
157
  }
158
  
159
# Construct the legend display text in the survival image
160
   legend.content <- substr(names(km.curves$strata), start = 14, stop = 1000)
161
  
162
   # x-axis scale unit conversion
163
   if (is.numeric(xscale) | (xscale %in% c("d_m", "d_y", "m_d", "m_y", "y_d", "y_m"))) {
164
     xscale = xscale
165
   } else {
166
     stop('xscale should be numeric or one of c("d_m", "d_y", "m_d", "m_y", "y_d", "y_m").')
167
   }
168
  
169
   # Implicit function: conversion of survival time unit
170
  .format_xticklabels <- function(labels, xscale){
171
    # 1 year = 365.25 days
172
    # 1 month = 365.25/12 = 30.4375 days
173
    if (is.numeric(xscale)) xtrans <- 1/xscale
174
    else
175
      xtrans <- switch(xscale,
176
                       d_m = 12/365.25,
177
                       d_y = 1/365.25,
178
                       m_d = 365.25/12,
179
                       m_y = 1/12,
180
                       y_d = 365.25,
181
                       y_m = 12,
182
                       1
183
      )
184
    round(labels*xtrans,2)
185
  }
186
  
187
# Add the median survival time and its 95% CI in the figure and place it in the subtitle position
188
  subtitle <- NULL
189
  if (median.time) {
190
    if (is.numeric(xscale)) {
191
      median.km.obj = km.curves
192
    } else if (xscale %in% c("d_m", "d_y", "m_d", "m_y", "y_d", "y_m")) {
193
      clinical.data$time <- .format_xticklabels(labels = clinical.data$time, xscale = xscale)
194
      median.km.obj <- survfit(Surv(time, event)~sample.label, data=clinical.data)
195
    }
196
    survival.time.info <- NULL
197
    survival.time.info <- rbind(survival.time.info, summary(median.km.obj)$table)
198
    median.survival <- round(survival.time.info[!duplicated(survival.time.info[,7:9]),7:9], digits = 2) # 注意:这里取得的置信区间上界可能为NA
199
    if (length(levels(clinical.data$sample.label)) == 1) {
200
      tmp1 <- levels(clinical.data$sample.label)
201
    } else {
202
      tmp1 <- do.call(rbind,strsplit(rownames(summary(median.km.obj)$table), split = "="))[,2]
203
    }
204
    tmp2 <- paste(median.survival[,1], "(", median.survival[,2], "-", median.survival[,3], ")")
205
    subtitle <- paste(tmp1, tmp2, sep = ":", collapse = "\n")
206
  }
207
  
208
  # ggsurvplot
209
  ggsurv <- ggsurvplot(km.curves,               # survfit object with calculated statistics.
210
                       data = clinical.data,    # data used to fit survival curves.
211
                       palette = t.col,
212
                       
213
                       risk.table = risk.table,       # show risk table.
214
                       pval = pval,             # show p-value of log-rank test.
215
                       surv.median.line = surv.median.line,  # add the median survival pointer.
216
                       title = main,     #main title
217
                       subtitle = subtitle, #sub title
218
                       font.main = 15,                 
219
                       xlab = xlab,   # customize X axis label.
220
                       ylab = ylab,   # customize Y axis label
221
                       xscale = xscale,
222
                       
223
                       
224
                       #legend
225
                       legend.title = "", 
226
                       legend.labs = legend.content, 
227
                       legend = c(0.8,0.9), 
228
                       font.legend = 9,     
229
                       
230
                       #risk table
231
                       tables.theme = theme_cleantable(),
232
                       risk.table.title = "No. at risk:",
233
                       risk.table.y.text.col = T, 
234
                       risk.table.y.text = FALSE, 
235
                       tables.height = 0.15,      
236
                       risk.table.fontsize = 3  
237
  )
238
  if (length(t.name) == 2) {
239
    if (HR) 
240
      ggsurv$plot <- ggsurv$plot + ggplot2::annotate("text", x = max(km.curves$time)/12, 
241
                                                     y = 0.15, size = 5, label = paste("HR=", HRs))
242
  } 
243
244
  ggsurv$plot <- ggsurv$plot + theme(plot.title = element_text(hjust = 0.5), plot.subtitle = element_text(size = 10), 
245
                                     plot.margin = unit(c(5.5, 5.5, 5.5, 50), "points"))
246
247
  ggsurv$table <- ggsurv$table + theme(plot.title = element_text(hjust = -0.04),
248
                                       plot.margin = unit(c(5.5, 5.5, 5.5, 50), "points"))
249
  
250
251
  if(length(t.name) > 2) {
252
    # pairwise: log rank P value
253
    res <- pairwise_survdiff(Surv(time, event)~sample.label, data=clinical.data);
254
    pairwise.pvalue <- round(res$p.value, digits = 4);
255
    pairwise.pvalue[which(pairwise.pvalue < 0.0001)] <- "<0.0001";
256
    pairwise.pvalue[is.na(pairwise.pvalue)] <- "-"
257
    
258
    # add table
259
    tt <- ttheme_minimal(core = list(fg_params = list(col = "black"),bg_params = list(fill = NA, col = "black")),
260
                         colhead = list(fg_params = list(col = NA),bg_params = list(fill = t.col, col = "black")),
261
                         rowhead = list(fg_params = list(col = NA, hjust = 1),bg_params = list(fill = c("white",t.col[-1]), col = "black"))
262
    )
263
    pairwise.table <- tableGrob(pairwise.pvalue, theme = tt)
264
    ggsurv <- ggarrange(ggarrange(ggsurv$plot, ggsurv$table, nrow=2, heights=c(2,0.5)),
265
                        pairwise.table, nrow=2, heights = c(2,0.5),
266
                        labels = c("","p from pairwise comparisons"),
267
                        hjust = 0, font.label = list(size = 15, face = "plain"))
268
  }
269
  
270
  ggsurv    
271
}