if (T) { dir.create("scripts") dir.create("PDFs") dir.create("PDFs/图片") dir.create("files") dir.create("files/文件") dir.create("files/model_select") dir.create("files/limma") dir.create("files/limma/TCGA") dir.create("origin_datas") dir.create("origin_datas/TCGA") dir.create("results") dir.create("files/GSEA/") } rm(list = ls()) options(stringsAsFactors = F) source('Z://projects/codes/mg_base.R') draw_survial_curve_variant<-function(datas){ library(survminer) library(survcomp) library(RColorBrewer) tmp.formula <- paste("Surv(time,status)~",'groups',sep="") tmp.formula <- as.formula(tmp.formula) datas.fit <- surv_fit(formula=tmp.formula,data=datas) ggplot <- ggsurvplot(datas.fit,pval=T,risk.table=T, main = "Method Kaplan Meier", xlab="Time(days)", legend.title='Groups', risk.table.col="strata", linetype="strata", palette=brewer.pal(9,"Set1"), break.time.by=500, data=datas) print(ggplot,newpage=F) } plotKMCox <- function(dat){ colnames(dat)=c('time','status','groups') sdf<-survdiff(Surv(time,status) ~ groups,data=dat) print((sdf)) p<-pchisq(sdf$chisq,length(sdf$n)-1,lower.tail=FALSE) sf<-survfit(Surv(time,status) ~ groups,data=dat) colKm=rainbow(length(sf$strata)) plot(sf, mark.time = TRUE,col=colKm,xlab=paste("Survival time in day","\np=",round(p,5)),ylab = "Survival probabilities",main="Method Kaplan Meier") legend('topright',paste0(gsub('groups=','',names(sf$strata)),'(N=',sdf$n,')'), col = colKm, lty = c(1,1, 1, 1),lwd=c(1,1,1,1),merge = TRUE,cex = 0.8) return(p) } plotKMCox_1=function(dat,n){ library(survival) library(ggsci) mypal = pal_jama(alpha = 0.7)(7) colnames(dat)=c('time','status','groups') sdf<-survdiff(Surv(time,status) ~ groups,data=dat) #print((sdf)) p<-pchisq(sdf$chisq,length(sdf$n)-1,lower.tail=FALSE) sf<-survfit(Surv(time,status) ~ groups,data=dat) colKm=c(mypal[2],mypal[1],mypal[3],mypal[4]) plot(sf, mark.time = TRUE,col=colKm,xlab=paste("Survival time in day","\np=",round(p,5)),ylab = "Survival probabilities",main=n) legend('topright',paste0(gsub('groups=','',names(sf$strata)),'(N=',sdf$n,')'), col = colKm, lty = c(1,1, 1, 1),lwd=c(1,1,1,1),merge = TRUE,cex = 0.8) return(p) } coxFun <- function(dat){ library(survival) colnames(dat)=c('time','status','gene') fmla=as.formula("Surv(time,status)~gene") cox=coxph(fmla,data=dat) # print(summary(cox)) p=summary(cox)[[7]][5] result=c(p,summary(cox)[[8]][1],summary(cox)[[8]][3],summary(cox)[[8]][4]) return(result) } ggplotKMCox=function(dat,title='Groups',labs=c()){ library(ggplot2) colnames(dat)=c('time','status','groups') #sdf<-survdiff(Surv(time,status) ~ groups,data=dat) #print((sdf)) #summary(sdf) #p<-pchisq(sdf$chisq,length(sdf$n)-1,lower.tail=FALSE) sf<-survfit(Surv(time,status) ~ groups,data=dat) surv=survminer::ggsurvplot(sf, data = dat, palette = "npg", #jco palette pval = TRUE, pval.coord=c(500, 0.4), #Add p-value risk.table = TRUE, legend.title = title, legend.labs = labs) p1=surv$plot+theme_bw()+theme(axis.text.y=element_text(family="Times",face="plain") ,axis.text.x=element_blank() ,axis.title.x=element_blank() ,plot.margin=unit(c(0.2, 0.2, 0, 0.1), "inches") #,axis.title.y=element_blank() ,legend.position=c(1,1), legend.justification=c(1,1) ,legend.background = element_rect(fill = NA, colour = NA) ,legend.title = element_text(family="Times",face="plain") ,legend.text = element_text(family="Times",face="plain")) p2=surv$table+theme_bw()+theme(axis.text.y=element_text(family="Times",face="plain") #,axis.text.x=element_blank() #,axis.title.x=element_blank() #,axis.title.y=element_blank() ,plot.margin=unit(c(0, 0.2, 0.2, 0.1), "inches") ,plot.title=element_blank() ,legend.position=c(1,1), legend.justification=c(1,1) #,legend.background = element_rect(fill = NA, colour = NA) ,legend.title = element_text(family="Times",face="plain") ,legend.text = element_text(family="Times",face="plain")) g2=ggpubr::ggarrange(p1,p2, ncol = 1, nrow = 2,heights = c(1,0.3),align = "v") return(g2) } mg_violin=function(data,xangle=0,ylab='value',xlab='',leg.title='Group',test_method='anova',legend.pos='r',melt=F,jitter=T,ylim=NULL){ library(ggplot2) if(melt){ data_m=data colnames(data_m)=c('Group','value') }else{ data_m=reshape2::melt(data) colnames(data_m)=c('Group','value') } if(xangle==0){ tx=element_text(colour="black",family="Times") }else{ tx=element_text(angle=xangle,hjust = 1,colour="black",family="Times") } pos='right' if(is.null(legend.pos)){ pos='none' }else if(legend.pos=='tr'){ pos=c(1,1) }else if(legend.pos=='br'){ pos=c(1,0) }else if(legend.pos=='tl'){ pos=c(0,1) }else if(legend.pos=='bl'){ pos=c(0,0) }else if(legend.pos=='t'){ pos='top' }else if(legend.pos=='r'){ pos='right' }else if(legend.pos=='b'){ pos='bottom' } ct=length(unique(data_m[,1])) p1<-ggplot(data_m,aes(x=Group,y=value))+geom_violin(alpha=0.7) if(ct<=10){ p1=p1+ggsci::scale_fill_npg(name=leg.title) }else if(ct<=20){ p1=p1+ggsci::scale_fill_d3(palette = "category20",name=leg.title) }else if(ct<=30){ cbPalette=c(ggsci::pal_npg("nrc", alpha = 0.6)(10),ggsci::pal_d3("category20", alpha = 0.6)(20)) p1=p1+scale_fill_manual(values=cbPalette[1:ct]) }else if(ct<=38){ cbPalette=c(ggsci::pal_npg("nrc", alpha = 0.6)(10) ,ggsci::pal_d3("category20", alpha = 0.6)(20) ,ggsci::pal_nejm("default", alpha = 0.6)(8)) p1=p1+scale_fill_manual(values=cbPalette[1:ct]) } if(jitter){ p1<-p1+geom_jitter(alpha=0.3,col='black',show.legend=FALSE,width = 0.2) } p1=p1+theme_bw()+geom_boxplot(width=0.2,aes(fill=Group),outlier.shape = NA) p1=p1+theme(axis.text.x=tx, #设置x轴刻度标签的字体显示倾斜角度为15度，并向下调整1(hjust = 1)，字体簇为Times大小为20 axis.text.y=element_text(family="Times",face="plain"), #设置y轴刻度标签的字体簇，字体大小，字体样式为plain axis.title.y=element_text(family="Times",face="plain"), #设置y轴标题的字体属性 #panel.border = element_blank(),axis.line = element_line(colour = "black"), #去除默认填充的灰色，并将x=0轴和y=0轴加粗显示(size=1) legend.text=element_text(face="plain", family="Times", colour="black" #设置图例的子标题的字体属性 ), legend.title=element_text(face="plain", family="Times", colour="black" #设置图例的总标题的字体属性 ), legend.justification=pos, legend.position=pos ,legend.background = element_rect(fill = NA, colour = NA) #,panel.grid.major = element_blank(), #不显示网格线 #panel.grid.minor = element_blank() )+ylab(ylab)+xlab(xlab) til='' if(test_method=='anova'){ fit <- aov(value~Group, data = data_m) pv=summary(fit)[[1]][5][[1]] fv=summary(fit)[[1]][4][[1]] til=paste0('ANOVA test p=',signif(pv,2)) }else if (test_method=='rank'){ fit=kruskal.test(value~Group, data = data_m) pv=fit$p.value til=paste0('Kruskal-Wallis test p=',signif(pv,2)) } else { fit=wilcox.test(value~Group, data = data_m) pv=fit$p.value til=paste0('Wilcox test p=',signif(pv,2)) } p1=p1+ggtitle(til) if(!is.null(ylim)){ p1=p1+ylim(ylim) } return(p1) } ggplotTimeROC=function(time,status,score,mks=c(1,3,5)){ library(survival) library(ggplot2) mx=max(time,na.rm = T) if(mx<20){ }else if(mx<365){ mks=mks*12 }else{ mks=mks*365 } mks=mks[which(mks0){ x_m=st1$time[inds[1]] }else{ x_m=max(st1$time[st1$surv>=0.5]) } } if(x_m>0){ median_labels=c(median_labels,round(x_m,1)) } } if(length(median_labels)>0){ txt_median=surv$data.survplot[1:length(median_labels),] txt_median[,5]=rep(0.5,length(median_labels)) txt_median[,1]=median_labels txt_median$Text=median_labels p1=p1+geom_text(data=txt_median,aes(x=time, y=surv, label=Text),color="black",hjust =1,angle=90,alpha=0.5,vjust=0,nudge_y = -0.01) } } #p1=p1+text() #tms=data.frame(Group=tms.gp,value=tms.tps,Attribute=rep(data_m[1,1],length(tms.gp)) # ,ymax=rep(max(ylim),length(tms.gp))) #p4=p4+geom_text(data=tms,aes(x=Group, y=ymax, label=value),color="black") if(is.null(add_text)){ gp=unique(dat[,3]) vls=1:length(gp) gvls=vls[match(dat[,3],gp)] g.cox=coxRun(data.frame(dat[,1],dat[,2],gvls)) add_text=paste0('HR=',round(g.cox[2],2) ,', 95%CI(',round(g.cox[3],2) ,', ',round(g.cox[4],2),')' ,'\nHR By:',paste0(gp,collapse = '<')) } text.tb=surv$data.survplot[1,] text.tb[1,1]=0 text.tb[1,5]=0 text.tb$Text=add_text p1=p1+geom_text(data=text.tb,aes(x=time, y=surv, label=Text),color="black",hjust =0) p2=surv$table+theme_bw()+theme(axis.text.y=element_text(family="Times",face="plain") #,axis.text.x=element_blank() #,axis.title.x=element_blank() #,axis.title.y=element_blank() ,plot.margin=unit(c(0, 0.2, 0.2, 0.1), "inches") ,plot.title=element_blank() ,legend.position=c(1,1), legend.justification=c(1,1) #,legend.background = element_rect(fill = NA, colour = NA) ,legend.title = element_text(family="Times",face="plain") ,legend.text = element_text(family="Times",face="plain")) g2=ggpubr::ggarrange(p1,p2, ncol = 1, nrow = 2,heights = c(1,0.3),align = "v") return(g2) } TME_genes <- read.csv('D:/public/TME_genes.txt', header = F) TME_ori_genes <- TME_genes[,1] TME_new_genes <- mg_idconvert_local(TME_ori_genes) TME_new_genes <- TME_new_genes$IDMap$GeneSymbol length(unique(TME_new_genes)) length(TME_ori_genes) protein_genes <- read.delim('D://public/GeneTag.genecode.v32.txt', header = T, stringsAsFactors = F) protein_genes <- protein_genes[protein_genes$GENETYPE == 'protein_coding', ]$SYMBOL protein_genes <- intersect(protein_genes, rownames(tcga_lihc)) library(data.table) tcga_lihc <- fread('Z://TCGA/Matrix/mRNA_TPM_Symbol/Merge_TCGA-LIHC_TPM.txt', sep = '\t', stringsAsFactors = F, header = T, data.table = F) rownames(tcga_lihc) <- tcga_lihc$Tag tcga_lihc <- tcga_lihc[, -1] lihc_tmr_samples_index <- which(substr(colnames(tcga_lihc), 14, 16) == '01') tcga_lihc_log2 <- log2(tcga_lihc[, lihc_tmr_samples_index] + 1) tcga_lihc_cli <- read.delim('origin_datas/TCGA/Clinical BCR XML.merge.txt', header = T, stringsAsFactors = F) tcga_lihc_cli$A0_Samples <- paste0(tcga_lihc_cli$A0_Samples, '-01') tcga_lihc_cli <- tcga_lihc_cli[, c("A0_Samples", "A1_OS", "A2_Event", "A8_New_Event_Time", "A8_New_Event", "age_at_initial_pathologic_diagnosis", "A18_Sex", "A3_T", "A4_N", "A5_M", "A6_Stage", "A7_Grade")] colnames(tcga_lihc_cli) <- c("A0_Samples", "OS.time", "OS", "PFS.time", "PFS", "Age", "Gender", "A3_T", "A4_N", "A5_M", "Stage", "Grade") tcga_lihc_cli <- tcga_lihc_cli[!is.na(tcga_lihc_cli$OS.time), ] tcga_lihc_cli$OS <- ifelse(tcga_lihc_cli$OS == 'Alive', 0, 1) tcga_lihc_cli$A3_T <- gsub('[ab]', '', tcga_lihc_cli$A3_T) tcga_lihc_cli$A3_T[tcga_lihc_cli$A3_T == ''] <- 'TX' tcga_lihc_cli$A4_N[tcga_lihc_cli$A4_N == ''] <- 'NX' tcga_lihc_cli$Stage <- gsub('[ABC]', '', tcga_lihc_cli$Stage) tcga_lihc_cli$Stage <- gsub('Stage ', '', tcga_lihc_cli$Stage) tcga_lihc_cli$Stage[tcga_lihc_cli$Stage == ''] <- 'X' tcga_lihc_cli$Grade[tcga_lihc_cli$Grade == 'Not Available'] <- 'GX' rownames(tcga_lihc_cli) <- tcga_lihc_cli$A0_Samples table(tcga_lihc_cli$Grade) tcga_lihc_cli_os <- tcga_lihc_cli[!is.na(tcga_lihc_cli[, 2]) & !is.na(tcga_lihc_cli[, 3]) & tcga_lihc_cli[, 2] > 0, ] tmr_samples <- intersect(tcga_lihc_cli_os$A0_Samples, colnames(tcga_lihc_log2)) TME_genes <- intersect(rownames(tcga_lihc_log2), TME_new_genes) tcga_lihc_cli_os <- tcga_lihc_cli_os[tmr_samples, ] tcga_lihc_tpm_log2 <- t(tcga_lihc_log2[TME_genes, tmr_samples]) length(TME_genes) write.table(TME_genes, file = 'files/TME_genes.txt', sep = '\t', row.names = F, col.names = F, quote = F) write.table(TME_genes, file = 'files/TME_genes.txt', sep = '\t', quote = F, row.names = F, col.names = F) TCGA_TME_genes.cox <- t(apply(tcga_lihc_tpm_log2, 2, function(x){ vl=as.numeric(x) tm=tcga_lihc_cli_os$OS.time ev=tcga_lihc_cli_os$OS dat=data.frame(tm,ev,vl)[which(tm>0&!is.na(vl)),] return(coxFun(dat)) })) colnames(TCGA_TME_genes.cox)=c('p.value','HR','Low 95%CI','High 95%CI') TCGA_TME_genes.cox <- crbind2DataFrame(TCGA_TME_genes.cox) table(TCGA_TME_genes.cox$p.value < 0.001) TCGA_TME_genes.cox <- na.omit(TCGA_TME_genes.cox) TCGA_TME_genes.cox.filter <- TCGA_TME_genes.cox[TCGA_TME_genes.cox$p.value < 0.001, ] sig_gene1 <- rownames(TCGA_TME_genes.cox.filter) write.table(TCGA_TME_genes.cox.filter,"files/tcga_TME_genes.cox.filtered.txt",quote=F,sep="\t") library(NMF) tcga_nmf <- nmf(t(tcga_lihc_tpm_log2[, sig_gene1]),2:10,nrun=50,seed=12345) pdf('PDFs/tcga_NMF-1.pdf',width = 8,height = 6) plot(tcga_nmf) dev.off() consensusmap(tcga_nmf,labCol=NA,labRow=NA,tracks=NA) retrive_cluster_names <- function(myd,myd_consensusmap,hvalue){ sample_names<-rownames(myd) myd_cut_list<-lapply(cut(myd_consensusmap$Colv,hvalue)$lower, function(l)rapply(l,function(i)i)) cluster_sample_names<-c() tmp_cluster<-c() c_index<- 1 for(i in myd_cut_list){ cluster_sample_names<-c(cluster_sample_names,as.character(sample_names[unlist(i)])) tmp_cluster<-c(tmp_cluster,rep(paste("C",c_index,sep=""),length(unlist(i)))) c_index<-c_index+1 } cluster_df<-data.frame("Sample"=cluster_sample_names,"Cluster"=tmp_cluster) return(cluster_df); } tcga_nmf_2 <- nmf(t(tcga_lihc_tpm_log2[, sig_gene1]), 2, nrun=50, seed=12345) #pdf('PDFs/tcga_NMF-2.pdf',width = 6,height = 6) #tcga_nmf_2_consensusmap <- consensusmap(tcga_nmf_2, # labCol=NA, # labRow=NA, # tracks=NA) #dev.off() #tcga_nmf_2_cluster <- retrive_cluster_names(tcga_lihc_tpm_log2, # tcga_nmf_2_consensusmap, # 0.9) #table(tcga_nmf_2_cluster$Cluster) #colnames(tcga_nmf_2_cluster)<-c("Sample","Cluster") #rownames(tcga_nmf_2_cluster) <- tcga_nmf_2_cluster[,1] #tcga_cli_nmf <- merge(tcga_lihc_cli_os, tcga_nmf_2_cluster, # by.x = 'A0_Samples', by.y = 'Sample') #tcga_NMF_OS <- data.frame(tcga_cli_nmf$OS.time, # tcga_cli_nmf$OS, # tcga_cli_nmf$Cluster) #tcga_NMF_OS <- na.omit(tcga_NMF_OS) #pdf('PDFs/tcga_NMF_KM-3.pdf',width = 5,height = 5) #ggplotKMCox(tcga_NMF_OS, # labs = c('C1', 'C2')) #dev.off() #library(pheatmap) #annotation_col <- data.frame(Cluster = factor(tcga_nmf_2_cluster$Cluster)) #rownames(annotation_col) <- tcga_nmf_2_cluster$Sample #tcga_NMF_KM_heatmap_data <- t(tcga_lihc_tpm_log2[tcga_nmf_2_cluster$Sample, sig_gene1]) #bk=unique(c(seq(-1.5, 1.5, length=100))) #pdf('PDFs/tcga_NMF_KM_heatmap-4.pdf',width = 6,height = 6) #pheatmap(tcga_NMF_KM_heatmap_data, # scale = 'row', # breaks = bk, # annotation_col = annotation_col, # cluster_cols = F, cluster_rows = F, # show_rownames = F, show_colnames = F, # gaps_col = 149, # cellwidth = 0.8, cellheight = 0.4, # color = colorRampPalette(c("navy", "white", "firebrick3"))(100) # ) #dev.off() immu_scores <- immu_estimate(tcga_lihc_log2[, tcga_nmf_2_cluster$Sample], isTCGA=T, platform='illumina') immu_scores1 <- as.data.frame(immu_scores) immu_scores1$samples <- rownames(immu_scores1) immu_scores1 <- merge(tcga_cli_nmf, immu_scores1, by.x = 'A0_Samples', by.y = 'samples') StromalScore <- data.frame(immu_scores1[,c("Cluster", "StromalScore")]) mg_violin(StromalScore, melt=TRUE, ylab='StromalScore', leg.title='StromalScore', test_method='other', legend.pos='tl') ImmuneScore <- data.frame(immu_scores1[,c("Cluster", "ImmuneScore")]) mg_violin(ImmuneScore, melt=TRUE, ylab='ImmuneScore', leg.title='ImmuneScore', test_method='other', legend.pos='tl') ESTIMATEScore <- data.frame(immu_scores1[,c("Cluster", "ESTIMATEScore")]) mg_violin(ESTIMATEScore, melt=TRUE, ylab='ESTIMATEScore', leg.title='ESTIMATEScore', test_method='other', legend.pos='tl') immu_scores_estimate <- ggpubr::ggarrange(mg_violin(StromalScore, melt=TRUE, ylab='StromalScore', leg.title='StromalScore', test_method='other', legend.pos='bl'), mg_violin(ImmuneScore, melt=TRUE, ylab='ImmuneScore', leg.title='ImmuneScore', test_method='other', legend.pos='bl'), mg_violin(ESTIMATEScore, melt=TRUE, ylab='ESTIMATEScore', leg.title='ESTIMATEScore', test_method='other', legend.pos='bl'), ncol = 3,nrow = 1, labels = toupper(letters)[1:3], align = "hv") immu_scores_estimate ggsave(plot = immu_scores_estimate, filename = 'PDFs/immu_scores_estimate.pdf', width = 12, height = 4, device = cairo_pdf) MCPCounter_score <- immu_MCPcounter(tcga_lihc_log2[, tcga_nmf_2_cluster$Sample]) MCPCounter_score <- log2(MCPCounter_score + 1) MCPCounter_score <- crbind2DataFrame(MCPCounter_score) MCPCounter_score$samples <- rownames(MCPCounter_score) tcga_MCPCounter_score <- merge(tcga_cli_nmf, MCPCounter_score, by.x = 'A0_Samples', by.y = 'samples') rownames(tcga_MCPCounter_score) <- tcga_MCPCounter_score$A0_Samples T_cells <- data.frame(tcga_MCPCounter_score[,c("Cluster", "T cells")]) mg_violin(T_cells, melt=TRUE, ylab='Immune Cell', leg.title='T cells', test_method='other', legend.pos='tl') CD8_T_cells <- data.frame(tcga_MCPCounter_score[,c("Cluster", "CD8 T cells")]) mg_violin(CD8_T_cells, melt=TRUE, ylab='Immune Cell', leg.title='CD8 T cells', test_method='other', legend.pos='tl') Cytotoxic_lymphocytes <- data.frame(tcga_MCPCounter_score[,c("Cluster", "Cytotoxic lymphocytes")]) mg_violin(Cytotoxic_lymphocytes, melt=TRUE, ylab='Immune Cell', leg.title='Cytotoxic lymphocytes', test_method='other', legend.pos='tl') B_lineage <- data.frame(tcga_MCPCounter_score[,c("Cluster", "B lineage")]) mg_violin(B_lineage, melt=TRUE, ylab='Immune Cell', leg.title='B lineage', test_method='other', legend.pos='tr') Monocytic_lineage <- data.frame(tcga_MCPCounter_score[,c("Cluster", "Monocytic lineage")]) mg_violin(Monocytic_lineage, melt=TRUE, ylab='Immune Cell', leg.title='Monocytic lineage', test_method='other', legend.pos='bl') Myeloid_dendritic_cells <- data.frame(tcga_MCPCounter_score[,c("Cluster", "Myeloid dendritic cells")]) mg_violin(Myeloid_dendritic_cells, melt=TRUE, ylab='Immune Cell', leg.title='Myeloid dendritic cells', test_method='other', legend.pos='tl') Neutrophils <- data.frame(tcga_MCPCounter_score[,c("Cluster", "Neutrophils")]) mg_violin(Neutrophils, melt=TRUE, ylab='Immune Cell', leg.title='Neutrophils', test_method='other', legend.pos='tl') Endothelial_cells <- data.frame(tcga_MCPCounter_score[,c("Cluster", "Endothelial cells")]) mg_violin(Endothelial_cells, melt=TRUE, ylab='Immune Cell', leg.title='Endothelial cells', test_method='other', legend.pos='tl') Fibroblasts <- data.frame(tcga_MCPCounter_score[,c("Cluster", "Fibroblasts")]) mg_violin(Fibroblasts, melt=TRUE, ylab='Immune Cell', leg.title='Fibroblasts', test_method='other', legend.pos='tl') write.table(tcga_MCPCounter_score, file = 'files/tcga_MCPCounter_score.txt', sep = '\t', row.names = F, quote = F) tcga_NMF_immune_MCPCounter <- ggpubr::ggarrange(mg_violin(CD8_T_cells, melt=TRUE, ylab='Immune Cell', xlab = 'CD8 T cells', leg.title='', test_method='other', legend.pos='bl'), mg_violin(Cytotoxic_lymphocytes, melt=TRUE, ylab='Immune Cell', xlab = 'Cytotoxic lymphocytes', leg.title='', test_method='other', legend.pos='bl'), mg_violin(B_lineage, melt=TRUE, ylab='Immune Cell', xlab = 'B lineage', leg.title='', test_method='other', legend.pos='bl'), mg_violin(Monocytic_lineage, melt=TRUE, ylab='Immune Cell', xlab = 'Monocytic lineage', leg.title='', test_method='other', legend.pos='bl'), mg_violin(Myeloid_dendritic_cells, melt=TRUE, ylab='Immune Cell', xlab = 'Myeloid dendritic cells', leg.title='', test_method='other', legend.pos='bl'), mg_violin(Neutrophils, melt=TRUE, ylab='Immune Cell', xlab = 'Neutrophils', leg.title='', test_method='other', legend.pos='bl'), mg_violin(Endothelial_cells, melt=TRUE, ylab='Immune Cell', xlab = 'Endothelial cells', leg.title='', test_method='other', legend.pos='bl'), mg_violin(Fibroblasts, melt=TRUE, ylab='Immune Cell', xlab = 'Fibroblasts', leg.title='', test_method='other', legend.pos='bl'), mg_violin(T_cells, melt=TRUE, ylab='Immune Cell', xlab = 'T cells', leg.title='', test_method='other', legend.pos='bl'), ncol = 3,nrow = 3, labels = toupper(letters)[1:9],align = "hv") tcga_NMF_immune_MCPCounter ggsave(plot = tcga_NMF_immune_MCPCounter, filename = 'PDFs/tcga_NMF_immune_MCPCounter.pdf', width = 12, height = 12, device = cairo_pdf) library(TCGAbiolinks) other_subtype <- TCGAquery_subtype(tumor = "lihc") table(other_subtype$`Hepatitis C`) table(other_subtype$`Hepatitis B`) library(dplyr) write.table(tcga_nmf_2_cluster, file = 'files/GSEA/gsea_groups.txt', sep = '\t', row.names = F, quote = F) tcga_gsae_data <- tcga_lihc[protein_genes, tcga_nmf_2_cluster$Sample] tcga_gsae_data <- tcga_gsae_data[which(apply(tcga_gsae_data,1,function(x){return(sum(x>=0.5))})>0.5*ncol(tcga_gsae_data)),] tcga_gsae_data <- log2(tcga_gsae_data + 1) boxplot(tcga_gsae_data) write.table(tcga_gsae_data, file = 'files/GSEA/tcga_gsae_data.txt', sep = '\t', quote = F) mg_RunGSEA(mod = 'exp_group',exp_Path = 'files/GSEA/tcga_gsae_data.txt' ,sample_group_path = 'files/GSEA/gsea_groups.txt' ,outFolder = 'files/GSEA/results/' ,gmt_Path = 'KEGG',outLog=T) gsea.result.folder='files/GSEA/results/my_analysis.Gsea.1585203474711/' tcga_GSEA=parseGSEAResult(gsea.result.folder) dim(tcga_GSEA$EnrichTable) tcga_GSEA_EnrichTable <- as.data.frame(tcga_GSEA$EnrichTable) library(dplyr) write.table(tcga_GSEA_EnrichTable, file = 'GSEA_KEGG_results.txt', sep = '\t', row.names = F, quote = F) gs.p1 <- plot_GSEA_By_node(tcga_GSEA,TermName = 'KEGG_FATTY_ACID_METABOLISM') gs.p1 library(limma) group_list <- factor(tcga_nmf_2_cluster$Cluster) design <- model.matrix(~group_list) fit <- lmFit(tcga_gsae_data, design) fit <- eBayes(fit) options(digits = 4) topTable(fit,coef=2,adjust='BH') deg <- topTable(fit,coef=2,adjust='BH',number = Inf) deg$genes <- rownames(deg) deg$logFC <- -deg$logFC exp_diff_genes <- deg[abs(deg$logFC) > 1 & deg$adj.P.Val < 0.05, ] write.table(exp_diff_genes, file = 'files/exp_limma_diff_genes.txt', sep = '\t', quote = F) exp_diff_genes_up <- rownames(exp_diff_genes[exp_diff_genes$logFC > 0, ]) exp_diff_genes_dn <- rownames(exp_diff_genes[exp_diff_genes$logFC < 0, ]) length(exp_diff_genes_up) length(exp_diff_genes_dn) library(pheatmap) annotation_col <- data.frame(Cluster = factor(tcga_nmf_2_cluster$Cluster)) rownames(annotation_col) <- tcga_nmf_2_cluster$Sample tcga_NMF_diff_gene_heatmap_data <- tcga_gsae_data[c(exp_diff_genes_up, exp_diff_genes_dn), ] bk=unique(c(seq(-1.5, 1.5, length=100))) pdf('PDFs/tcga_NMF_diff_gene_heatmap.pdf',width = 6,height = 6) pheatmap(tcga_NMF_diff_gene_heatmap_data, scale = 'row', breaks = bk, annotation_col = annotation_col, cluster_cols = F, cluster_rows = F, show_rownames = F, show_colnames = F, gaps_col = 149, cellwidth = 0.8, ccellheight = 0.35, color = colorRampPalette(c("navy", "white", "firebrick3"))(100) ) dev.off() library(pheatmap) deg$tmp <- NA which(deg$genes == 'LDHA') deg$tmp[which(deg$genes == 'LDHA')] <- 'LDHA' deg$tmp[which(deg$genes == 'PPAT')] <- 'PPAT' deg$tmp[which(deg$genes == 'BFSP1')] <- 'BFSP1' deg$tmp[which(deg$genes == 'NR0B1')] <- 'NR0B1' deg$tmp[which(deg$genes == 'PFKFB4')] <- 'PFKFB4' tcga_NMF_diff_gene_volcano_data <- mg_volcano(deg$logFC, deg$adj.P.Val, symbol=deg$genes, showText=c('LDHA','PPAT','BFSP1','NR0B1','PFKFB4'), cutFC=1, cutPvalue=0.05, legend.pos='tl', ylab='-log10(FDR)', xlab='log2(FC)' ) tcga_NMF_diff_gene_volcano_data ggsave(plot = tcga_NMF_diff_gene_volcano_data, filename = 'PDFs/tcga_NMF_diff_gene_volcano.pdf', width = 5, height = 5, device = cairo_pdf) exp_diff_genes_up_res <- enrichmentORA(exp_diff_genes_up, mp_dbs=c('pathway_KEGG', 'geneontology_Biological_Process', 'geneontology_Cellular_Component', 'geneontology_Molecular_Function')) exp_diff_genes_up_res_filtered <- exp_diff_genes_up_res[exp_diff_genes_up_res$FDR < 0.05, ] table(exp_diff_genes_up_res_filtered$DB) pdf('PDFs/exp_diff_genes_up_GO_KEGG.pdf', width = 10, height = 8) dotplot_batch(exp_diff_genes_up_res_filtered, dbs =c('geneontology_Biological_Process', 'geneontology_Cellular_Component', 'geneontology_Molecular_Function', 'pathway_KEGG'),top=10) dev.off() write.table(exp_diff_genes_up_res_filtered, file = 'files/exp_diff_genes_up_res_filtered_GO_KEGG.txt', sep = '\t', row.names = F, quote = F) exp_diff_genes_dn_res <- enrichmentORA(exp_diff_genes_dn, mp_dbs=c('pathway_KEGG', 'geneontology_Biological_Process', 'geneontology_Cellular_Component', 'geneontology_Molecular_Function')) exp_diff_genes_dn_res_filtered <- exp_diff_genes_dn_res[exp_diff_genes_dn_res$FDR < 0.05, ] table(exp_diff_genes_dn_res_filtered$DB) exp_diff_genes_dn_res_filtered <- exp_diff_genes_dn_res_filtered[-7, ] pdf('PDFs/exp_diff_genes_dn_GO_KEGG.pdf', width = 18, height = 8) dotplot_batch(exp_diff_genes_dn_res_filtered, dbs =c('geneontology_Biological_Process', 'geneontology_Cellular_Component', 'geneontology_Molecular_Function', 'pathway_KEGG'),top=10) dev.off() write.table(exp_diff_genes_dn_res_filtered, file = 'files/exp_diff_genes_dn_res_filtered_GO_KEGG.txt', sep = '\t', row.names = F, quote = F) intersect(rownames(tcga_lihc_log2), genes) save.image('LIHC_TME_001.RData') TCGA_model_data_cli <- tcga_cli_nmf[, c("A0_Samples", "OS.time", "OS")] rownames(TCGA_model_data_cli) <- TCGA_model_data_cli$A0_Samples TCGA_model_data_exp <- t(tcga_lihc_log2[c(exp_diff_genes_up, exp_diff_genes_dn), TCGA_model_data_cli$A0_Samples]) TCGA_model_data <- cbind(TCGA_model_data_cli, TCGA_model_data_exp) TCGA_model_data <- TCGA_model_data[, -1] colnames(TCGA_model_data) <- gsub('-', '__', colnames(TCGA_model_data)) TCGA_model_data <- crbind2DataFrame(TCGA_model_data) TCGA_model_data <- na.omit(TCGA_model_data) GSE14520 <- getGEOExpData('GSE14520') GSE14520_cli <- read.delim('origin_datas/GSE14520/GSE14520_Extra_Supplement.txt', header = T, stringsAsFactors = F, check.names = F) GSE14520_cli <- GSE14520_cli[GSE14520_cli$`Tissue Type` == 'Tumor', ] GSE14520_cli <- GSE14520_cli[, c('Affy_GSM', "Gender", "Age", "TNM staging", "Survival months", "Survival status", "Recurr months", "Recurr status")] colnames(GSE14520_cli) <- c('samples', 'Gender', 'Age', 'Stage', 'OS.time', 'OS', 'RFS.time', 'RFS') GSE14520_cli$Stage <- gsub('[ABC]', '', GSE14520_cli$Stage) GSE14520_cli$OS.time <- GSE14520_cli$OS.time * 30 GSE14520_cli$RFS.time <- GSE14520_cli$RFS.time * 30 GSE14520_cli <- na.omit(GSE14520_cli) rownames(GSE14520_cli) <- GSE14520_cli$samples GSE14520_exp <- exp_probe2symbol_v2(GSE14520$Exp$GPL3921_22268_Data_col2, GSE14520$Anno$GPL3921[,c(1,11)]) GSE14520_tmr_samples <- intersect(GSE14520_cli$samples, colnames(GSE14520_exp)) GSE14520_exp <- t(GSE14520_exp[, GSE14520_tmr_samples]) boxplot(t(GSE14520_exp)) GSE14520_cli <- GSE14520_cli[GSE14520_tmr_samples, ] GSE14520_cli$samples GSE14520_model_data <- cbind(GSE14520_cli[, c("OS.time", "OS")], GSE14520_exp) colnames(GSE14520_model_data) <- gsub('-', '__', colnames(GSE14520_model_data)) library(stringr) hccdb18_type <- read.delim('origin_datas/HCCDB18/HCCDB18.sample.txt', check.names = F, header = F, stringsAsFactors = F, row.names = 1) hccdb18_type <- t(hccdb18_type) hccdb18_type <- crbind2DataFrame(hccdb18_type) hccdb18_type <- hccdb18_type[hccdb18_type$TYPE == 'HCC', ] hccdb18_type$cancer <- sapply(str_split(hccdb18_type$SAMPLE_NAME1, "_"),"[",2) hccdb18_type$SAMPLE <- sapply(str_split(hccdb18_type$SAMPLE_NAME1, "_"),"[",1) hccdb18_type <- hccdb18_type[hccdb18_type$cancer == 'Cancer', ] rownames(hccdb18_type) <- hccdb18_type$SAMPLE hccdb18_cli <- read.delim('origin_datas/HCCDB18/HCCDB18.patient.txt', check.names = F, header = T, stringsAsFactors = F, row.names = 1) hccdb18_cli <- t(hccdb18_cli) hccdb18_cli <- crbind2DataFrame(hccdb18_cli) hccdb18_cli <- hccdb18_cli[, c("PATIENT1", "SUR", "STATUS")] colnames(hccdb18_cli) <- c("samples", "OS.time", "OS") rownames(hccdb18_cli) <- hccdb18_cli$samples hccdb18_cli$OS.time <- hccdb18_cli$OS.time * 30 table(hccdb18_cli$OS) hccdb18_cli$OS <- ifelse(hccdb18_cli$OS == 'Alive', 0, 1) hccdc_com_sam <- intersect(rownames(hccdb18_cli), rownames(hccdb18_type)) hccdb18_type <- hccdb18_type[hccdc_com_sam, ] hccdb18_cli <- hccdb18_cli[hccdc_com_sam, ] rownames(hccdb18_cli) <- hccdb18_type$SAMPLE_ID hccdb18_cli$samples <- rownames(hccdb18_cli) hccdb18_exp <- read.delim('origin_datas/HCCDB18/HCCDB18_mRNA_level3.txt', check.names = F, header = T, stringsAsFactors = F) rownames(hccdb18_exp) <- hccdb18_exp$Symbol hccdb18_exp <- hccdb18_exp[, -c(1,2)] intersect(colnames(hccdb18_exp), hccdb18_cli$samples) hccdb18_exp <- t(hccdb18_exp[, hccdb18_cli$samples]) boxplot(t(hccdb18_exp)) rownames(hccdb18_exp) rownames(hccdb18_cli) HCCDB18_model_data <- cbind(hccdb18_cli, hccdb18_exp) colnames(HCCDB18_model_data) <- gsub('-', '__', colnames(HCCDB18_model_data)) GSE76427 <- getGEOExpData('GSE76427') GSE76427_cli <- GSE76427$Sample table(GSE76427_cli$Source) GSE76427_cli <- GSE76427_cli[GSE76427_cli$Source == 'hepatocellular carcinoma tumor tissue', ] GSE76427_cli <- GSE76427_cli[, c("Acc", "duryears_os", "event_os", "duryears_rfs", "event_rfs")] colnames(GSE76427_cli) <- c('Samples', 'OS.time', 'OS', 'RFS.time', 'RFS') GSE76427_cli <- crbind2DataFrame(GSE76427_cli) GSE76427_cli$OS.time <- GSE76427_cli$OS.time * 365 GSE76427_cli$RFS.time <- GSE76427_cli$RFS.time * 365 rownames(GSE76427_cli) <- GSE76427_cli$Samples GSE76427_exp <- exp_probe2symbol_v2(GSE76427$Exp$GPL10558_47322_Data_col2, GSE76427$Anno$GPL10558[,c(1,6)]) GSE76427_exp <- t(GSE76427_exp[, GSE76427_cli$Samples]) GSE76427_exp <- log2(GSE76427_exp + 1) GSE76427_model_data <- cbind(GSE76427_cli[, c("OS.time", "OS")], GSE76427_exp) colnames(GSE76427_model_data) <- gsub('-', '__', colnames(GSE76427_model_data)) save.image('LIHC_TME_002.RData') coxFun <- function(dat){ library(survival) colnames(dat)=c('time','status','gene') fmla=as.formula("Surv(time,status)~gene") cox=coxph(fmla,data=dat) p=summary(cox)[[7]][5] result=c(p,summary(cox)[[8]][1],summary(cox)[[8]][3],summary(cox)[[8]][4]) return(result) } plotKMCox_1=function(dat,n){ library(survival) library(ggsci) mypal = pal_jama(alpha = 0.7)(7) colnames(dat)=c('time','status','groups') sdf<-survdiff(Surv(time,status) ~ groups,data=dat) #print((sdf)) p<-pchisq(sdf$chisq,length(sdf$n)-1,lower.tail=FALSE) sf<-survfit(Surv(time,status) ~ groups,data=dat) colKm=c(mypal[2],mypal[1],mypal[3],mypal[4]) plot(sf, mark.time = TRUE,col=colKm,xlab=paste("Survival time in day","\np=",round(p,5)),ylab = "Survival probabilities",main=n) legend('topright',paste0(gsub('groups=','',names(sf$strata)),'(N=',sdf$n,')'), col = colKm, lty = c(1,1, 1, 1),lwd=c(1,1,1,1),merge = TRUE,cex = 0.8) return(p) } myd_exp_resampling <- select_gene_zscore(TCGA_model_data, dat2 = GSE14520_model_data, dat3 = HCCDB18_model_data, a = 101, n = 1000, ratio = 0.6, cut_p = 0.05, years = c(1,3,5)) myd_exp_resampling[[1]] save(myd_exp_resampling, file = 'new_resampling_101-1000_0.6-0.05.RData') write.table(myd_exp_resampling[[1]], file = 'files/new_OS_resampling_101-1000_0.6-0.05.csv', sep = ',', quote = F, row.names = F) num <- 443 tra.samples <- rownames(read.delim(paste0('files/model_select/tra.dat_zscore_',num,'.txt'), header = T, row.names = 1, stringsAsFactors = F)) test.samples <- rownames(read.delim(paste0('files/model_select/test.dat_zscore_',num,'.txt'), header = T, row.names = 1, stringsAsFactors = F)) tra.data <- TCGA_model_data[tra.samples, ] test.data <- TCGA_model_data[test.samples, ] tra.cox <- t(apply(tra.data[,3:c(ncol(tra.data))],2,function(x){ vl=as.numeric(x) tm=tra.data$OS.time ev=tra.data$OS dat=data.frame(tm,ev,vl)[which(tm > 0 & !is.na(vl)),] return(coxFun(dat)) })) colnames(tra.cox)=c('p.value','HR','Low 95%CI','High 95%CI') length(which(tra.cox[,1]<0.05)) write.table(tra.cox,"files/tcga_OS_train_single_HR_TPM_pvalue_1.txt",quote=F,sep="\t") tra.cox <- na.omit(tra.cox) filter_genes <- rownames(tra.cox[tra.cox[,1]<0.05, ]) library(glmnet) set.seed(num) fit1=glmnet(as.matrix(tra.data[,filter_genes]) #,factor(samps) ,cbind(time=tra.data$OS.time, status=tra.data$OS) ,family="cox" #,family="binomial" #,type.measure="deviance" ,nlambda=100 , alpha=1) cv.fit<-cv.glmnet(as.matrix(tra.data[,filter_genes]) #,factor(samps) ,cbind(time=tra.data$OS.time, status=tra.data$OS) ,family="cox" #,family="binomial" #,type.measure="deviance" ,nlambda=100 , alpha=1) sig.coef <- coefficients(cv.fit,s=cv.fit$lambda.min)[which(coefficients(cv.fit,s=cv.fit$lambda.min)[,1]!=0),1] cv.fit$lambda.min pdf('PDFs/lasso.pdf',width = 10,height = 5) par(mfrow=c(1,2)) plot(fit1, xvar="lambda") plot(cv.fit) dev.off() tcga_dat1 <- cbind(time=tra.data$OS.time, status=tra.data$OS, tra.data[,names(sig.coef)]) fmla <- as.formula(paste0("Surv(time, status) ~" ,paste0(names(sig.coef),collapse = '+'))) cox <- coxph(fmla, data =as.data.frame(tcga_dat1)) cox1 <- step(cox, trace = 0) lan <- coef(cox1) round(lan, 3) genes <- names(cox1$coefficients) tra.cox[genes,] IMvigor210_lan <- lan match(names(IMvigor210_lan),colnames(IMvigor210_model_data)) IMvigor210_lan risk.IMvigor210=as.numeric(IMvigor210_lan%*%as.matrix(t(IMvigor210_model_data[,names(IMvigor210_lan)]))) risk.IMvigor210z=mosaic::zscore(risk.IMvigor210) cutoff <- 0 fit <- survivalROC::survivalROC(Stime = IMvigor210_model_data$OS.time, status = IMvigor210_model_data$OS, marker = risk.IMvigor210z, predict.time = 365*1.5, method = "KM") fit$AUC optimalCutoff1 <- fit$cut.values[which.max(fit$TP - fit$FP)] cutoff <- optimalCutoff1 ggplotKMCox(data.frame(IMvigor210_model_data$OS.time, IMvigor210_model_data$OS, ifelse(risk.IMvigor210z>=cutoff,'H','L'))) pdf('PDFs/tcga_signle_gene_KM_train.pdf',width = 9,height = 3) par(mfrow=c(1, 3)) for (a in genes) { dat=mosaic::zscore(tra.data[,a]) plotKMCox_1(data.frame(tra.data$OS.time,tra.data$OS,ifelse(dat>=0,'H','L')),a) } dev.off() risk.tr <- as.numeric(lan%*%as.matrix(t(tra.data[,genes]))) risk.trz <- mosaic::zscore(risk.tr) ggplotTimeROC(tra.data$OS.time, tra.data$OS, risk.trz) ggplotKMCox(data.frame(tra.data$OS.time, tra.data$OS, ifelse(risk.trz>=0,'H','L'))) risk.te=as.numeric(lan%*%as.matrix(t(test.data[,genes]))) risk.tez=mosaic::zscore(risk.te) ggplotTimeROC(test.data$OS.time, test.data$OS, risk.tez) ggplotKMCox(data.frame(test.data$OS.time, test.data$OS, ifelse(risk.tez>=0,'H','L'))) risk.all=as.numeric(lan%*%as.matrix(t(TCGA_model_data[,genes]))) risk.allz=mosaic::zscore(risk.all) ggplotTimeROC(TCGA_model_data$OS.time, TCGA_model_data$OS, risk.allz) ggplotKMCox(data.frame(TCGA_model_data$OS.time, TCGA_model_data$OS, ifelse(risk.allz>=0,'H','L'))) HCCDB18_lan <- lan # names(HCCDB18_lan) <- gsub('HILPDA','C7orf68',names(HCCDB18_lan)) match(names(HCCDB18_lan),colnames(HCCDB18_model_data)) HCCDB18_lan risk.geo=as.numeric(HCCDB18_lan%*%as.matrix(t(HCCDB18_model_data[,names(HCCDB18_lan)]))) risk.geoz=mosaic::zscore(risk.geo) ggplotTimeROC(HCCDB18_model_data$OS.time, HCCDB18_model_data$OS, risk.geoz) ggplotKMCox(data.frame(HCCDB18_model_data$OS.time, HCCDB18_model_data$OS, ifelse(risk.geoz>=0,'H','L'))) intersect(c('C7orf68'), colnames(GSE14520_model_data)) GSE14520_lan <- lan # names(GSE14520_lan) <- gsub('AOC1','ABP1',names(GSE14520_lan)) match(names(GSE14520_lan),colnames(GSE14520_model_data)) GSE14520_lan risk.geo2=as.numeric(GSE14520_lan%*%as.matrix(t(GSE14520_model_data[,names(GSE14520_lan)]))) risk.geoz2=mosaic::zscore(risk.geo2) ggplotTimeROC(GSE14520_model_data$OS.time, GSE14520_model_data$OS, risk.geoz2) ggplotKMCox(data.frame(GSE14520_model_data$OS.time, GSE14520_model_data$OS, ifelse(risk.geoz2>=0,'H','L'))) tcga_train <- plotCoxModel_Batch(risk.trz, tra.data[,match(genes, colnames(tra.data))], tra.data$OS.time, tra.data$OS, cutoff = 0, # mks = c(365*1,365*3,365*5), ) tcga_train ggsave(plot = tcga_train, filename = 'PDFs/tcga_train_roc_km.pdf', width = 10, height = 8, device = cairo_pdf) ggsave(plot = tcga_train, filename = '售后/001/tcga_train_roc_km.pdf', width = 10, height = 8, device = cairo_pdf) tcga_test <- plotCoxModel_Batch(risk.tez, test.data[,match(genes, colnames(test.data))], test.data$OS.time, test.data$OS, cutoff = 0) tcga_test ggsave(plot = tcga_test, filename = 'PDFs/tcga_test_roc_km.pdf', width = 10, height = 8, device = cairo_pdf) ggsave(plot = tcga_test, filename = '售后/001/tcga_test_roc_km.pdf', width = 10, height = 8, device = cairo_pdf) tcga_all <- plotCoxModel_Batch(risk.allz, TCGA_model_data[,match(genes, colnames(TCGA_model_data))], TCGA_model_data$OS.time, TCGA_model_data$OS, cutoff = 0) tcga_all ggsave(plot = tcga_all, filename = 'PDFs/tcga_all_roc_km.pdf', width = 10, height = 8, device = cairo_pdf) ggsave(plot = tcga_all, filename = '售后/001/tcga_all_roc_km.pdf', width = 10, height = 8, device = cairo_pdf) GSE14520_all <- plotCoxModel_Batch(risk.geoz2, GSE14520_model_data[,match(names(GSE14520_lan), colnames(GSE14520_model_data))], GSE14520_model_data$OS.time, GSE14520_model_data$OS, cutoff = 0) GSE14520_all ggsave(plot = GSE14520_all, filename = 'PDFs/GSE14520_all_roc_km.pdf', width = 10, height = 8, device = cairo_pdf) ggsave(plot = GSE14520_all, filename = '售后/001/GSE14520_all_roc_km.pdf', width = 10, height = 8, device = cairo_pdf) tcga_cli_fea <- tcga_MCPCounter_score[rownames(TCGA_model_data), ] tcga_cli_fea$Status <- tcga_cli_fea$OS tcga_cli_fea$RiskScore <- risk.allz tcga_cli_fea$Groups <- ifelse(tcga_cli_fea$RiskScore >= 0, 'High', 'Low') age_km <- data.frame(time = as.numeric(tcga_cli_fea$OS.time), status = as.numeric(tcga_cli_fea$Status), Age = as.numeric(tcga_cli_fea$Age), groups = tcga_cli_fea$Groups) age_km2 <- age_km[age_km$Age > 60, ] age_km2 <- ggplotKMCox(data.frame(age_km2$time, age_km2$status, age_km2$groups), title = 'Age > 60', labs = c('High', 'Low')) age_km2 age_km3 <- age_km[age_km$Age <= 60, ] age_km3 <- ggplotKMCox(data.frame(age_km3$time, age_km3$status, age_km3$groups), title = 'Age ≤ 60', labs = c('High', 'Low')) age_km3 Gender_km <- data.frame(time = as.numeric(tcga_cli_fea$OS.time), status = as.numeric(tcga_cli_fea$Status), Gender = tcga_cli_fea$Gender, groups = tcga_cli_fea$Groups) Gender_km2 <- Gender_km[Gender_km$Gender == 'MALE', ] Gender_km2 <- ggplotKMCox(data.frame(Gender_km2$time, Gender_km2$status, Gender_km2$groups), title = 'Male', labs = c('High', 'Low')) Gender_km2 Gender_km3 <- Gender_km[Gender_km$Gender == 'FEMALE', ] Gender_km3 <- ggplotKMCox(data.frame(Gender_km3$time, Gender_km3$status, Gender_km3$groups), title = 'Female', labs = c('High', 'Low')) Gender_km3 A3_T_km <- data.frame(time = as.numeric(tcga_cli_fea$OS.time), status = as.numeric(tcga_cli_fea$Status), A3_T = tcga_cli_fea$A3_T, groups = tcga_cli_fea$Groups) A3_T_km2 <- A3_T_km[A3_T_km$A3_T == 'T1' | A3_T_km$A3_T == 'T2', ] A3_T_km2 <- ggplotKMCox(data.frame(A3_T_km2$time, A3_T_km2$status, A3_T_km2$groups), title = 'T1 + T2', labs = c('High', 'Low')) A3_T_km2 A3_T_km3 <- A3_T_km[A3_T_km$A3_T == 'T3' | A3_T_km$A3_T == 'T4', ] A3_T_km3 <- ggplotKMCox(data.frame(A3_T_km3$time, A3_T_km3$status, A3_T_km3$groups), title = 'T3 + T4', labs = c('High', 'Low')) A3_T_km3 A4_N_km <- data.frame(time = as.numeric(tcga_cli_fea$OS.time), status = as.numeric(tcga_cli_fea$Status), A4_N = tcga_cli_fea$A4_N, groups = tcga_cli_fea$Groups) A4_N_km2 <- A4_N_km[A4_N_km$A4_N == 'N0', ] A4_N_km2 <- ggplotKMCox(data.frame(A4_N_km2$time, A4_N_km2$status, A4_N_km2$groups), title = 'N0', labs = c('High', 'Low')) A4_N_km2 A5_M_km <- data.frame(time = as.numeric(tcga_cli_fea$OS.time), status = as.numeric(tcga_cli_fea$Status), A5_M = tcga_cli_fea$A5_M, groups = tcga_cli_fea$Groups) A5_M_km2 <- A5_M_km[A5_M_km$A5_M == 'M0', ] A5_M_km2 <- ggplotKMCox(data.frame(A5_M_km2$time, A5_M_km2$status, A5_M_km2$groups), title = 'M0', labs = c('High', 'Low')) A5_M_km2 Stage_km <- data.frame(time = as.numeric(tcga_cli_fea$OS.time), status = as.numeric(tcga_cli_fea$Status), Stage = tcga_cli_fea$Stage, groups = tcga_cli_fea$Groups) Stage_km2 <- Stage_km[Stage_km$Stage == 'I' | Stage_km$Stage == 'II', ] Stage_km2 <- ggplotKMCox(data.frame(Stage_km2$time, Stage_km2$status, Stage_km2$groups), title = 'I + II', labs = c('High', 'Low')) Stage_km2 Stage_km3 <- Stage_km[Stage_km$Stage == 'III' | Stage_km$Stage == 'IV', ] Stage_km3 <- ggplotKMCox(data.frame(Stage_km3$time, Stage_km3$status, Stage_km3$groups), title = 'III + IV', labs = c('High', 'Low')) Stage_km3 Grade_km <- data.frame(time = as.numeric(tcga_cli_fea$OS.time), status = as.numeric(tcga_cli_fea$Status), Grade = tcga_cli_fea$Grade, groups = tcga_cli_fea$Groups) Grade_km2 <- Grade_km[Grade_km$Grade == 'G1' | Grade_km$Grade == 'G2', ] Grade_km2 <- ggplotKMCox(data.frame(Grade_km2$time, Grade_km2$status, Grade_km2$groups), title = 'G1 + G2', labs = c('High', 'Low')) Grade_km2 Grade_km3 <- Grade_km[Grade_km$Grade == 'G3' | Grade_km$Grade == 'G4', ] Grade_km3 <- ggplotKMCox(data.frame(Grade_km3$time, Grade_km3$status, Grade_km3$groups), title = 'G3 + G4', labs = c('High', 'Low')) Grade_km3 tcga_cli_km <- ggpubr::ggarrange(age_km2, age_km3, Gender_km2, Gender_km3, A3_T_km2, A3_T_km3, A4_N_km2, A5_M_km2, Stage_km2, Stage_km3, Grade_km2, Grade_km3, ncol = 4,nrow = 3, labels = toupper(letters)[1:12], align = "hv") tcga_cli_km ggsave(plot = tcga_cli_km, filename = 'PDFs/tcga_cli_km.pdf', width = 20, height = 15, device = cairo_pdf) library(maftools) maf.mutect <- read.maf(maf = 'Z:/TCGA/Matrix/mutect2/TCGA.LIHC.mutect.a630f0a0-39b3-4aab-8181-89c1dde8d3e2.DR-10.0.somatic.maf.gz') pdf('PDFs/TCGA-LIHC-mutect-plot.pdf', width = 10, height = 6) oncoplot(maf = maf.mutect, # colors = vc_cols, bgCol = "#FFFFFF", genes = c('TP53', 'PIK3CA', 'RB1', 'CDKN2A', 'TSC2', 'CTNNB1', 'ARID2', 'AXIN1', 'RPS6KA3', 'ARID1A', 'KMT2D') ) dev.off() maf.cli.samples <- substr(getClinicalData(maf.mutect)$Tumor_Sample_Barcode, 1, 15) com_samples <- intersect(maf.cli.samples, tcga_cli_fea$A0_Samples) TP53 <- as.character(subsetMaf(maf = maf.mutect, genes = c('TP53'), mafObj = FALSE)$Tumor_Sample_Barcode) TP53 <- substr(TP53, 1, 15) TP53_samples <- intersect(TP53, com_samples) NO_TP53_samples <- setdiff(com_samples, TP53_samples) TP53_Mutant <- c(rep('YES', length(TP53_samples)), rep('NO', length(NO_TP53_samples))) TP53_Mutant <- data.frame(cbind(sample = c(TP53_samples, NO_TP53_samples), TP53_Mutant)) tcga_cluster_mut <- merge(tcga_cli_fea, TP53_Mutant, by.x = 'A0_Samples', by.y = 'sample', all = TRUE) CTNNB1 <- as.character(subsetMaf(maf = maf.mutect, genes = c('CTNNB1'), mafObj = FALSE)$Tumor_Sample_Barcode) CTNNB1 <- substr(CTNNB1, 1, 15) CTNNB1_samples <- intersect(CTNNB1, com_samples) NO_CTNNB1_samples <- setdiff(com_samples, CTNNB1_samples) CTNNB1_Mutant <- c(rep('YES', length(CTNNB1_samples)), rep('NO', length(NO_CTNNB1_samples))) CTNNB1_Mutant <- data.frame(cbind(sample = c(CTNNB1_samples, NO_CTNNB1_samples), CTNNB1_Mutant)) tcga_cluster_mut <- merge(tcga_cluster_mut, CTNNB1_Mutant, by.x = 'A0_Samples', by.y = 'sample', all = TRUE) AXIN1 <- as.character(subsetMaf(maf = maf.mutect, genes = c('AXIN1'), mafObj = FALSE)$Tumor_Sample_Barcode) AXIN1 <- substr(AXIN1, 1, 15) AXIN1_samples <- intersect(AXIN1, com_samples) NO_AXIN1_samples <- setdiff(com_samples, AXIN1_samples) AXIN1_Mutant <- c(rep('YES', length(AXIN1_samples)), rep('NO', length(NO_AXIN1_samples))) AXIN1_Mutant <- data.frame(cbind(sample = c(AXIN1_samples, NO_AXIN1_samples), AXIN1_Mutant)) tcga_cluster_mut <- merge(tcga_cluster_mut, AXIN1_Mutant, by.x = 'A0_Samples', by.y = 'sample', all = TRUE) ARID1A <- as.character(subsetMaf(maf = maf.mutect, genes = c('ARID1A'), mafObj = FALSE)$Tumor_Sample_Barcode) ARID1A <- substr(ARID1A, 1, 15) ARID1A_samples <- intersect(ARID1A, com_samples) NO_ARID1A_samples <- setdiff(com_samples, ARID1A_samples) ARID1A_Mutant <- c(rep('YES', length(ARID1A_samples)), rep('NO', length(NO_ARID1A_samples))) ARID1A_Mutant <- data.frame(cbind(sample = c(ARID1A_samples, NO_ARID1A_samples), ARID1A_Mutant)) tcga_cluster_mut <- merge(tcga_cluster_mut, ARID1A_Mutant, by.x = 'A0_Samples', by.y = 'sample', all = TRUE) table(tcga_cluster_mut$TP53_Mutant) TP53_Mutant_km <- data.frame(time = as.numeric(tcga_cluster_mut$OS.time), status = as.numeric(tcga_cluster_mut$Status), TP53_Mutant = tcga_cluster_mut$TP53_Mutant, groups = tcga_cluster_mut$Groups) TP53_Mutant_km2 <- TP53_Mutant_km[TP53_Mutant_km$TP53_Mutant == 'YES', ] TP53_Mutant_km2 <- ggplotKMCox(data.frame(TP53_Mutant_km2$time, TP53_Mutant_km2$status, TP53_Mutant_km2$groups), title = 'TP53 YES', labs = c('High', 'Low')) TP53_Mutant_km2 TP53_Mutant_km3 <- TP53_Mutant_km[TP53_Mutant_km$TP53_Mutant == 'NO', ] TP53_Mutant_km3 <- ggplotKMCox(data.frame(TP53_Mutant_km3$time, TP53_Mutant_km3$status, TP53_Mutant_km3$groups), title = 'TP53 NO', labs = c('High', 'Low')) TP53_Mutant_km3 CTNNB1_Mutant_km <- data.frame(time = as.numeric(tcga_cluster_mut$OS.time), status = as.numeric(tcga_cluster_mut$Status), CTNNB1_Mutant = tcga_cluster_mut$CTNNB1_Mutant, groups = tcga_cluster_mut$Groups) CTNNB1_Mutant_km2 <- CTNNB1_Mutant_km[CTNNB1_Mutant_km$CTNNB1_Mutant == 'YES', ] CTNNB1_Mutant_km2 <- ggplotKMCox(data.frame(CTNNB1_Mutant_km2$time, CTNNB1_Mutant_km2$status, CTNNB1_Mutant_km2$groups), title = 'CTNNB1 YES', labs = c('High', 'Low')) CTNNB1_Mutant_km2 CTNNB1_Mutant_km3 <- CTNNB1_Mutant_km[CTNNB1_Mutant_km$CTNNB1_Mutant == 'NO', ] CTNNB1_Mutant_km3 <- ggplotKMCox(data.frame(CTNNB1_Mutant_km3$time, CTNNB1_Mutant_km3$status, CTNNB1_Mutant_km3$groups), title = 'CTNNB1 NO', labs = c('High', 'Low')) CTNNB1_Mutant_km3 AXIN1_Mutant_km <- data.frame(time = as.numeric(tcga_cluster_mut$OS.time), status = as.numeric(tcga_cluster_mut$Status), AXIN1_Mutant = tcga_cluster_mut$AXIN1_Mutant, groups = tcga_cluster_mut$Groups) AXIN1_Mutant_km2 <- AXIN1_Mutant_km[AXIN1_Mutant_km$AXIN1_Mutant == 'YES', ] AXIN1_Mutant_km2 <- ggplotKMCox(data.frame(AXIN1_Mutant_km2$time, AXIN1_Mutant_km2$status, AXIN1_Mutant_km2$groups), title = 'AXIN1 YES', labs = c('High', 'Low')) AXIN1_Mutant_km2 AXIN1_Mutant_km3 <- AXIN1_Mutant_km[AXIN1_Mutant_km$AXIN1_Mutant == 'NO', ] AXIN1_Mutant_km3 <- ggplotKMCox(data.frame(AXIN1_Mutant_km3$time, AXIN1_Mutant_km3$status, AXIN1_Mutant_km3$groups), title = 'AXIN1 NO', labs = c('High', 'Low')) AXIN1_Mutant_km3 ARID1A_Mutant_km <- data.frame(time = as.numeric(tcga_cluster_mut$OS.time), status = as.numeric(tcga_cluster_mut$Status), ARID1A_Mutant = tcga_cluster_mut$ARID1A_Mutant, groups = tcga_cluster_mut$Groups) ARID1A_Mutant_km2 <- ARID1A_Mutant_km[ARID1A_Mutant_km$ARID1A_Mutant == 'YES', ] ARID1A_Mutant_km2 <- ggplotKMCox(data.frame(ARID1A_Mutant_km2$time, ARID1A_Mutant_km2$status, ARID1A_Mutant_km2$groups), title = 'ARID1A YES', labs = c('High', 'Low')) ARID1A_Mutant_km2 ARID1A_Mutant_km3 <- ARID1A_Mutant_km[ARID1A_Mutant_km$ARID1A_Mutant == 'NO', ] ARID1A_Mutant_km3 <- ggplotKMCox(data.frame(ARID1A_Mutant_km3$time, ARID1A_Mutant_km3$status, ARID1A_Mutant_km3$groups), title = 'ARID1A NO', labs = c('High', 'Low')) ARID1A_Mutant_km3 tcga_mut_km <- ggpubr::ggarrange(TP53_Mutant_km2, TP53_Mutant_km3, CTNNB1_Mutant_km2, CTNNB1_Mutant_km3, AXIN1_Mutant_km2, AXIN1_Mutant_km3, ARID1A_Mutant_km2, ARID1A_Mutant_km3, ncol = 4,nrow = 2, labels = toupper(letters)[1:8], align = "hv") tcga_mut_km ggsave(plot = tcga_mut_km, filename = 'PDFs/tcga_mut_km.pdf', width = 20, height = 10, device = cairo_pdf) RiskScore_Gender <- data.frame(tcga_cli_fea[, c("Gender", "RiskScore")]) Gender_violin_RiskScore <- mg_violin(RiskScore_Gender, melt=TRUE, ylab='RiskScore', leg.title='', test_method='other', xlab = 'Gender', legend.pos='bl', show_compare = F) Gender_violin_RiskScore RiskScore_Age <- data.frame(tcga_cli_fea[, c('Age', "RiskScore")]) RiskScore_Age <- na.omit(RiskScore_Age) median(RiskScore_Age$Age) RiskScore_Age$Age <- ifelse(RiskScore_Age$Age > 60, '>60', '≤60') Age_violin_RiskScore <- mg_violin(RiskScore_Age, melt=TRUE, ylab='RiskScore', leg.title='', test_method='wilcox', xlab = 'Age', legend.pos='bl', show_compare = F) Age_violin_RiskScore RiskScore_A3_T <- data.frame(tcga_cli_fea[, c('A3_T', "RiskScore")]) RiskScore_A3_T <- na.omit(RiskScore_A3_T) RiskScore_A3_T <- RiskScore_A3_T[which(RiskScore_A3_T$A3_T != 'TX'), ] A3_T_violin_RiskScore <- mg_violin(RiskScore_A3_T, melt=TRUE, ylab='RiskScore', leg.title='', test_method='rank', xlab = 'T Stage', legend.pos='br', show_compare = F) A3_T_violin_RiskScore RiskScore_A4_N <- data.frame(tcga_cli_fea[, c('A4_N', "RiskScore")]) RiskScore_A4_N <- na.omit(RiskScore_A4_N) RiskScore_A4_N <- RiskScore_A4_N[which(RiskScore_A4_N$A4_N != 'NX'), ] A4_N_violin_RiskScore <- mg_violin(RiskScore_A4_N, melt=TRUE, ylab='RiskScore', leg.title='', test_method='rank', xlab = 'N Stage', legend.pos='bl', show_compare = F) A4_N_violin_RiskScore RiskScore_A5_M <- data.frame(tcga_cli_fea[, c("A5_M", "RiskScore")]) RiskScore_A5_M <- na.omit(RiskScore_A5_M) RiskScore_A5_M <- RiskScore_A5_M[which(RiskScore_A5_M$A5_M != 'MX'), ] A5_M_violin_RiskScore <- mg_violin(RiskScore_A5_M, melt=TRUE, ylab='RiskScore', leg.title='', test_method='rank', xlab = 'M Stage', legend.pos='bl', show_compare = F) A5_M_violin_RiskScore RiskScore_A6_Stage <- data.frame(tcga_cli_fea[, c("Stage", "RiskScore")]) RiskScore_A6_Stage <- na.omit(RiskScore_A6_Stage) RiskScore_A6_Stage <- RiskScore_A6_Stage[which(RiskScore_A6_Stage$Stage != 'X'), ] A6_Stage_violin_RiskScore <- mg_violin(RiskScore_A6_Stage, melt=TRUE, ylab='RiskScore', leg.title='', test_method='rank', xlab = 'Stage', legend.pos='br', show_compare = F) A6_Stage_violin_RiskScore RiskScore_Grade <- data.frame(tcga_cli_fea[, c("Grade", "RiskScore")]) RiskScore_Grade <- na.omit(RiskScore_Grade) RiskScore_Grade <- RiskScore_Grade[which(RiskScore_Grade$Grade != 'GX'), ] Grade_violin_RiskScore <- mg_violin(RiskScore_Grade, melt=TRUE, ylab='RiskScore', leg.title='', test_method='rank', xlab = 'Grade', legend.pos='br', show_compare = F) Grade_violin_RiskScore tcga_cli_RiskScore <- ggpubr::ggarrange(A3_T_violin_RiskScore, A6_Stage_violin_RiskScore, Grade_violin_RiskScore, Gender_violin_RiskScore, Age_violin_RiskScore, ncol = 3,nrow = 2, labels = toupper(letters)[1:6], align = "hv") tcga_cli_RiskScore ggsave(plot = tcga_cli_RiskScore, filename = 'PDFs/tcga_cli_RiskScore.pdf', width = 15, height = 10, device = cairo_pdf) RiskScore_TP53 <- data.frame(tcga_cluster_mut[, c('TP53_Mutant', "RiskScore")]) RiskScore_TP53 <- na.omit(RiskScore_TP53) TP53_violin_RiskScore <- mg_violin(RiskScore_TP53, melt=TRUE, ylab='RiskScore', leg.title='', test_method='other', xlab = 'TP53', legend.pos='br', show_compare = F) TP53_violin_RiskScore RiskScore_CTNNB1 <- data.frame(tcga_cluster_mut[, c('CTNNB1_Mutant', "RiskScore")]) RiskScore_CTNNB1 <- na.omit(RiskScore_CTNNB1) CTNNB1_violin_RiskScore <- mg_violin(RiskScore_CTNNB1, melt=TRUE, ylab='RiskScore', leg.title='', test_method='other', xlab = 'CTNNB1', legend.pos='br', show_compare = F) CTNNB1_violin_RiskScore RiskScore_AXIN1 <- data.frame(tcga_cluster_mut[, c('AXIN1_Mutant', "RiskScore")]) RiskScore_AXIN1 <- na.omit(RiskScore_AXIN1) AXIN1_violin_RiskScore <- mg_violin(RiskScore_AXIN1, melt=TRUE, ylab='RiskScore', leg.title='', test_method='other', xlab = 'AXIN1', legend.pos='br', show_compare = F) AXIN1_violin_RiskScore RiskScore_ARID1A <- data.frame(tcga_cluster_mut[, c('ARID1A_Mutant', "RiskScore")]) RiskScore_ARID1A <- na.omit(RiskScore_ARID1A) ARID1A_violin_RiskScore <- mg_violin(RiskScore_ARID1A, melt=TRUE, ylab='RiskScore', leg.title='', test_method='other', xlab = 'ARID1A', legend.pos='br', show_compare = F) ARID1A_violin_RiskScore tcga_mut_RiskScore <- ggpubr::ggarrange(TP53_violin_RiskScore, CTNNB1_violin_RiskScore, AXIN1_violin_RiskScore, ARID1A_violin_RiskScore, ncol = 2,nrow = 2, labels = toupper(letters)[1:4], align = "hv") tcga_mut_RiskScore ggsave(plot = tcga_mut_RiskScore, filename = 'PDFs/tcga_mut_RiskScore.pdf', width = 10, height = 10, device = cairo_pdf) library('GSVA') library(GSEABase) c2KEGG <- getGmt("d:/public/GSEA/c2.cp.kegg.v7.0.symbols.gmt", collectionType=BroadCollection(category="c2"), geneIdType=SymbolIdentifier()) tcga_tpm_filter_1 <- tcga_lihc_log2[, rownames(TCGA_model_data)] ssGSEA <- gsva(as.matrix(tcga_tpm_filter_1), c2KEGG, method='ssgsea', min.sz=10, max.sz=500, verbose=TRUE) sort(-abs(cor(t(ssGSEA),(as.numeric(risk.allz)))))[1:20] write.table(ssGSEA,'files/ssGSEA.txt',sep = '\t',quote = F) write.table(cor(t(ssGSEA),risk.allz),'files/ssGSEA.cor.txt',sep = '\t',quote = F) sum(abs(cor(t(ssGSEA),(as.numeric(risk.allz))))>=0.45) pdf('PDFs/ssGSEA_cor.pdf',width = 10,height = 10) bk=unique(c(seq(-1.5,1.5, length=100))) pheatmap::pheatmap((ssGSEA[order(abs(cor(t(ssGSEA),(risk.allz))), decreasing=TRUE)[1:26],order(risk.allz)]), show_colnames = F, breaks = bk, cluster_cols = F, scale = 'row', cellheight = 10 ) dev.off() pdf('PDFs/ssGSEA_KEGG.pdf',width = 10,height = 10) data_p <- cbind(t(ssGSEA[which(abs(cor(t(ssGSEA),risk.allz))>=0.45),]),RiskScore=risk.allz) pheatmap::pheatmap(cor(data_p), show_colnames = F, cluster_cols = T, cluster_row = T, cellwidth = 10, cellheight = 10) dev.off() tcga_nomogram <- tcga_cli_fea[, c("A0_Samples", "OS.time", "OS","Age", "Gender", "A3_T", "A4_N", "A5_M", "Stage", "Grade", "RiskScore")] tcga_nomogram$Age_g <- ifelse(tcga_nomogram$Age > 60, '>60', '≤60') table(tcga_nomogram$Stage) tcga_nomogram$A3_T[tcga_nomogram$A3_T == 'TX'] <- '' tcga_nomogram$Stage[tcga_nomogram$Stage == 'X'] <- '' tcga_nomogram$Stage[tcga_nomogram$Stage == 'IV'] <- '' tcga_nomogram$Grade[tcga_nomogram$Grade == 'GX'] <- '' library(rms) ddist <- datadist(tcga_nomogram) options(datadist='ddist') alignment.cph <- cph(formula=Surv(OS.time, OS)~Age_g+Gender+A3_T+Grade+RiskScore, data=tcga_nomogram,surv=T) surv <- Survival(alignment.cph) surv1 <- function(x)surv(365*1,lp=x) surv2 <- function(x)surv(365*3,lp=x) surv3 <- function(x)surv(365*5,lp=x) nomogram.f <- nomogram(alignment.cph,lp= F, fun=list(surv1,surv2,surv3), funlabel=c('1-Year Survival','3-Year survival', '5-Year survival'), maxscale=100, fun.at=c('0.9','0.8','0.7','0.5','0.3','0.1')) plot(nomogram.f,xfrac=.15) dev.off() pdf('PDFs/tcga_nomogram.pdf', width = 10, height = 8) plot(nomogram.f,xfrac=.15) dev.off() f2 <- cph(Surv(OS.time, OS) ~ Age_g+Gender+A3_T+Grade+RiskScore, data =tcga_nomogram, x=T, y=T, dist='lognormal',surv=T) cal1 <- calibrate(f2, cmethod='KM', method="boot", u=365, m=100, B=300) cal2 <- calibrate(f2, cmethod='KM', method="boot", u=1095, m=100, B=300) cal3 <- calibrate(f2, cmethod='KM', method="boot", u=1825, m=100, B=300) pdf('PDFs/nomogram_correct.pdf', width = 4, height = 10) par(mfrow = c(3, 1)) plot(cal1, errbar.col=c(rgb(0,0,0,maxColorValue=255)), col=c(rgb(255,0,0,maxColorValue= 255)), xlab="Predicted of 1-Year OS", ylab="Actual 2-Year OS") abline(0,1,lty =3,lwd=2,col=c(rgb(0,0,255,maxColorValue= 255))) plot(cal2, errbar.col=c(rgb(0,0,0,maxColorValue=255)), col=c(rgb(255,0,0,maxColorValue= 255)), xlab="Predicted of 3-Year OS", ylab="Actual 3-Year OS") abline(0,1,lty =3,lwd=2,col=c(rgb(0,0,255,maxColorValue= 255))) plot(cal3, errbar.col=c(rgb(0,0,0,maxColorValue=255)), col=c(rgb(255,0,0,maxColorValue= 255)), xlab="Predicted of 5-Year OS", ylab="Actual 5-Year OS") abline(0,1,lty =3,lwd=2,col=c(rgb(0,0,255,maxColorValue= 255))) dev.off() library(forestplot) library(survcomp) change_values<-function(myd,column,values){ myd[!is.na(myd[,column]),]->myd colnames(myd)[column]->column_name; table(myd[,column])->N_stage.table; as.factor(names(N_stage.table))->N_stage.names; data.frame(column_name=N_stage.names,"Value"=values)->N_stage.df; c()->tmp.value; for(i in 1:nrow(myd)){ for(j in 1:nrow(N_stage.df)){ if(myd[i,column]==N_stage.df[j,1]){ c(tmp.value,as.character(N_stage.df[j,2]))->tmp.value; } } } tmp.value->myd[,column]; return(myd); } tcga_forestplot_data <- tcga_cli_fea[, c("A0_Samples", "OS.time", "OS","Age", "Gender", "A3_T", "A4_N", "A5_M", "Stage", "Grade", "RiskScore")] tcga_forestplot_data$Age <- as.numeric(tcga_forestplot_data$Age) tcga_forestplot_data <- change_values(tcga_forestplot_data, 5, c(1,2)) tcga_forestplot_data$Gender <- as.numeric(tcga_forestplot_data$Gender) tcga_forestplot_data <- change_values(tcga_forestplot_data, 6, c(1,2,3,4,5)) tcga_forestplot_data$A3_T <- as.numeric(tcga_forestplot_data$A3_T) table(tcga_forestplot_data$Grade) tcga_forestplot_data <- change_values(tcga_forestplot_data, 10, c(1,2,3,4,5)) tcga_forestplot_data$Grade <- as.numeric(tcga_forestplot_data$Grade) table(tcga_forestplot_data$Stage) tcga_forestplot_data <- change_values(tcga_forestplot_data, 9, c(1,2,3,4,5)) tcga_forestplot_data$Stage <- as.numeric(tcga_forestplot_data$Stage) model <- coxph(formula=Surv(OS.time, OS)~Age+Gender+A3_T+Stage+Grade+RiskScore, data=tcga_forestplot_data) summary(coxph(formula=Surv(OS.time, OS)~Age+Gender+A3_T+Stage+Grade+RiskScore, data=tcga_forestplot_data)) summary(coxph(formula=Surv(OS.time, OS)~RiskScore, data=tcga_forestplot_data)) pdf('PDFs/tcga_forest.pdf', width = 8, height = 5) survminer::ggforest(model,data=tcga_forestplot_data) dev.off() library(survcomp) library(timeROC) tcga_tpm_copy <- t(tcga_lihc_log2[, rownames(TCGA_model_data)]) colnames(tcga_tpm_copy) <- gsub('-', '__', colnames(tcga_tpm_copy)) other_model_gene <- read.table('files/other_model_genes.txt', check.names = F, header=T, sep="\t", stringsAsFactors=F) Qiao <- other_model_gene$Qiao Qiao Qiao <- intersect(Qiao, colnames(tcga_tpm_copy)) Qiao data1 <- data.frame(time=TCGA_model_data$OS.time, status=TCGA_model_data$OS, tcga_tpm_copy) fmla1 <- as.formula(paste0("Surv(time, status) ~" ,paste0(Qiao, collapse = '+'))) coxsig1 <- coxph(fmla1, data =as.data.frame(data1)) Qiao_cindex1 <- concordance.index(predict(coxsig1), surv.time = TCGA_model_data$OS.time, surv.event = TCGA_model_data$OS, method = "noether") Qiao_cindex1$c.index Qiao_cindex1$lower Qiao_cindex1$upper Qiao_risk=as.numeric(coef(coxsig1)%*%as.matrix(t(data1[,Qiao]))) Qiao_risk=mosaic::zscore(Qiao_risk) Qiao_model <- plotCoxModel_Batch(Qiao_risk, data1[,match(Qiao, colnames(data1))], data1$time, data1$status, cutoff = 0) Qiao_model ggsave(plot = Qiao_model, filename = 'PDFs/Qiao_model_roc_km.pdf', width = 10, height = 10, device = cairo_pdf) coxFun(data.frame(data1$time,data1$status,ifelse(as.numeric(Qiao_risk)>=0,'1High risk','0Low risk'))) Liu <- other_model_gene$Liu Liu Liu <- intersect(Liu, colnames(tcga_tpm_copy)) Liu data1 <- data.frame(time=TCGA_model_data$OS.time, status=TCGA_model_data$OS, tcga_tpm_copy) fmla1 <- as.formula(paste0("Surv(time, status) ~" ,paste0(Liu, collapse = '+'))) coxsig1 <- coxph(fmla1, data =as.data.frame(data1)) Liu_cindex1 <- concordance.index(predict(coxsig1), surv.time = TCGA_model_data$OS.time, surv.event = TCGA_model_data$OS, method = "noether") Liu_cindex1$c.index Liu_cindex1$lower Liu_cindex1$upper Liu_risk=as.numeric(coef(coxsig1)%*%as.matrix(t(data1[,Liu]))) Liu_risk=mosaic::zscore(Liu_risk) Liu_model <- plotCoxModel_Batch(Liu_risk, data1[,match(Liu, colnames(data1))], data1$time, data1$status, cutoff = 0) Liu_model library(ggplot2) ggsave(plot = Liu_model, filename = 'PDFs/Liu_model_roc_km.pdf', width = 13, height = 10, device = cairo_pdf) coxFun(data.frame(data1$time,data1$status,ifelse(as.numeric(Liu_risk)>=0,'1High risk','0Low risk'))) Wang <- other_model_gene$Wang Wang Wang <- intersect(Wang, colnames(tcga_tpm_copy)) Wang data1 <- data.frame(time=TCGA_model_data$OS.time, status=TCGA_model_data$OS, tcga_tpm_copy) fmla1 <- as.formula(paste0("Surv(time, status) ~" ,paste0(Wang, collapse = '+'))) coxsig1 <- coxph(fmla1, data =as.data.frame(data1)) Wang_cindex1 <- concordance.index(predict(coxsig1), surv.time = TCGA_model_data$OS.time, surv.event = TCGA_model_data$OS, method = "noether") Wang_cindex1$c.index Wang_cindex1$lower Wang_cindex1$upper Wang_risk=as.numeric(coef(coxsig1)%*%as.matrix(t(data1[,Wang]))) Wang_risk=mosaic::zscore(Wang_risk) Wang_model <- plotCoxModel_Batch(Wang_risk, data1[,match(Wang, colnames(data1))], data1$time, data1$status, cutoff = 0) Wang_model ggsave(plot = Wang_model, filename = 'PDFs/Wang_model_roc_km.pdf', width = 10, height = 10, device = cairo_pdf) coxFun(data.frame(data1$time,data1$status,ifelse(as.numeric(Wang_risk)>=0,'1High risk','0Low risk'))) Ke <- other_model_gene$Ke Ke Ke <- intersect(Ke, colnames(tcga_tpm_copy)) Ke data1 <- data.frame(time=TCGA_model_data$OS.time, status=TCGA_model_data$OS, tcga_tpm_copy) fmla1 <- as.formula(paste0("Surv(time, status) ~" ,paste0(Ke, collapse = '+'))) coxsig1 <- coxph(fmla1, data =as.data.frame(data1)) Ke_cindex1 <- concordance.index(predict(coxsig1), surv.time = TCGA_model_data$OS.time, surv.event = TCGA_model_data$OS, method = "noether") Ke_cindex1$c.index Ke_cindex1$lower Ke_cindex1$upper Ke_risk=as.numeric(coef(coxsig1)%*%as.matrix(t(data1[,Ke]))) Ke_risk=mosaic::zscore(Ke_risk) Ke_model <- plotCoxModel_Batch(Ke_risk, data1[,match(Ke, colnames(data1))], data1$time, data1$status, cutoff = 0) Ke_model ggsave(plot = Ke_model, filename = 'PDFs/Ke_model_roc_km.pdf', width = 13, height = 10, device = cairo_pdf) coxFun(data.frame(data1$time,data1$status,ifelse(as.numeric(Ke_risk)>=0,'1High risk','0Low risk'))) Long <- other_model_gene$Long Long Long <- intersect(Long, colnames(tcga_tpm_copy)) Long data1 <- data.frame(time=TCGA_model_data$OS.time, status=TCGA_model_data$OS, tcga_tpm_copy) fmla1 <- as.formula(paste0("Surv(time, status) ~" ,paste0(Long, collapse = '+'))) coxsig1 <- coxph(fmla1, data =as.data.frame(data1)) Long_cindex1 <- concordance.index(predict(coxsig1), surv.time = TCGA_model_data$OS.time, surv.event = TCGA_model_data$OS, method = "noether") Long_cindex1$c.index Long_cindex1$lower Long_cindex1$upper Long_risk=as.numeric(coef(coxsig1)%*%as.matrix(t(data1[,Long]))) Long_risk=mosaic::zscore(Long_risk) Long_model <- plotCoxModel_Batch(Long_risk, data1[,match(Long, colnames(data1))], data1$time, data1$status, cutoff = 0) Long_model ggsave(plot = Long_model, filename = 'PDFs/Long_model_roc_km.pdf', width = 10, height = 10, device = cairo_pdf) coxFun(data.frame(data1$time,data1$status,ifelse(as.numeric(Long_risk)>=0,'1High risk','0Low risk'))) Zheng <- other_model_gene$Zheng Zheng Zheng <- intersect(Zheng, colnames(tcga_tpm_copy)) Zheng data1 <- data.frame(time=TCGA_model_data$OS.time, status=TCGA_model_data$OS, tcga_tpm_copy) fmla1 <- as.formula(paste0("Surv(time, status) ~" ,paste0(Zheng, collapse = '+'))) coxsig1 <- coxph(fmla1, data =as.data.frame(data1)) Zheng_cindex1 <- concordance.index(predict(coxsig1), surv.time = TCGA_model_data$OS.time, surv.event = TCGA_model_data$OS, method = "noether") Zheng_cindex1$c.index Zheng_cindex1$lower Zheng_cindex1$upper Zheng_risk=as.numeric(coef(coxsig1)%*%as.matrix(t(data1[,Zheng]))) Zheng_risk=mosaic::zscore(Zheng_risk) Zheng_model <- plotCoxModel_Batch(Zheng_risk, data1[,match(Zheng, colnames(data1))], data1$time, data1$status, cutoff = 0) Zheng_model ggsave(plot = Zheng_model, filename = 'PDFs/Zheng_model_roc_km.pdf', width = 13, height = 10, device = cairo_pdf) coxFun(data.frame(data1$time,data1$status,ifelse(as.numeric(Zheng_risk)>=0,'1High risk','0Low risk'))) Li <- other_model_gene$Li Li Li <- intersect(Li, colnames(tcga_tpm_copy)) Li data1 <- data.frame(time=TCGA_model_data$OS.time, status=TCGA_model_data$OS, tcga_tpm_copy) fmla1 <- as.formula(paste0("Surv(time, status) ~" ,paste0(Li, collapse = '+'))) coxsig1 <- coxph(fmla1, data =as.data.frame(data1)) Li_cindex1 <- concordance.index(predict(coxsig1), surv.time = TCGA_model_data$OS.time, surv.event = TCGA_model_data$OS, method = "noether") Li_cindex1$c.index Li_cindex1$lower Li_cindex1$upper Li_risk=as.numeric(coef(coxsig1)%*%as.matrix(t(data1[,Li]))) Li_risk=mosaic::zscore(Li_risk) Li_model <- plotCoxModel_Batch(Li_risk, data1[,match(Li, colnames(data1))], data1$time, data1$status, cutoff = 0) Li_model ggsave(plot = Li_model, filename = 'PDFs/Li_model_roc_km.pdf', width = 10, height = 10, device = cairo_pdf) coxFun(data.frame(data1$time,data1$status,ifelse(as.numeric(Li_risk)>=0,'1High risk','0Low risk'))) library("IMvigor210CoreBiologies") data(cds) IMvigor210_gene_length <- as.data.frame(fData(cds)) IMvigor210_cli <- as.data.frame(pData(cds)) IMvigor210_cli$os <- IMvigor210_cli$os * 30 IMvigor210_cli$os IMvigor210_cli$censOS IMvigor210_fpkm <- read.table('D:/public/IMvigor210/IMvigor210_FPKM.txt', sep = '\t', row.names = 1, header = T, stringsAsFactors = F, check.names = F) IMvigor210_fpkm <- IMvigor210_fpkm[rownames(IMvigor210_gene_length), ] IMvigor210_fpkm$genes <- IMvigor210_gene_length$symbol IMvigor210_fpkm_symbol <- aggregate(.~genes, data=IMvigor210_fpkm, mean) IMvigor210_fpkm_symbol <- IMvigor210_fpkm_symbol[-c(1), ] rownames(IMvigor210_fpkm_symbol) <- IMvigor210_fpkm_symbol$genes IMvigor210_fpkm_symbol <- IMvigor210_fpkm_symbol[, -c(1)] data(human_gene_signatures) save(human_gene_signatures, file = 'D:/public/IMvigor210/human_gene_signatures.RData') IMvigor210_fpkm_symbol_log2 <- log2(IMvigor210_fpkm_symbol + 1) IMvigor210_cli <- IMvigor210_cli[colnames(IMvigor210_fpkm_symbol_log2), ] tail(rownames(IMvigor210_cli)) tail(colnames(IMvigor210_fpkm_symbol_log2)) IMvigor210_model_cli <- IMvigor210_cli[, c("os", "censOS")] colnames(IMvigor210_model_cli) <- c('OS.time', 'OS') IMvigor210_model_cli$samples <- rownames(IMvigor210_model_cli) IMvigor210_model_exp <- t(IMvigor210_fpkm_symbol_log2[, rownames(IMvigor210_cli)]) IMvigor210_model_exp <- as.data.frame(IMvigor210_model_exp) IMvigor210_model_exp$samples <- rownames(IMvigor210_model_exp) IMvigor210_model_data <- merge(IMvigor210_model_cli, IMvigor210_model_exp, by.x = 'samples', by.y = 'samples') rownames(IMvigor210_model_data) <- IMvigor210_model_data$samples IMvigor210_lan <- lan match(names(IMvigor210_lan),colnames(IMvigor210_model_data)) IMvigor210_lan risk.IMvigor210=as.numeric(IMvigor210_lan%*%as.matrix(t(IMvigor210_model_data[,names(IMvigor210_lan)]))) risk.IMvigor210z=mosaic::zscore(risk.IMvigor210) cutoff <- 0 fit <- survivalROC::survivalROC(Stime = IMvigor210_model_data$OS.time, status = IMvigor210_model_data$OS, marker = risk.IMvigor210z, predict.time = 365*1, method = "KM") fit$AUC optimalCutoff1 <- fit$cut.values[which.max(fit$TP - fit$FP)] cutoff <- optimalCutoff1 fivenum(risk.IMvigor210z) IMvigor210_km <- ggplotKMCox(data.frame(IMvigor210_model_data$OS.time, IMvigor210_model_data$OS, ifelse(risk.IMvigor210z>=cutoff,'H','L')), labs = c('High', 'Low')) IMvigor210_km IMvigor210_datas1 <- IMvigor210_cli[rownames(IMvigor210_model_data), ] IMvigor210_datas1$RiskScore <- risk.IMvigor210z IMvigor210_datas1 <- IMvigor210_datas1[, c("os", "censOS", "FMOne mutation burden per MB", "Neoantigen burden per MB", "RiskScore", "Best Confirmed Overall Response")] colnames(IMvigor210_datas1) <- c('OS.time', 'Status', 'TMB', "NEO", 'RiskScore', 'Response') IMvigor210_datas1 <- IMvigor210_datas1[IMvigor210_datas1$Response != 'NE', ] IMvigor210_datas1$TMB[is.na(IMvigor210_datas1$TMB)] <- '' IMvigor210_datas1$NEO[is.na(IMvigor210_datas1$NEO)] <- '' fmla1 <- as.formula(paste0("Surv(OS.time, Status) ~" , 'TMB+NEO+RiskScore')) coxsig1 <- coxph(fmla1, data =IMvigor210_datas1) IMvigor210_datas1$Complex <- predict(coxsig1) write.table(IMvigor210_datas1, file = 'files/IMvigor210_ROC_datas.txt', sep = '\t') library(pROC) library(dplyr) IMvigor210_datas1$TMB <- as.numeric(IMvigor210_datas1$TMB) IMvigor210_datas1$NEO <- as.numeric(IMvigor210_datas1$NEO) roc.list1 <- roc(Status ~ TMB + NEO + RiskScore + Complex, data = IMvigor210_datas1) g.list1 <- ggroc(roc.list1, size = 1.2, legacy.axes = TRUE) g.list1 + theme_bw() dev.off() roc.list1$TMB$auc roc.list1$NEO$auc roc.list1$RiskScore$auc roc.list1$Complex$auc IMvigor210_ROC <-g.list1 + theme_bw() IMvigor210_ROC IMvigor210_KM_ROC <- ggpubr::ggarrange(IMvigor210_km, IMvigor210_ROC, ncol = 2,nrow = 1, labels = toupper(letters)[1:2], align = "hv") IMvigor210_KM_ROC ggsave(plot = IMvigor210_KM_ROC, filename = 'PDFs/IMvigor210_KM_ROC.pdf', width = 10, height = 5, device = cairo_pdf) IMvigor210_cli[1:5,1:5] IMvigor210_cli <- IMvigor210_cli[rownames(IMvigor210_model_data), ] IMvigor210_cli$RiskScore <- risk.IMvigor210z IMvigor210_cli$Groups <- ifelse(risk.IMvigor210z>=cutoff, 'High','Low') immu_eff <- IMvigor210_cli[, c("Best Confirmed Overall Response", "RiskScore")] colnames(immu_eff) <- c('groups', 'RiskScore') immu_eff <- immu_eff[immu_eff$groups != 'NE', ] respon_violin <- mg_violin(immu_eff, melt=TRUE, ylab='RiskScore', leg.title='Response', test_method='anova', legend.pos='tl', show_compare = F) respon_violin IC_datas <- IMvigor210_cli[, c("IC Level", "RiskScore")] colnames(IC_datas) <- c('groups', 'RiskScore') IC_datas <- na.omit(IC_datas) IC_violin <- mg_violin(IC_datas, melt=TRUE, ylab='RiskScore', leg.title='IC', test_method='anova', legend.pos='tl', show_compare = F) IC_violin TC_datas <- IMvigor210_cli[, c("TC Level", "RiskScore")] colnames(TC_datas) <- c('groups', 'RiskScore') TC_datas <- na.omit(TC_datas) TC_violin <- mg_violin(TC_datas, melt=TRUE, ylab='RiskScore', leg.title='TC', test_method='anova', legend.pos='tl', show_compare = F) TC_violin IP_datas <- IMvigor210_cli[, c("Immune phenotype", "RiskScore")] colnames(IP_datas) <- c('groups', 'RiskScore') IP_datas <- na.omit(IP_datas) IP_violin <- mg_violin(IP_datas, melt=TRUE, ylab='RiskScore', leg.title='IP', test_method='anova', legend.pos='tl', show_compare = F) IP_violin IMvigor210_cli_RiskScore <- ggpubr::ggarrange(respon_violin, IC_violin, TC_violin, ncol = 3,nrow = 1, labels = toupper(letters)[1:3], align = "hv") IMvigor210_cli_RiskScore ggsave(plot = IMvigor210_cli_RiskScore, filename = 'PDFs/IMvigor210_cli_RiskScore.pdf', width = 15, height = 5, device = cairo_pdf) save.image('LIHC_TME_20200501.RData') low_groups <- IMvigor210_cli[IMvigor210_cli$Groups == 'Low', ] low_groups <- low_groups[low_groups$`Best Confirmed Overall Response` != 'NE', ] table(low_groups$`Best Confirmed Overall Response` == 'CR' | low_groups$`Best Confirmed Overall Response` == 'PR') High_groups <- IMvigor210_cli[IMvigor210_cli$Groups == 'High', ] High_groups <- High_groups[High_groups$`Best Confirmed Overall Response` != 'NE', ] table(High_groups$`Best Confirmed Overall Response` == 'CR' | High_groups$`Best Confirmed Overall Response` == 'PR') tdata <- matrix(c(126, 36, 104, 32), ncol = 2) tdata chisq.test(tdata) library(plyr) library(ggplot2) perc_data <- data.frame(Cluster = c('Low', 'Low', 'High', 'High'), Groups = c('NO Responder','Responder', 'NO Responder','Responder'), datas = c(126, 36, 104, 32)) perc_data ce = ddply(perc_data, "Cluster", transform, percent_weight = datas / sum(datas) * 100) perc_plot <- ggplot(ce, aes(x = Cluster, y = percent_weight, fill = Groups)) + geom_bar(stat = "identity", colour = "black", width = 0.5) perc_plot save.image('.RData')