Switch to side-by-side view

--- a
+++ b/RNA-seq/Functions/survival.combined.R
@@ -0,0 +1,195 @@
+source(file = "/home/longzhilin/Analysis_Code/code/analysis.diff.survival.TCGA.R")
+DESeq2.normalized_counts <- readRDS("/data/active_data/lzl/RenalTumor-20200713/Data/TCGA/KIRC/Result/DESeq2.normalized_counts.rds")
+DESeq2.normalized_counts <- log2(DESeq2.normalized_counts+1)
+DESeq2.result <- readRDS("/data/active_data/lzl/RenalTumor-20200713/Data/TCGA/KIRC/Result/DESeq2.result.rds")
+clin.data <- readRDS("/data/active_data/lzl/RenalTumor-20200713/Data/TCGA/KIRC/Result/clin.data.rds")
+
+survival.combined <- function(geneA, geneB, clin.data, DESeq2.result, DESeq2.normalized_counts, risk.table = T){
+    gene.overlap <- intersect(c(geneA, geneB), rownames(DESeq2.result))
+    diff.gene.pro.sig.gene <- DESeq2.result[gene.overlap,]
+    interest.gene.sig <- data.frame(Gene = gene.overlap)
+    sample.id <- colnames(DESeq2.normalized_counts)
+    sample.id <- substr(sample.id, 1, 16)
+    sample.type <- substr(sample.id, 14, 15)
+    sample.id <- substr(sample.id, 1, 15)
+    patient.overlap <- intersect(clin.data$Sample, sample.id)
+    exp.data.process.pro <- DESeq2.normalized_counts[,match(patient.overlap, sample.id)]
+    clin.info <- clin.data[match(patient.overlap, clin.data$Sample),]
+
+    exp.A <- exp.data.process.pro[geneA,]
+    exp.B <- exp.data.process.pro[geneB,]
+
+    med.exp <- median(exp.A)
+    high.group <- which(exp.A>med.exp)
+    exp.A.label <- rep(paste0("Low ", geneA), length(exp.A))
+    exp.A.label[high.group] <- paste0("High ", geneA)
+
+    med.exp <- median(exp.B)
+    high.group <- which(exp.B>med.exp)
+    exp.B.label <- rep(paste0("Low ", geneB), length(exp.B))
+    exp.B.label[high.group] <- paste0("High ", geneB)
+
+    groups <- paste0(exp.A.label, " + ", exp.B.label)
+    OS.data <- data.frame(Patient_ID = patient.overlap, event = clin.info$OS, time = clin.info$OS_time, sample.label = groups)
+    DFS.data <- data.frame(Patient_ID = patient.overlap, event = clin.info$DFS, time = clin.info$DFS_time, sample.label = groups)
+    p1 <- plot.surv(OS.data, risk.table = risk.table, HR = T, ylab = "Overall Survival", main = paste0(geneA, " + ", geneB), surv.median.line = "hv", xlab = "Time (Month)", colors = c("#D95319", "#F39B7F", "#3B6793","#4285F4"))
+    print(p1)
+    p2 <- plot.surv(DFS.data, risk.table = risk.table, HR = T, ylab = "Disease-Free Survival", main = paste0(geneA, " + ", geneB), surv.median.line = "hv", xlab = "Time (Month)", colors = c("#D95319", "#F39B7F", "#3B6793","#4285F4"))
+    print(p2)
+    return(list(OS.data = OS.data, DFS.data = DFS.data))
+}
+
+plot.surv <- function(clinical.data, upper.time = NULL, xscale = 1, xlab = "Time", median.time = TRUE, 
+                      surv.median.line = "none", HR = FALSE, risk.table = TRUE, pval = TRUE, 
+                      conf.int = FALSE, main = NULL, ylab = "Survival probability", colors = c("#D95319", "#F39B7F", "#3B6793","#4285F4")) {
+  
+#Load related R packages
+  require(survival)
+  require(survminer)
+  require(RColorBrewer)
+  require(gridExtra)
+
+  #Determine the unit of event type and time
+  # survival.event <- survival.event[1];
+  # unit.xlabel <- unit.xlabel[1];
+
+  #If upper.time is set, the samples whose survival time exceeds upper.time will be removed
+  if (!is.null(upper.time)) clinical.data <- clinical.data[clinical.data$time <= upper.time,]
+
+  #set color
+  if (!is.factor(clinical.data$sample.label)) 
+    clinical.data$sample.label <- as.factor(clinical.data$sample.label)
+  
+  t.name <- levels(clinical.data$sample.label)
+  
+if (length(t.name)> 6) stop("Sample grouping>6, exceeding the function acceptance range")
+  t.col <- colors[1:length(t.name)]
+  
+# Construct a living object
+   km.curves <- survfit(Surv(time, event)~sample.label, data=clinical.data)
+  
+   # Calculate HR value and 95% CI
+  if (length(t.name) == 2) {
+    if (HR) {
+      cox.obj <- coxph(Surv(time, event)~sample.label, data=clinical.data)
+      tmp <- summary(cox.obj)
+      HRs <- round(tmp$coefficients[ ,2], digits = 2)
+      HR.confint.lower <- round(tmp$conf.int[,"lower .95"], 2)
+      HR.confint.upper <- round(tmp$conf.int[,"upper .95"], 2)
+      HRs <- paste0(HRs, " (", HR.confint.lower, "-", HR.confint.upper, ")")	  
+    }
+  }
+  
+# Construct the legend display text in the survival image
+   legend.content <- substr(names(km.curves$strata), start = 14, stop = 1000)
+  
+   # x-axis scale unit conversion
+   if (is.numeric(xscale) | (xscale %in% c("d_m", "d_y", "m_d", "m_y", "y_d", "y_m"))) {
+     xscale = xscale
+   } else {
+     stop('xscale should be numeric or one of c("d_m", "d_y", "m_d", "m_y", "y_d", "y_m").')
+   }
+  
+   # Implicit function: conversion of survival time unit
+  .format_xticklabels <- function(labels, xscale){
+    # 1 year = 365.25 days
+    # 1 month = 365.25/12 = 30.4375 days
+    if (is.numeric(xscale)) xtrans <- 1/xscale
+    else
+      xtrans <- switch(xscale,
+                       d_m = 12/365.25,
+                       d_y = 1/365.25,
+                       m_d = 365.25/12,
+                       m_y = 1/12,
+                       y_d = 365.25,
+                       y_m = 12,
+                       1
+      )
+    round(labels*xtrans,2)
+  }
+  
+# Add the median survival time and its 95% CI in the figure and place it in the subtitle position
+  subtitle <- NULL
+  if (median.time) {
+    if (is.numeric(xscale)) {
+      median.km.obj = km.curves
+    } else if (xscale %in% c("d_m", "d_y", "m_d", "m_y", "y_d", "y_m")) {
+      clinical.data$time <- .format_xticklabels(labels = clinical.data$time, xscale = xscale)
+      median.km.obj <- survfit(Surv(time, event)~sample.label, data=clinical.data)
+    }
+    survival.time.info <- NULL
+    survival.time.info <- rbind(survival.time.info, summary(median.km.obj)$table)
+    median.survival <- round(survival.time.info[!duplicated(survival.time.info[,7:9]),7:9], digits = 2) # 注意:这里取得的置信区间上界可能为NA
+    if (length(levels(clinical.data$sample.label)) == 1) {
+      tmp1 <- levels(clinical.data$sample.label)
+    } else {
+      tmp1 <- do.call(rbind,strsplit(rownames(summary(median.km.obj)$table), split = "="))[,2]
+    }
+    tmp2 <- paste(median.survival[,1], "(", median.survival[,2], "-", median.survival[,3], ")")
+    subtitle <- paste(tmp1, tmp2, sep = ":", collapse = "\n")
+  }
+  
+  # ggsurvplot
+  ggsurv <- ggsurvplot(km.curves,               # survfit object with calculated statistics.
+                       data = clinical.data,    # data used to fit survival curves.
+                       palette = t.col,
+                       
+                       risk.table = risk.table,       # show risk table.
+                       pval = pval,             # show p-value of log-rank test.
+                       surv.median.line = surv.median.line,  # add the median survival pointer.
+                       title = main,     #main title
+                       subtitle = subtitle, #sub title
+                       font.main = 15,                 
+                       xlab = xlab,   # customize X axis label.
+                       ylab = ylab,   # customize Y axis label
+                       xscale = xscale,
+                       
+                       
+                       #legend
+                       legend.title = "", 
+                       legend.labs = legend.content, 
+                       legend = c(0.8,0.9), 
+                       font.legend = 9,     
+                       
+                       #risk table
+                       tables.theme = theme_cleantable(),
+                       risk.table.title = "No. at risk:",
+                       risk.table.y.text.col = T, 
+                       risk.table.y.text = FALSE, 
+                       tables.height = 0.15,      
+                       risk.table.fontsize = 3  
+  )
+  if (length(t.name) == 2) {
+    if (HR) 
+      ggsurv$plot <- ggsurv$plot + ggplot2::annotate("text", x = max(km.curves$time)/12, 
+                                                     y = 0.15, size = 5, label = paste("HR=", HRs))
+  } 
+
+  ggsurv$plot <- ggsurv$plot + theme(plot.title = element_text(hjust = 0.5), plot.subtitle = element_text(size = 10), 
+                                     plot.margin = unit(c(5.5, 5.5, 5.5, 50), "points"))
+
+  ggsurv$table <- ggsurv$table + theme(plot.title = element_text(hjust = -0.04),
+                                       plot.margin = unit(c(5.5, 5.5, 5.5, 50), "points"))
+  
+
+  if(length(t.name) > 2) {
+    # pairwise: log rank P value
+    res <- pairwise_survdiff(Surv(time, event)~sample.label, data=clinical.data);
+    pairwise.pvalue <- round(res$p.value, digits = 4);
+    pairwise.pvalue[which(pairwise.pvalue < 0.0001)] <- "<0.0001";
+    pairwise.pvalue[is.na(pairwise.pvalue)] <- "-"
+    
+    # add table
+    tt <- ttheme_minimal(core = list(fg_params = list(col = "black"),bg_params = list(fill = NA, col = "black")),
+                         colhead = list(fg_params = list(col = NA),bg_params = list(fill = t.col, col = "black")),
+                         rowhead = list(fg_params = list(col = NA, hjust = 1),bg_params = list(fill = c("white",t.col[-1]), col = "black"))
+    )
+    pairwise.table <- tableGrob(pairwise.pvalue, theme = tt)
+    ggsurv <- ggarrange(ggarrange(ggsurv$plot, ggsurv$table, nrow=2, heights=c(2,0.5)),
+                        pairwise.table, nrow=2, heights = c(2,0.5),
+                        labels = c("","p from pairwise comparisons"),
+                        hjust = 0, font.label = list(size = 15, face = "plain"))
+  }
+  
+  ggsurv	
+}