setwd("/home/jzd/Documents/P013")
#----Differential expression analysis----
rm(list = ls())
library(limma)
library(tidyverse)
library(stringr)
library(edgeR)
library(dplyr)
library(gridExtra)
library(survival)
library(survminer)
library(forestplot)
library(ezcox)
library(forestmodel)
#----Load data--
load("exp_count.rda")
load("exp_fpkm.rda")
load("geo_exp.rda")
tcga_clinical<-read.csv("tcga_clinical.csv",header = T)
geo_clinical<-read.csv("geo_clinical.csv",header = T)
geneset<-read.csv("golgi.csv",header = T)
geneset<-geneset$Symbol
exp<-exp_count[rownames(exp_count)%in%geneset,]
dim(exp)
group<-factor(rep(c("Normal","Tumor"),times=c(44,519)),
              levels = c("Normal","Tumor"))
table(group)
design<-model.matrix(~0+group)
colnames(design)<-levels(group)
row.names(design)<-colnames(exp_count)

DGElist<-DGEList(counts=exp,group=group)
DGElist<-calcNormFactors(DGElist)

v<-voom(DGElist,design,plot = T,normalize="quantile")
fit<-lmFit(v,design)
constrasts<-paste(rev(levels(group)),collapse = "-")
cont.matrix<-makeContrasts(contrasts = constrasts,levels = design)
fit2=contrasts.fit(fit,cont.matrix)
fit2=eBayes(fit2)
DEG<-topTable(fit2,coef = constrasts,n=Inf)#Extract a table of the top-ranked genes from a linear model fit.
DEG=na.omit(DEG)#Remove rows with missing values on columns specified
fdr=0.05
k1=(DEG$adj.P.Val<fdr)&(DEG$logFC<(-1))
k2=(DEG$adj.P.Val<fdr)&(DEG$logFC>(1))
change=ifelse(k1,"down",ifelse(k2,"up","stable"))
DEG$change<-change
nrow(DEG[DEG$change!="stable",])#321DEG
write.csv(DEG[DEG$change!="stable",],file = "deGARGs.csv")

save(DEG,group,file = "DEG.Rdata")
#---Volcano map---
pdf(file = "vol_TMG.pdf",height = 5,width=5)
DEG$gene_name<-row.names(DEG)
x_lim<-max(DEG$logFC,-DEG$logFC)
p1<-ggplot(DEG,aes(logFC,-1*log10(adj.P.Val),color=change))+
  geom_point(size=1)+
  theme_bw()+
  xlim(-x_lim,x_lim)+
  labs(x="log2(FC)",y="-log10(adjP)")+
  scale_color_manual(values=c("#A52A2A","grey","#21766d"))+
  geom_hline(aes(yintercept=-1*log10(0.05)),color="black",linetype="dashed")+
  geom_vline(xintercept = c(-1,1),color="black",linetype="dashed")
print(p1)
dev.off()

nrow(DEG[DEG$change=="up",])
nrow(DEG[DEG$change=="down",])

#---Prognostic analysis----
tumor_fpkm<-exp_fpkm[,substr(colnames(exp_fpkm),14,14)=="0"]
colnames(tumor_fpkm)<-substr(colnames(tumor_fpkm),1,12)
tumor_fpkm<-tumor_fpkm[,unique(colnames(tumor_fpkm))]
tumor_fpkm<-log2(tumor_fpkm+1)
coxdata<-as.data.frame(t(tumor_fpkm))
coxdata<-coxdata[,colnames(coxdata)%in%rownames(DEG[DEG$change!="stable",])]
coxdata$Patients<-rownames(coxdata)
coxdata<-merge(coxdata,tcga_clinical,by="Patients",sort = F)

coxdata$status<-ifelse(coxdata$status=="Dead",1,0)
nrows<-nrow(DEG[DEG$change!="stable",])
unicox_result<-data.frame(matrix(data = NA,nrow = nrows,ncol = 5))
for (i in 1:nrows) {
  unicox<-coxph(Surv(days,status)~coxdata[,i+1],data=coxdata)
  unicox_result$X1[i]=summary(unicox)[["conf.int"]][1]
  unicox_result$X2[i]=summary(unicox)[["conf.int"]][2]
  unicox_result$X3[i]=summary(unicox)[["conf.int"]][3]
  unicox_result$X4[i]=summary(unicox)[["conf.int"]][4]
  unicox_result$X5[i]=summary(unicox)[["coefficients"]][5]
}
rownames(unicox_result)[1:nrows]<-colnames(coxdata)[2:(nrows+1)]
colnames(unicox_result)<-c("HR","exp(-coef)","Lower95","Upper95","p")
unicox_result_sig<-subset(unicox_result,p<0.05)
unicox_result_sig$gene<-rownames(unicox_result_sig)
unicox_result_sig<-unicox_result_sig[order(unicox_result_sig$p,decreasing = T),]
unicox_result_sig$group<-ifelse(unicox_result_sig$HR>1,"risk","protective")
pro_genes<-rownames(unicox_result_sig)
length(pro_genes)#prognostic DEGs=69
write.csv(unicox_result_sig,file = "unicox_genes.csv")

#Draw HR diagram
hrdata<-unicox_result_sig
hrdata<-hrdata[order(hrdata$HR,decreasing = T),]
pdf(file = "HR_genes.pdf")
ggplot(data = hrdata,
       mapping = aes(x=reorder(gene,HR),y=HR,fill=group))+
  geom_bar(stat = 'identity')+
  theme_bw()+
  theme(axis.text.x = element_text(angle = 45,hjust = 1))+
  labs(x="genes",y="HR")+
  scale_color_manual(values = c("red","green"),aesthetics = c("color","fill"))+
  geom_hline(yintercept = 1,color="gray50")
dev.off()

#---Cluster analysis----
library(ConsensusClusterPlus)
library(ggstatsplot)
library(ggplot2)
library(reshape2)

library(survival)
library(survminer)

data<-tumor_fpkm[rownames(tumor_fpkm)%in%pro_genes,]
data<-as.matrix(data)
path=getwd()
results<-ConsensusClusterPlus(data,
                              maxK=6,
                              reps = 500,pItem = 0.8,
                              pFeature = 0.8,
                              seed = 12123,
                              clusterAlg = 'pam',
                              distance = 'pearson',
                              title = path,
                              plot = 'pdf')
ic1<-calcICL(results,title = path,plot = 'png')

Kvec=2:6
x1=0.1;x2=0.9#threshold defining the intermediate sub-interval
PAC=rep(NA,length(Kvec))
names(PAC)=paste("K=",Kvec,sep = "")#from 2 to maxK
for (i in Kvec) {
  M=results[[i]]$consensusMatrix
  Fn=ecdf(M[lower.tri(M)])
  PAC[i-1]=Fn(x2)-Fn(x1)#end for i# the optimal K
}
optK=Kvec[which.min(PAC)]


clusters<-as.data.frame(results[[2]]["consensusClass"])
clusters$Patients<-rownames(clusters)

clinical<-tcga_clinical[,c("Patients","status","days")]
sadata<-merge(clusters,clinical,by="Patients")
sadata$status<-ifelse(sadata$status=="Dead",1,0)
sadata$consensusClass<-ifelse(sadata$consensusClass==1,"cluster1","cluster2")
cluster_km<-survfit(Surv(days,status)~consensusClass,data = sadata)
pdf(file = "KM_clusters.pdf")
p<-ggsurvplot(cluster_km,size=1,
              linetype = "strata",
              break.time.by=1000,
              palette = c('#009C3E','#FFA500'),
              # conf.int = TRUE,
              pval = TRUE, 
              pval.method = TRUE,
              surv.median.line = "hv",
              conf.int = T,
              legend.title="",
              legend=c(0.7,0.9),
              legend.labs=c("cluster1","cluster2"),
              risk.table = T
)
print(p)
dev.off()
#----PCA----
pca <- prcomp(as.matrix(t(data)), scale=TRUE)
pca_df <- as.data.frame(pca$x)
pcadata<-pca_df
pcadata$Patients<-rownames(pcadata)
pcadata<-merge(pcadata,clusters,by="Patients",sort=F)
pcadata$consensusClass<-ifelse(pcadata$consensusClass==1,"cluster1","cluster2")
pca_df$group<-pcadata$consensusClass

library(ggplot2)
pdf("pca.pdf")
pcaplot<-ggplot(pca_df, aes(x=PC1, y=PC2, color=group)) + 
  geom_point(size=3) +
  xlab(paste0("PC1 (", round(summary(pca)$importance[2,1]*100, 1), "%)")) +
  ylab(paste0("PC2 (", round(summary(pca)$importance[2,2]*100, 1), "%)")) +
  scale_color_manual(values = c("#f06eaa", "#3c9cd7"))+
  theme_bw()
print(pcaplot)
dev.off()

#----Construction of prognosis model----
library(glmnet)
pro_genes<-intersect(pro_genes,rownames(geo_exp))#pro_genes=66
x<-coxdata[,colnames(coxdata)%in%pro_genes]
x<-as.matrix(x)
y<-coxdata[,c("days","status")]
names(y)<-c('time','status')
y$time<-as.double(y$time)
y$status<-as.double(y$status)
y<-as.matrix(survival::Surv(y$time,y$status))

set.seed(12345)
fit<-glmnet(x,y,family = "cox")
pdf("lasso.lambda.pdf")
lambda<-plot(fit,xvar="lambda",label=TRUE)
dev.off()
lasso_fit<-cv.glmnet(x,y,family="cox",type.measure = 'deviance',maxit=20000)
cvfit<-plot(lasso_fit)
cvfit+abline(v=log(c(lasso_fit$lambda.min,lasso_fit$lambda.1se)),lty="dashed")
coefficient<-coef(lasso_fit,s=lasso_fit$lambda.min)
active.index<-which(as.numeric(coefficient)!=0)
active.coefficients<-as.numeric(coefficient)[active.index]
sig_gene_multi_cox<-rownames(coefficient)[active.index]
length(sig_gene_multi_cox)

par(mfrow=c(1,2))
plot(fit,xvar="lambda",label=TRUE)
plot(lasso_fit)
cvfit+abline(v=log(c(lasso_fit$lambda.min,lasso_fit$lambda.1se)),lty="dashed")

write.csv(sig_gene_multi_cox,file = "lasso_sig_genes_pattern.csv")

#Mapping the gene
sig_gene_multi_cox<-read.csv("lasso_sig_genes_pattern.csv",header = T)
library(RCircos)
library(biomaRt)
listMarts()
hsp<-useMart(biomart = "ENSEMBL_MART_ENSEMBL",
             dataset = "hsapiens_gene_ensembl",
             host = "https://www.ensembl.org")
attributes<-c("chromosome_name",
              "start_position",
              "end_position",
              "hgnc_symbol")
hsp_info<-getBM(attributes = attributes,mart = hsp)
progene_info<-hsp_info[hsp_info$hgnc_symbol%in%sig_gene_multi_cox$x,]
progene_info$chromosome_name<-paste("chr",progene_info$chromosome_name,sep = "")


data(UCSC.HG38.Human.CytoBandIdeogram)
cyto.info<-UCSC.HG38.Human.CytoBandIdeogram
RCircos.Set.Core.Components(cyto.info,chr.exclude = NULL,
                            tracks.inside = 10,
                            tracks.outside = 0)
RCircos.List.Plot.Parameters()
data("RCircos.Gene.Label.Data")

colnames(progene_info)<-colnames(RCircos.Gene.Label.Data)
nchar(progene_info$Chromosome)

progene_info<-subset(progene_info,nchar(progene_info$Chromosome)<6)
pdf(file = "RCircosDemoHumanGenome.pdf",height = 8,width = 8,compress = T)
RCircos.Set.Plot.Area()
RCircos.Chromosome.Ideogram.Plot()
side<-"in"
track.num=1
RCircos.Gene.Connector.Plot(progene_info,track.num,side)
name.col<-4
track.num<-2
RCircos.Gene.Name.Plot(progene_info,name.col,track.num,side)
dev.off()

#---Machine learning----
library(survival)
library(randomForestSRC)
library(glmnet)
library(plsRcox)
library(superpc)
library(gbm)
library(CoxBoost)
library(survivalsvm)
library(dplyr)
library(tibble)
library(BART)
#####################################
#####################################
tcga<-coxdata[,c("days","status",sig_gene_multi_cox)]
rownames(tcga)<-coxdata$Patients
data <-as.data.frame(t(geo_exp))
data <-data[,sig_gene_multi_cox]
colnames(geo_clinical)[2]<-c("patients")
data$patients<-rownames(data)
data<-merge(data,geo_clinical,by="patients",sort=F)
geo<-data[,c("days","status",sig_gene_multi_cox)]
rownames(geo)<-data$patients
colnames(tcga)[1:2]<-c('OS.time','OS')
colnames(geo)[1:2]<-c('OS.time','OS')
geo$OS<-ifelse(geo$OS=="Dead",1,0)
mm<-list(TCGA=tcga,
         GEO=geo)
mm <- lapply(mm,function(x){
  x[,-c(1:2)] <- scale(x[,-c(1:2)])
  return(x)})

result<-data.frame()

est_data <- mm$TCGA
val_data_list <- mm
pre_var <- colnames(est_data)[-c(1:2)]
est_dd <- est_data[,c('OS.time','OS',pre_var)]
val_dd_list <- lapply(val_data_list,function(x){x[,c('OS.time','OS',pre_var)]})


rf_nodesize <- 5
seed <- 1
##################################
#### 1-1.RSF ####
##################################

set.seed(seed)
fit <- rfsrc(Surv(OS.time,OS)~.,data = est_dd,
             ntree = 1000,nodesize = rf_nodesize,
             splitrule = 'logrank',
             importance = T,
             proximity = T,
             forest = T,
             seed = seed)
rs <- lapply(val_dd_list,function(x){cbind(x[,1:2],RS=predict(fit,newdata = x)$predicted)})
cc <- data.frame(Cindex=sapply(rs,function(x){as.numeric(summary(coxph(Surv(OS.time,OS)~RS,x))$concordance[1])}))%>%
  rownames_to_column('ID')
cc$Model <- 'RSF'
result <- rbind(result,cc)

##################################
#### 2-1.Enet ####
##################################

x1 <- as.matrix(est_dd[,pre_var])
x2 <- as.matrix(Surv(est_dd$OS.time,est_dd$OS))

for (alpha in seq(0,1,0.1)) {
  set.seed(seed)
  fit = cv.glmnet(x1, x2,family = "cox",alpha=alpha,nfolds = 10)
  rs <- lapply(val_dd_list,function(x){cbind(x[,1:2],RS=as.numeric(predict(fit,type='link',newx=as.matrix(x[,-c(1,2)]),s=fit$lambda.min)))})
  
  cc <- data.frame(Cindex=sapply(rs,function(x){as.numeric(summary(coxph(Surv(OS.time,OS)~RS,x))$concordance[1])}))%>%
    rownames_to_column('ID')
  cc$Model <- paste0('Enet','[α=',alpha,']')
  result <- rbind(result,cc)
}

##################################
#### 3-1.StepCox ####
##################################

for (direction in c("both", "backward", "forward")) {
  fit <- step(coxph(Surv(OS.time,OS)~.,est_dd),direction = direction)
  rs <- lapply(val_dd_list,function(x){cbind(x[,1:2],RS=predict(fit,type = 'risk',newdata = x))})
  
  cc <- data.frame(Cindex=sapply(rs,function(x){as.numeric(summary(coxph(Surv(OS.time,OS)~RS,x))$concordance[1])}))%>%
    rownames_to_column('ID')
  cc$Model <- paste0('StepCox','[',direction,']')
  result <- rbind(result,cc)
}
##################################
#### 3-8.StepCox+gbm ####
##################################

for (direction in c("both", "backward")) {
  fit <- step(coxph(Surv(OS.time,OS)~.,est_dd),direction = direction)
  rid <- names(coef(fit))
  est_dd2 <- est_data[,c('OS.time','OS',rid)]
  val_dd_list2 <- lapply(val_data_list,function(x){x[,c('OS.time','OS',rid)]})
  
  fit = survivalsvm(Surv(OS.time,OS)~., data= est_dd2, gamma.mu = 1)
  rs <- lapply(val_dd_list2,function(x){cbind(x[,1:2],RS=as.numeric(predict(fit, x)$predicted))})
  cc <- data.frame(Cindex=sapply(rs,function(x){as.numeric(summary(coxph(Surv(OS.time,OS)~RS,x))$concordance[1])}))%>%
    rownames_to_column('ID')
  cc$Model <- paste0('StepCox','[',direction,']',' + survival-SVM')
  result <- rbind(result,cc)
}


##################################
#### 4-1.CoxBoost ####
##################################

set.seed(seed)
pen <- optimCoxBoostPenalty(est_dd[,'OS.time'],est_dd[,'OS'],as.matrix(est_dd[,-c(1,2)]),
                            trace=TRUE,start.penalty=500,parallel = T)
cv.res <- cv.CoxBoost(est_dd[,'OS.time'],est_dd[,'OS'],as.matrix(est_dd[,-c(1,2)]),
                      maxstepno=500,K=10,type="verweij",penalty=pen$penalty)
fit <- CoxBoost(est_dd[,'OS.time'],est_dd[,'OS'],as.matrix(est_dd[,-c(1,2)]),
                stepno=cv.res$optimal.step,penalty=pen$penalty)
rs <- lapply(val_dd_list,function(x){cbind(x[,1:2],RS=as.numeric(predict(fit,newdata=x[,-c(1,2)], newtime=x[,1], newstatus=x[,2], type="lp")))})

cc <- data.frame(Cindex=sapply(rs,function(x){as.numeric(summary(coxph(Surv(OS.time,OS)~RS,x))$concordance[1])}))%>%
  rownames_to_column('ID')
cc$Model <- paste0('CoxBoost')
result <- rbind(result,cc)

##################################
#### 5.plsRcox####
##################################

set.seed(seed)
cv.plsRcox.res=cv.plsRcox(list(x=est_dd[,pre_var],time=est_dd$OS.time,status=est_dd$OS),nt=10,verbose = FALSE)
fit <- plsRcox(est_dd[,pre_var],time=est_dd$OS.time,event=est_dd$OS,nt=as.numeric(cv.plsRcox.res[5]))
rs <- lapply(val_dd_list,function(x){cbind(x[,1:2],RS=as.numeric(predict(fit,type="lp",newdata=x[,-c(1,2)])))})

cc <- data.frame(Cindex=sapply(rs,function(x){as.numeric(summary(coxph(Surv(OS.time,OS)~RS,x))$concordance[1])}))%>%
  rownames_to_column('ID')
cc$Model <- paste0('plsRcox')
result <- rbind(result,cc)

##################################
#### 6.superpc####
##################################

data <- list(x=t(est_dd[,-c(1,2)]),y=est_dd$OS.time,censoring.status=est_dd$OS,featurenames=colnames(est_dd)[-c(1,2)])
set.seed(seed)
fit <- superpc.train(data = data,type = 'survival',s0.perc = 0.5) #default
cv.fit <- superpc.cv(fit,data,n.threshold = 20,#default 
                     n.fold = 10,
                     n.components=3,
                     min.features=5,
                     max.features=nrow(data$x),
                     compute.fullcv= TRUE,
                     compute.preval=TRUE)
rs <- lapply(val_dd_list,function(w){
  test <- list(x=t(w[,-c(1,2)]),y=w$OS.time,censoring.status=w$OS,featurenames=colnames(w)[-c(1,2)])
  ff <- superpc.predict(fit,data,test,threshold = cv.fit$thresholds[which.max(cv.fit[["scor"]][1,])],n.components = 1)
  rr <- as.numeric(ff$v.pred)
  rr2 <- cbind(w[,1:2],RS=rr)
  return(rr2)
})

cc <- data.frame(Cindex=sapply(rs,function(x){as.numeric(summary(coxph(Surv(OS.time,OS)~RS,x))$concordance[1])}))%>%
  rownames_to_column('ID')
cc$Model <- paste0('SuperPC')
result <- rbind(result,cc)


##################################
#### 7.GBM ####
##################################

set.seed(seed)
fit <- gbm(formula = Surv(OS.time,OS)~.,data = est_dd,distribution = 'coxph',
           n.trees = 10000,
           interaction.depth = 3,
           n.minobsinnode = 10,
           shrinkage = 0.001,
           cv.folds = 10,n.cores = 6)
# find index for number trees with minimum CV error
best <- which.min(fit$cv.error)
set.seed(seed)
fit <- gbm(formula = Surv(OS.time,OS)~.,data = est_dd,distribution = 'coxph',
           n.trees = best,
           interaction.depth = 3,
           n.minobsinnode = 10,
           shrinkage = 0.001,
           cv.folds = 10,n.cores = 8)
rs <- lapply(val_dd_list,function(x){cbind(x[,1:2],RS=as.numeric(predict(fit,x,n.trees = best,type = 'link')))})

cc <- data.frame(Cindex=sapply(rs,function(x){as.numeric(summary(coxph(Surv(OS.time,OS)~RS,x))$concordance[1])}))%>%
  rownames_to_column('ID')
cc$Model <- paste0('GBM')
result <- rbind(result,cc)


##################################
#### 8.survivalsvm ####
##################################

fit = survivalsvm(Surv(OS.time,OS)~., data= est_dd, gamma.mu = 1)

rs <- lapply(val_dd_list,function(x){cbind(x[,1:2],RS=as.numeric(predict(fit, x)$predicted))})

cc <- data.frame(Cindex=sapply(rs,function(x){as.numeric(summary(coxph(Surv(OS.time,OS)~RS,x))$concordance[1])}))%>%
  rownames_to_column('ID')
cc$Model <- paste0('survival-SVM')
result <- rbind(result,cc)

result2 <- result
result2$Model <- gsub('α','a',result2$Model)
library(ggplot2)
library(ggsci)
library(tidyr)
library(ggbreak)
range(result2$Cindex)
result2%>%filter(ID!='TCGA')%>%
  ggplot(aes(Cindex,reorder(Model,Cindex)))+
  geom_bar(width = 0.7,stat = 'summary',fun='mean',fill='orange2')+
  theme_classic()+
  labs(y=NULL)

dd <- result2%>%
  #filter(ID!='TCGA')%>%
  group_by(Model)%>%
  summarise(Cindex=mean(Cindex))

dd%>%
  ggplot(aes(Cindex,reorder(Model,Cindex)))+
  geom_bar(width=0.7,stat = 'identity',fill='orange')+
  scale_x_break(c(0.05,0.53),scales = 20)


dd2 <- pivot_wider(result2,names_from = 'ID',values_from = 'Cindex')%>%as.data.frame()
dd2[,-1] <- apply(dd2[,-1],2,as.numeric)

result_t <- tidyr::pivot_wider(result, names_from = "ID", values_from = "Cindex")
result_t$mean<-rowMeans(result_t[,c("TCGA","GEO")])
result_t <- result_t %>%
  arrange(desc(mean))
# （long format）
library(reshape2)
result_melted <- melt(result, id.vars = c("ID", "Model"))

# Heat mapping
library(ggplot2)
result_melted <- result_melted[order(match(result_melted$Model, result_t$Model)), ]

ggplot(result_melted, aes(x = ID, y = reorder(Model, -match(Model, result_t$Model)), fill = value)) +
  geom_tile() +
  scale_fill_gradient(low = "white", high = "red") +
  geom_text(aes(label = round(value, 2)), color = "black", size = 3) +
  labs(title = NULL,
       x = "ID",
       y = "Model",
       fill = "Cindex")+
  theme_bw()+
  theme(legend.position = "top")

ggplot(result_t, aes(x = reorder(Model, mean), y = mean)) +
  geom_bar(stat = "identity", fill = "steelblue") +
  labs(x = "Model", y = "Average Value") +
  theme_minimal()+coord_flip()

##############################################################
#---Model construction and evaluation----
rf_nodesize <- 5
seed <- 1
set.seed(seed)
fit <- rfsrc(Surv(OS.time,OS)~.,data = est_dd,
             ntree = 1000,nodesize = rf_nodesize,
             splitrule = 'logrank',
             importance = T,
             proximity = T,
             forest = T,
             seed = seed)
fit.tcga<-predict(fit,as.data.frame(est_dd))
fit.geo<-predict(fit,as.data.frame(mm$GEO))
tcga$rfs_score<-fit.tcga$predicted
geo$rfs_score<-fit.geo$predicted
tcga$riskgroup<-ifelse(fit.tcga$predicted>median(fit.tcga$predicted),"High","Low")
geo$riskgroup<-ifelse(fit.geo$predicted>median(fit.tcga$predicted),"High","Low")

fits <- survfit(Surv(OS.time, as.numeric(OS)) ~ riskgroup, data=tcga)

ggsurvplot(fits, data = tcga,
           pval = T,
           risk.table = F,
           surv.median.line = "hv", 
           palette=c("red", "blue"),  
           legend.labs=c("High","Low"), 
           legend.title="RiskScore",
           title="Overall survival",
           ylab="Cumulative survival (percentage)",xlab = " Time (Days)", 
           censor.shape = 124,censor.size = 2,conf.int = FALSE, 
           break.x.by = 720
)

fits <- survfit(Surv(OS.time, as.numeric(OS)) ~ riskgroup, data=geo)

ggsurvplot(fits, data = geo,
           pval = T,
           risk.table = F,
           surv.median.line = "hv", 
           palette=c("red", "blue"),  
           legend.labs=c("High","Low"), 
           legend.title="RiskScore",
           title="Overall survival", 
           ylab="Cumulative survival (percentage)",xlab = " Time (Days)", 
           censor.shape = 124,censor.size = 2,conf.int = FALSE, 
           break.x.by = 720
)

##roc curve
library(survivalROC)

roc1<-survivalROC(Stime = tcga$OS.time,
                  status = tcga$OS,
                  marker = tcga$rfs_score,
                  predict.time = 365*1,
                  method = "KM")
roc3<-survivalROC(Stime = tcga$OS.time,
                  status = tcga$OS,
                  marker = tcga$rfs_score,
                  predict.time = 365*3,
                  method = "KM")
roc5<-survivalROC(Stime = tcga$OS.time,
                  status = tcga$OS,
                  marker = tcga$rfs_score,
                  predict.time = 365*5,
                  method = "KM")
cutoff_1year<-roc1$cut.values[which.max(roc1$TP-roc1$FP)]
cutoff_1year


plot(roc1$FP,roc1$TP,
     type="l",col="red",xlim=c(0,1),ylim=c(0,1),
     xlab="FP",
     ylab="TP",
     main="riskscore, method=KM")

abline(0,1,col="gray",lty=2)
lines(roc3$FP,roc3$TP,type = "l",col="green",
      xlim=c(0,1),ylim=c(0,1))
lines(roc5$FP,roc5$TP,type = "l",col="blue",
      xlim=c(0,1),ylim=c(0,1))
legend(0.6,0.2,c(paste("AUC of 1 year=",round(roc1$AUC,3)),
                 paste("AUC of 3 year=",round(roc3$AUC,3)),
                 paste("AUC of 5 year=",round(roc5$AUC,3))),
       x.intersp=1,y.intersp=0.8,
       lty=1,lwd=2,col=c("red","green","blue"),
       bty="n",
       seg.len=1,cex=0.8
)
##roc curve
library(survivalROC)
roc1<-survivalROC(Stime = geo$OS.time,
                  status = geo$OS,
                  marker = geo$rfs_score,
                  predict.time = 365*1,
                  method = "KM")
roc3<-survivalROC(Stime = geo$OS.time,
                  status = geo$OS,
                  marker = geo$rfs_score,
                  predict.time =365*3,
                  method = "KM")
roc5<-survivalROC(Stime = geo$OS.time,
                  status = geo$OS,
                  marker = geo$rfs_score,
                  predict.time = 365*5,
                  method = "KM")

plot(roc1$FP,roc1$TP,
     type="l",col="red",xlim=c(0,1),ylim=c(0,1),
     xlab="FP",
     ylab="TP",
     main="riskscore, method=KM")

abline(0,1,col="gray",lty=2)
lines(roc3$FP,roc3$TP,type = "l",col="green",
      xlim=c(0,1),ylim=c(0,1))
lines(roc5$FP,roc5$TP,type = "l",col="blue",
      xlim=c(0,1),ylim=c(0,1))
legend(0.6,0.2,c(paste("AUC of 1 year=",round(roc1$AUC,3)),
                 paste("AUC of 3 year=",round(roc3$AUC,3)),
                 paste("AUC of 5 year=",round(roc5$AUC,3))),
       x.intersp=1,y.intersp=0.8,
       lty=1,lwd=2,col=c("red","green","blue"),
       bty="n",
       seg.len=1,cex=0.8
)


library(gridExtra)
library(ggplot2)
library(ggpubr)
library(ggplotify)
library(grid)
grid.arrange(p1,p4,p2,p5,as.ggplot(as.grob(p3)),as.ggplot(as.grob(p6)),nrow=3)

#---riskscore Clinical correlation analysis----
library(ggplot2)
library(ggpubr)
library(tidyr)
library(dplyr)
library(gridExtra)
corrdata<-data.frame(Patients=rownames(tcga),riskscore=tcga$rfs_score)
corrdata<-merge(corrdata,tcga_clinical,by="Patients",sort=F)


P1 <- ggboxplot(corrdata,x="age",y="riskscore",
                color = "age",add = "jitter")+
  stat_compare_means(comparisons = list(c("<60",">=60")),
                     label = "p.format",
                     method = "wilcox.test",
                     hide.ns = F,
                     label.x.npc = "center")+
  labs(y="risk score",x= NULL,title = NULL)
print(P1) 


P2 <- ggboxplot(corrdata,x="status",y="riskscore",
                color = "status",add = "jitter")+
  stat_compare_means(comparisons = list(c("Dead","Alive")),
                     label = "p.format",
                     method = "wilcox.test",
                     hide.ns = F,
                     label.x.npc = "center")+
  labs(y="risk score",x= NULL,title = NULL)
print(P2) 

P3 <- ggboxplot(corrdata,x="radiotherapy",y="riskscore",
                color = "radiotherapy",add = "jitter")+
  stat_compare_means(comparisons = list(c("YES","NO")),
                     label = "p.format",
                     method = "wilcox.test",
                     hide.ns = F,
                     label.x.npc = "center")+
  labs(y="risk score",x= NULL,title = NULL)
print(P3) 

P4 <- ggboxplot(corrdata,x="grade",y="riskscore",
                color = "grade",add = "jitter")+
  stat_compare_means(comparisons = list(c("G4","G1"),
                                        c("G4","G2"),
                                        c("G4","G3")),
                     label = "p.format",
                     method = "wilcox.test",
                     hide.ns = F,
                     label.x.npc = "center")+
  labs(y="risk score",x= NULL,title = NULL)
print(P4) 

P5 <- ggboxplot(corrdata,x="chemotherapy",y="riskscore",
                color = "chemotherapy",add = "jitter")+
  stat_compare_means(comparisons = list(c("YES","NO")),
                     label = "p.format",
                     method = "wilcox.test",
                     hide.ns = F,
                     label.x.npc = "center")+
  labs(y="risk score",x= NULL,title = NULL)
print(P5) 

P6 <- ggboxplot(corrdata,x="clinical_stage",y="riskscore",
                color = "clinical_stage",add = "jitter")+
  stat_compare_means(comparisons = list(c("I/II",">=III")),
                     label = "p.format",
                     method = "wilcox.test",
                     hide.ns = F,
                     label.x.npc = "center")+
  labs(y="risk score",x= NULL,title = NULL)
print(P6) 


P7 <- ggboxplot(corrdata,x="T",y="riskscore",
                color = "T",add = "jitter")+
  stat_compare_means(comparisons = list(c("T4","T1"),
                                        c("T4","T2"),
                                        c("T4","T3")),
                     label = "p.format",
                     method = "wilcox.test",
                     hide.ns = F,
                     label.x.npc = "center")+
  labs(y="risk score",x= NULL,title = NULL)
print(P7) 


P8 <- ggboxplot(corrdata,x="N",y="riskscore",
                color = "N",add = "jitter")+
  stat_compare_means(comparisons = list(c("N0","N1"),
                                        c("N0","N2"),
                                        c("N0","N3")),
                     label = "p.format",
                     method = "wilcox.test",
                     hide.ns = F,
                     label.x.npc = "center")+
  labs(y="risk score",x= NULL,title = NULL)
print(P8) 


P9 <- ggboxplot(corrdata,x="M",y="riskscore",
                color = "M",add = "jitter")+
  stat_compare_means(comparisons = list(c("M0","M1")),
                     label = "p.format",
                     method = "wilcox.test",
                     hide.ns = F,
                     label.x.npc = "center")+
  labs(y="risk score",x= NULL,title = NULL)
print(P9) 

grid.arrange(P1,P2,P3,P4,P5,P6,P7,P8,P9, ncol=3,nrow=3)
#---GSEA----
tumor_count<-exp_count[,substr(colnames(exp_count),14,14)=="0"]
colnames(tumor_count)<-substr(colnames(tumor_count),1,12)
tumor_count<-tumor_count[,!duplicated(colnames(tumor_count))]
group<-data.frame(Patients=rownames(tcga),group=tcga$riskgroup)
temp<-tumor_count[,colnames(tumor_count)%in%group$Patients]

temp1<-data.frame(Patients=colnames(temp),No=c(1:ncol(temp)))
temp1<-merge(temp1,group,by="Patients",sort=F)

group<-as.factor(temp1$group)
table(group)
design<-model.matrix(~0+group)
colnames(design)<-levels(group)
row.names(design)<-temp1$Patients
DGElist<-DGEList(counts=temp,group=group)

DGElist<-calcNormFactors(DGElist)

v<-voom(DGElist,design,plot = T,normalize="quantile")
fit<-lmFit(v,design)
constrasts<-paste(rev(levels(group)),collapse = "-")
cont.matrix<-makeContrasts(contrasts = constrasts,levels = design)
fit2=contrasts.fit(fit,cont.matrix)
fit2=eBayes(fit2)

DEG<-topTable(fit2,coef = constrasts,n=Inf)#Extract a table of the top-ranked genes from a linear model fit.
DEG=na.omit(DEG)#Remove rows with missing values on columns specified

fdr=0.05
k1=(DEG$adj.P.Val<fdr)&(DEG$logFC<(-1))
k2=(DEG$adj.P.Val<fdr)&(DEG$logFC>(1))
change=ifelse(k1,"down",ifelse(k2,"up","stable"))
DEG$change<-change

nrow(DEG[DEG$change!="stable",])
save(DEG,file = "DEG_groups.rda")
load("DEG_CLUSTERS.rda")

pdf(file = "vol_groups.pdf",height = 5,width=5)

x_lim<-max(DEG$logFC,-DEG$logFC)
vol_cluster<-ggplot(DEG,aes(logFC,-1*log10(adj.P.Val),color=change))+
  geom_point(size=1)+
  theme_bw()+
  xlim(-x_lim,x_lim)+
  labs(x="log2(FC)",y="-log10(adjP)")+
  scale_color_manual(values=c("#A52A2A","grey","#21766d"))+
  geom_hline(aes(yintercept=-1*log10(0.05)),color="black",linetype="dashed")+
  geom_vline(xintercept = c(-1,1),color="black",linetype="dashed")

print(vol_cluster)
dev.off()

library(clusterProfiler)
library(org.Hs.eg.db)
library(stringr)

DEG$SYMBOL<-rownames(DEG)
gseaDATA<-DEG[,c("logFC","SYMBOL")]


gene<-bitr(gseaDATA[,2],
           fromType = "SYMBOL",
           toType = "ENTREZID",
           OrgDb = "org.Hs.eg.db")


gseaDATA<-as.data.frame(gseaDATA)
gseaDATA<-gseaDATA[(gseaDATA$SYMBOL)%in%(gene$SYMBOL),]

gseaDATA<-merge(gseaDATA,gene,by="SYMBOL")
gseaDATA<-gseaDATA[order(gseaDATA$logFC,decreasing = T),]
gsea<-gseaDATA$logFC
names(gsea)<-gseaDATA$ENTREZID

head(gsea)

GO <- gseGO(
  gsea, #gsea
  ont = "BP",
  OrgDb = org.Hs.eg.db,
  keyType = "ENTREZID",
  pvalueCutoff = 0.05,
  pAdjustMethod = "BH",
)
kegg<-gseKEGG(
  gsea,
  organism = "hsa",
  keyType = "kegg",
  exponent = 1,
  minGSSize = 10,
  maxGSSize = 500,
  eps = 1e-10,
  pvalueCutoff = 0.05,
  pAdjustMethod = "BH",
  verbose = TRUE,
  use_internal_data = FALSE,
  seed = FALSE,
  by = "fgsea"
)
go_gsea<-dotplot(GO,split=".sign",color="pvalue",showCategory=8)+facet_grid(~.sign)  
kegg_gsea<-dotplot(kegg,split=".sign",color="pvalue",showCategory=8)+facet_grid(~.sign)  

grid.arrange(go_gsea,kegg_gsea,nrow=1)
save(GO,kegg,file = "gsea.rda")

#--- immune infiltration----
library(e1071)
library(preprocessCore)
library(parallel)
library(devtools)

library(bseqsc)
library(CIBERSORT)
library(reshape2)
library(dplyr)

library(ggplot2)
library(pheatmap)
library(ggpubr)

group<-data.frame(Patients=rownames(tcga),group=tcga$riskgroup)
hgroup<-group[group$group=="High",]$Patients
lgroup<-group[group$group=="Low",]$Patients
fpc_high<-tumor_fpkm[,colnames(tumor_fpkm)%in%hgroup]
fpc_low<-tumor_fpkm[,colnames(tumor_fpkm)%in%lgroup]

fpc_high<-as.matrix(fpc_high)
fpc_low<-as.matrix(fpc_low)

results_high <- cibersort(sig_matrix = LM22, mixture_file = fpc_high)
results_low <- cibersort(sig_matrix = LM22, mixture_file = fpc_low)


cluster1_if<-as.data.frame(results_high[,1:ncol(LM22)])
cluster1_if$group<-c(rep("high_risk",nrow(results_high)))
cluster2_if<-as.data.frame(results_low[,1:ncol(LM22)])
cluster2_if$group<-c(rep("low_risk",nrow(results_low)))
all<-rbind(cluster1_if,cluster2_if)
all$sample<-rownames(all)
all_new<-melt(all)
colnames(all_new)<-c("Group","Sample","Celltype","Composition")
head(all_new)

if(T){
  mytheme <- theme(plot.title = element_text(size = 12,color="black",hjust = 0.5),
                   axis.title = element_text(size = 12,color ="black"), 
                   axis.text = element_text(size= 12,color = "black"),
                   panel.grid.minor.y = element_blank(),
                   panel.grid.minor.x = element_blank(),
                   axis.text.x = element_text(angle = 45, hjust = 1 ),
                   panel.grid=element_blank(),
                   legend.position = "top",
                   legend.text = element_text(size= 12),
                   legend.title= element_text(size= 12)
  ) }

ggplot(all_new, aes(x = Celltype, y = Composition))+ 
  labs(y="Cell composition",x= NULL,title = NULL)+  
  geom_boxplot(aes(fill = Group),position=position_dodge(0.5),width=0.5,outlier.alpha = 0)+ 
  scale_fill_manual(values = c("#7FABD2", "#FFA57F"))+
  theme_classic() + mytheme + 
  stat_compare_means(aes(group =  Group),
                     label = "p.signif",
                     method = "wilcox.test",
                     hide.ns = F)


TCGA_TME_four = as.data.frame(results_high[,1:20])
immCell_four_type <- read.table("Cibersort_four_types.txt", header = T, row.names = NULL, sep = "\t")
colnames(TCGA_TME_four) == immCell_four_type$Immune.cells 

all_new2<-all_new
colnames(all_new2) = c("Group","Sample","Immune.cells","Composition")
all_new3 = left_join(all_new2, immCell_four_type, by = "Immune.cells") %>% 
  group_by(Sample,Group,Types) %>%
  summarize(Sum = sum(Composition))
all_new3<-subset(all_new3,Types!="NA")


ggplot(all_new3, aes(x = Group, y = Sum))+ 
  labs(y="Cell composition",x= NULL,title = "TCGA")+  
  geom_boxplot(aes(fill = Group),position=position_dodge(0.5),width=0.5,size=0.4,
               outlier.alpha = 1, outlier.size = 0.5)+ 
  theme_bw() + mytheme + 
  scale_fill_manual(values = c("#0000FF", "#FFA500"))+ 
  scale_y_continuous(labels = scales::percent)+
  facet_wrap(~ Types,scales = "free",ncol = 4) + 
  stat_compare_means(aes(group =  Group),
                     label = "p.format",
                     method = "wilcox.test",
                     size = 3.5,
                     hide.ns = T)


library(tidyverse)
library(corrplot)
group<-data.frame(patients=rownames(tcga),group=tcga$rfs_score)
cordata<-rbind(cluster1_if,cluster2_if)
cordata$patients<-rownames(cordata)
cordata<-merge(cordata,group,by="patients",sort=F)
cordata<-cordata[,c(2:23,25)]
colnames(cordata)[23]<-"riskscore"
corr<-cor(cordata)

corrplot(corr,order = "original",
             method = "ellipse",type = "lower",
             tl.col = "black",tl.cex = 0.8)


cgroup<-clusters
cgroup$consensusClass<-ifelse(cgroup$consensusClass==1,"cluster1","cluster2")
hgroup<-cgroup[cgroup$consensusClass=="cluster1",]$Patients
lgroup<-cgroup[cgroup$consensusClass=="cluster2",]$Patients
fpc_high<-tumor_fpkm[,colnames(tumor_fpkm)%in%hgroup]
fpc_low<-tumor_fpkm[,colnames(tumor_fpkm)%in%lgroup]

fpc_high<-as.matrix(fpc_high)
fpc_low<-as.matrix(fpc_low)

results_high <- cibersort(sig_matrix = LM22, mixture_file = fpc_high)
results_low <- cibersort(sig_matrix = LM22, mixture_file = fpc_low)


cluster1_if<-as.data.frame(results_high[,1:ncol(LM22)])
cluster1_if$group<-c(rep("cluster1",nrow(results_high)))
cluster2_if<-as.data.frame(results_low[,1:ncol(LM22)])
cluster2_if$group<-c(rep("cluster2",nrow(results_low)))
all<-rbind(cluster1_if,cluster2_if)
all$sample<-rownames(all)
all_new<-melt(all)
colnames(all_new)<-c("Group","Sample","Celltype","Composition")
head(all_new)

if(T){
  mytheme <- theme(plot.title = element_text(size = 12,color="black",hjust = 0.5),
                   axis.title = element_text(size = 12,color ="black"), 
                   axis.text = element_text(size= 12,color = "black"),
                   panel.grid.minor.y = element_blank(),
                   panel.grid.minor.x = element_blank(),
                   axis.text.x = element_text(angle = 45, hjust = 1 ),
                   panel.grid=element_blank(),
                   legend.position = "top",
                   legend.text = element_text(size= 12),
                   legend.title= element_text(size= 12)
  ) }
pdf("cluster_tme.pdf")
p <- ggplot(all_new, aes(x = Celltype, y = Composition))+ 
  labs(y="Cell composition",x= NULL,title = NULL)+  
  geom_boxplot(aes(fill = Group),position=position_dodge(0.5),width=0.5,outlier.alpha = 0)+ 
  scale_fill_manual(values = c("#8B008B", "#FFA500"))+
  theme_classic() + mytheme + 
  stat_compare_means(aes(group =  Group),
                     label = "p.signif",
                     method = "wilcox.test",
                     hide.ns = F)
print(p)
dev.off()
#---drug sensitivity----
BiocManager::install(c("car", "ridge", "preprocessCore", "genefilter", "sva"))
install.packages("pRRophetic_0.5.tar.gz", repos = NULL, dependencies = TRUE) 
library(pRRophetic)
library(sva)
library(car)
library(genefilter)
library(preprocessCore)
library(ridge)
library(ggplot2)
library(ggpubr)
library(survminer)

drugs<-c("Carboplatin",
         "Cisplatin",
         "5FU",
         "Cetuximab",
         "Xeloda",
         "Taxol",
         "Lapatinib",
         "Oxaliplatin",
         "Gemcitabine",
         "Taxotere",
         "Docetaxel",
         "VECTIBIX",
         "ERBITUX",
         "Everolimus",
         "panitumumab",
         "Methotrexate",
         "Paclitaxel",
         "Alimta",
         "Bevacizumab",
         "Pemetrexed",
         "Carboplatinum",
         "Irinotecan",
         "IRESSA",
         "Palixtaxel",
         "Fluorouracil",
         "5-fluorouracil",
         "5-FU",
         "Eribulin")
possibleDrugs <- c("A.443654", "A.770041", "ABT.263", "ABT.888", "AG.014699", 
                   "AICAR", "AKT.inhibitor.VIII", "AMG.706", "AP.24534", 
                   "AS601245", "ATRA", "AUY922", "Axitinib", "AZ628", 
                   "AZD.0530", "AZD.2281", "AZD6244", "AZD6482", "AZD7762",
                   "AZD8055", "BAY.61.3606", "Bexarotene", "BI.2536", 
                   "BIBW2992", "Bicalutamide", "BI.D1870", "BIRB.0796", 
                   "Bleomycin", "BMS.509744", "BMS.536924", "BMS.708163",
                   "BMS.754807", "Bortezomib", "Bosutinib", "Bryostatin.1",
                   "BX.795", "Camptothecin", "CCT007093", "CCT018159",
                   "CEP.701", "CGP.082996", "CGP.60474", "CHIR.99021", 
                   "CI.1040", "Cisplatin", "CMK", "Cyclopamine", "Cytarabine", 
                   "Dasatinib", "DMOG", "Docetaxel", "Doxorubicin", "EHT.1864", 
                   "Elesclomol", "Embelin", "Epothilone.B", "Erlotinib", 
                   "Etoposide", "FH535", "FTI.277", "GDC.0449", "GDC0941",
                   "Gefitinib", "Gemcitabine", "GNF.2", "GSK269962A",
                   "GSK.650394", "GW.441756", "GW843682X", "Imatinib", 
                   "IPA.3", "JNJ.26854165", "JNK.9L", "JNK.Inhibitor.VIII",
                   "JW.7.52.1", "KIN001.135", "KU.55933", "Lapatinib", 
                   "Lenalidomide", "LFM.A13", "Metformin", "Methotrexate", 
                   "MG.132", "Midostaurin", "Mitomycin.C", "MK.2206", "MS.275",
                   "Nilotinib", "NSC.87877", "NU.7441", "Nutlin.3a", 
                   "NVP.BEZ235", "NVP.TAE684", "Obatoclax.Mesylate", 
                   "OSI.906", "PAC.1", "Paclitaxel", "Parthenolide", 
                   "Pazopanib", "PD.0325901", "PD.0332991", "PD.173074",
                   "PF.02341066", "PF.4708671", "PF.562271", "PHA.665752",
                   "PLX4720", "Pyrimethamine", "QS11", "Rapamycin",
                   "RDEA119", "RO.3306", "Roscovitine", "Salubrinal", 
                   "SB.216763", "SB590885", "Shikonin", "SL.0101.1",
                   "Sorafenib", "S.Trityl.L.cysteine", "Sunitinib", 
                   "Temsirolimus", "Thapsigargin", "Tipifarnib", "TW.37",
                   "Vinblastine", "Vinorelbine", "Vorinostat", "VX.680",
                   "VX.702", "WH.4.023", "WO2009093972", "WZ.1.84", 
                   "X17.AAG", "X681640", "XMD8.85", "Z.LLNle.CHO", "ZM.447439")
drugs<-drugs[drugs%in%possibleDrugs]


source("compute_phenotype_function.R")
source("predict_from_cgp.R")
source("classification_function.R")
source("do_variable_selection.R")
source("homogenize_data.R")
source("summarizeGenesByMean.R")


chedata<-tumor_fpkm[,colnames(tumor_fpkm)%in%rownames(tcga)]


groups<-data.frame(patients=colnames(chedata),no=c(1:ncol(chedata)))
cluster<-data.frame(patients=rownames(tcga),group=tcga$riskgroup)
groups<-merge(groups,cluster,by="patients",sort=F)
group<-groups$group
table(group)

all_zero_genes <- apply(chedata, 1, function(x) all(x == 0))
chedata <- chedata[!all_zero_genes, ]
chedata<-as.matrix(chedata)
#cycles for calculating drug sensitivities
l<-length(drugs)
results<-data.frame()
for (i in 1:l) {
  predictedPtype <- pRRopheticPredict(testMatrix=chedata, #expression data
                                      drug=drugs[i],#drug
                                      tissueType = "all", 
                                      batchCorrect = "eb",
                                      selection=1)
  df<-as.data.frame(cbind(predictedPtype,group))
  df$drug<-rep(drugs[i],439)
  results<-rbind(results,df)
}

results$predictedPtype<-as.numeric(results$predictedPtype)
colnames(results)[1]="value"
results1<-results[!is.na(results$value),]


ggplot(results1, aes(x = drug, y = value))+ 
  labs(y="Predicted Sensitivity",x= NULL,title = NULL)+  
  geom_violin(aes(fill = group),position=position_dodge(0.5),width=0.5,outlier.alpha = 0)+ 
  scale_fill_manual(values = c("#FF5733", "#6B8E23"))+
  theme_classic() + 
  stat_compare_means(aes(group =  group),
                     label = "p.signif",
                     method = "wilcox.test",
                     hide.ns = F)


average<-mean(as.matrix(tumor_fpkm))
group<-data.frame(Patients=rownames(tcga),group=tcga$riskgroup)
hgroup<-group[group$group=="High",]$Patients
lgroup<-group[group$group=="Low",]$Patients
fpc_high<-tumor_fpkm[,colnames(tumor_fpkm)%in%hgroup]
fpc_low<-tumor_fpkm[,colnames(tumor_fpkm)%in%lgroup]

fpc_high<-as.matrix(fpc_high)
fpc_low<-as.matrix(fpc_low)

high_tide<-fpc_high-average
low_tide<-fpc_low-average

write.table(high_tide,file = "exp_high_tide.txt",sep = "\t")
write.table(low_tide,file = "exp_low_tide.txt",sep = "\t")


write.csv(hgroup,file = "high_patients.csv")
write.csv(lgroup,file = "low_patients.csv")


tide_high<-read.csv("tide_high.csv",header = T)
tide_low<-read.csv("tide_low.csv",header = T)
tide_high$group<-rep("high",nrow(tide_high))
tide_low$group<-rep("low",nrow(tide_low))

tide_data<-rbind(tide_high,tide_low)



color=c("#FFA500","#008080")
tide_plot<-ggplot(tide_data,aes(x=group,y=TIDE,fill=group))+
  geom_violin()+
  geom_boxplot(width=0.2,position = position_dodge(0.9),outlier.color = NA,fill="white")+
  theme_bw()+
  theme(legend.position="none",
        axis.text.x = element_text(hjust = 0.5, vjust = 0.5),
        axis.text.y = element_text(hjust = 0.5, vjust = 0.5),
        panel.grid.major = element_blank(), 
        panel.grid.minor = element_blank(),
        axis.title.x = element_blank(),
        axis.title.y = element_text( size=rel(1)),
        panel.border = element_blank(),
        axis.line = element_line(colour = "black",size=1)
  )+scale_fill_manual(values = color)+
  stat_compare_means( comparisons = list(c("high","low")),
                      label = "p.signif")

dysfunction<-ggplot(tide_data,aes(x=group,y=Dysfunction,fill=group))+
  geom_violin()+
  geom_boxplot(width=0.2,position = position_dodge(0.9),outlier.color = NA,fill="white")+
  theme_bw()+
  theme(legend.position="none",
        axis.text.x = element_text(hjust = 0.5, vjust = 0.5),
        axis.text.y = element_text(hjust = 0.5, vjust = 0.5),
        panel.grid.major = element_blank(), 
        panel.grid.minor = element_blank(),
        axis.title.x = element_blank(),
        axis.title.y = element_text( size=rel(1)),
        panel.border = element_blank(),
        axis.line = element_line(colour = "black",size=1)
  )+scale_fill_manual(values = color)+
  stat_compare_means( comparisons = list(c("high","low")),
                      label = "p.signif")
print(dysfunction)
exclusion<-ggplot(tide_data,aes(x=group,y=Exclusion,fill=group))+
  geom_violin()+
  geom_boxplot(width=0.2,position = position_dodge(0.9),outlier.color = NA,fill="white")+
  theme_bw()+
  theme(legend.position="none",
        axis.text.x = element_text(hjust = 0.5, vjust = 0.5),
        axis.text.y = element_text(hjust = 0.5, vjust = 0.5),
        panel.grid.major = element_blank(), 
        panel.grid.minor = element_blank(),
        axis.title.x = element_blank(),
        axis.title.y = element_text( size=rel(1)),
        panel.border = element_blank(),
        axis.line = element_line(colour = "black",size=1)
  )+scale_fill_manual(values = color)+
  stat_compare_means( comparisons = list(c("high","low")),
                      label = "p.signif")
print(exclusion)

merk18_plot<-ggplot(tide_data,aes(x=group,y=Merck18,fill=group))+
  geom_violin()+
  geom_boxplot(width=0.2,position = position_dodge(0.9),outlier.color = NA,fill="white")+
  theme_bw()+
  theme(legend.position="none",
        axis.text.x = element_text(hjust = 0.5, vjust = 0.5),
        axis.text.y = element_text(hjust = 0.5, vjust = 0.5),
        panel.grid.major = element_blank(), 
        panel.grid.minor = element_blank(),
        axis.title.x = element_blank(),
        axis.title.y = element_text( size=rel(1)),
        panel.border = element_blank(),
        axis.line = element_line(colour = "black",size=1)
  )+scale_fill_manual(values = color)+
  stat_compare_means( comparisons = list(c("high","low")),
                      label = "p.signif")
CAF_plot<-ggplot(tide_data,aes(x=group,y=CAF,fill=group))+
  geom_violin()+
  geom_boxplot(width=0.2,position = position_dodge(0.9),outlier.color = NA,fill="white")+
  theme_bw()+
  theme(legend.position="none",
        axis.text.x = element_text(hjust = 0.5, vjust = 0.5),
        axis.text.y = element_text(hjust = 0.5, vjust = 0.5),
        panel.grid.major = element_blank(), 
        panel.grid.minor = element_blank(),
        axis.title.x = element_blank(),
        axis.title.y = element_text( size=rel(1)),
        panel.border = element_blank(),
        axis.line = element_line(colour = "black",size=1)
  )+scale_fill_manual(values = color)+
  stat_compare_means( comparisons = list(c("high","low")),
                      label = "p.signif")

TAM_plot<-ggplot(tide_data,aes(x=group,y=TAM.M2,fill=group))+
  geom_violin()+
  geom_boxplot(width=0.2,position = position_dodge(0.9),outlier.color = NA,fill="white")+
  theme_bw()+
  theme(legend.position="none",
        axis.text.x = element_text(hjust = 0.5, vjust = 0.5),
        axis.text.y = element_text(hjust = 0.5, vjust = 0.5),
        panel.grid.major = element_blank(), 
        panel.grid.minor = element_blank(),
        axis.title.x = element_blank(),
        axis.title.y = element_text( size=rel(1)),
        panel.border = element_blank(),
        axis.line = element_line(colour = "black",size=1)
  )+scale_fill_manual(values = color)+
  stat_compare_means( comparisons = list(c("high","low")),
                      label = "p.signif")

colnames(tide_data)[1]="patients"
riskscores<-data.frame(patients=rownames(tcga),riskscore=tcga$rfs_score)
data<-merge(tide_data,riskscores,by="patients",sort=F)
P1 <- ggboxplot(data,x="Responder",y="riskscore",
                color = "Responder",add = "jitter")+
  stat_compare_means(comparisons = list(c("False","True")),
                     label = "p.format",
                     method = "wilcox.test",
                     hide.ns = F,
                     label.x.npc = "center")+
  labs(y="risk score",x= NULL,title = NULL)
print(P1) 
grid.arrange(P1,tide_plot,CAF_plot,merk18_plot,dysfunction,exclusion,nrow=2)



colnames(tide_data)[1]="patients"
tide_data1<-merge(tide_data,riskscores,by="patients",sort=F)
tide_data1<-tide_data1[,c(4:9,11:15,17)]
corr_tide<-cor(tide_data1)
pdf("cor_riskscore_immut.pdf")
p2<-corrplot(corr_tide,order = "hclust",
             method = "ellipse",type = "lower",
             tl.col = "black",tl.cex = 0.8)
print(p2)
dev.off()

tica_C1<-read_delim("TCIA-ClinicalData_high.tsv",delim="\t")
tica_C2<-read_delim("TCIA-ClinicalData_low.tsv",delim = "\t")
mycols<-c("ips_ctla4_neg_pd1_neg",
          "ips_ctla4_neg_pd1_pos",
          "ips_ctla4_pos_pd1_neg",
          "ips_ctla4_pos_pd1_pos")
tica_C1<-tica_C1[,colnames(tica_C1)%in%mycols]
tica_C2<-tica_C2[,colnames(tica_C2)%in%mycols]
tica_C1$group<-rep("cluster1",nrow(tica_C1))
tica_C2$group<-rep("cluster2",nrow(tica_C2))
tica_data<-rbind(tica_C1,tica_C2)
library(reshape2)
tica_data<-melt(tica_data)

ggplot(tica_data, aes(x = variable, y = value,fill=group))+ 
  labs(y="IPS",x= NULL,title = NULL)+  
  geom_violin() +
  scale_fill_manual(values = c("#f9c2ff", "#87cefa"))+
  theme_classic() + 
  stat_compare_means(aes(group =  group),
                     label = "p.signif",
                     method = "wilcox.test",
                     hide.ns = F)


#---nomogram----

library(rms)
library(survival)
library(survminer)
library(rmda)
library(survival)
library(stringr)

nomodata<-data.frame(Patients=rownames(tcga),riskscore=tcga$rfs_score)
nomodata<-merge(nomodata,tcga_clinical,by="Patients",sort=F)
nomodata$status<-ifelse(nomodata$status=="Dead",1,0)
nomodata$N<-ifelse(nomodata$N=="NX","N3",nomodata$N)
write.csv(nomodata,file = "nomodata.csv")
save(nomodata,file = "nomodata.rda")
load("nomodata.rda")

ddist<-datadist(nomodata)
options(datadist='ddist')
#multivariate cox regression analysis
model<-coxph(Surv(days,status)~riskscore+
               age+
               grade+
               chemotherapy+
               radiotherapy+
               clinical_stage+
               T+N+M,data=nomodata)
pdf("mulCox.pdf",height = 5,width = 5)
ggforest(model,data = nomodata)
dev.off()

f<-cph(Surv(days,status) ~ riskscore+age+grade+radiotherapy,
       x=T,y=T,surv=T,
       data=nomodata,time.inc=365*1)

surv<-Survival(f)
surv1<-function(x)surv(365*1,lp=x)
surv2<-function(x)surv(365*2,lp=x)
surv3<-function(x)surv(365*3,lp=x)


nomo<-nomogram(f,
               fun=list(surv1,surv2,surv3),
               funlabel=c("1-year survival",
                          "2-year surviavl",
                          "3-year survival"),
               lp=F,
               maxscale=100,
               fun.at=c(0.99,0.9,0.7,0.5,0.3,0.1))
pdf(file = "nomogram.pdf",height = 5,width = 5)
plot(nomo,
     xfrac=0.55,
     cex.var=1,
     cex.axis=0.8,
     tcl=-0.5,
     lmgp=0.3,
     label.every=1,
     naxes=13,
     col.grid=gray(c(0.8,0.95)),
     lplabel="Cox predictorlp",
     points.label="points",
     total.points.label="Total Points",
     force.label=T)
dev.off()
f
nom

cal<-calibrate(f,cmethod='KM',method="boot",
               u=365*1, 
               m=110,
               B=1000)


f3<-cph(Surv(days,status) ~ riskscore+N+
          radiotherapy,
        x=T,y=T,surv=T,
        data=nomodata,time.inc=365*3)
cal3<-calibrate(f3,cmethod='KM',method="boot",
                u=365*3, 
                m=110,
                B=1000)


f5<-cph(Surv(days,status) ~ riskscore+N+
          radiotherapy,
        x=T,y=T,surv=T,
        data=nomodata,time.inc=365*5)
cal5<-calibrate(f5,cmethod='KM',method="boot",
                u=365*5, 
                m=110,
                B=1000)



plot(cal,lwd=2,lty=1,
     conf.int=T,
     errbar.col="#2166AC",
     col="#2166AC",
     xlim=c(0,1),
     ylim=c(0,1),
     xlab="Nomogram-predicted OS (%)",
     ylab="Observed OS (%)",
     subtitle=F)
plot(cal3,lwd=2,lty=1,
     conf.int=T,
     errbar.col="#B2182b",
     col="#B2182b",
     xlim=c(0,1),
     ylim=c(0,1),
     subtitle=F,
     add=T)
plot(cal5,lwd=2,lty=1,
     conf.int=T,
     errbar.col="#224444",
     col="#224444",
     xlim=c(0,1),
     ylim=c(0,1),
     subtitle=F,
     add=T)
legend("topleft", 
       legend = c("1-year","3-year","5-year"),
       col =c("#2166AC","#B2182B","#224444"),
       lwd = 2,
       cex = 1.2,
       bty = "n")




dca_nomogram<-decision_curve(status~riskscore+age+grade+radiotherapy,data = nomodata,
                             thresholds = seq(0,1,by=.01),
                             study.design = 'cohort',
                             bootstraps = 10)
dca_grade<-decision_curve(status~grade,data = nomodata,
                          thresholds = seq(0,1,by=.01),
                          study.design = 'cohort',
                          bootstraps = 10)
dca_radiotherapy<-decision_curve(status~radiotherapy,data = nomodata,
                                 thresholds = seq(0,1,by=.01),
                                 study.design = 'cohort',
                                 bootstraps = 10)
dca_age<-decision_curve(status~age,data = nomodata,
                        thresholds = seq(0,1,by=.01),
                        study.design = 'cohort',
                        bootstraps = 10)
dca_riskscore<-decision_curve(status~riskscore,data = nomodata,
                              thresholds = seq(0,1,by=.01),
                              study.design = 'cohort',
                              bootstraps = 10)

plot_decision_curve(list(dca_nomogram,
                         dca_grade,
                         dca_riskscore,
                         dca_radiotherapy,
                         dca_age),
                    curve.names = c("nomogram","grade","riskscore","radiotherapy","age"),
                    col = c("#6E5B9C","#DAA520","#00CED1","#c5a0d9","#62b8c7"),
                    lty = c(1,1,1,1,1),
                    lwd = c(2,2,2,2,2),
                    legend.position = "topright",
                    confidence.intervals = FALSE,
                    cost.benefit.axis = FALSE,
                    xlim = c(0,1))