##--------------------------------##
setwd("F:/")
library(pheatmap)
library(ggplot2)
library(ggrepel)
library(limma)
load("GSE.exp.rda")
logFoldChange=0
adjustP=0.01

datGroup <- read.table("GSE183533_sample.txt",sep="\t",header=T,check.names=F,quote = "")
datGroup$Tissue <- ifelse(datGroup$source == "normal human lung", "Control", "COVID19")
datGroup <- datGroup[,c("ID_REF", "Tissue")];colnames(datGroup) <- c("Acc", "Tissue")
normSam <- datGroup[datGroup$Tissue == "Control",]$Acc
exp=GSE.exp$`GSE183533-GPL24676`
exp <- exp[,colnames(exp) %in% datGroup$Acc]
dimnames=list(rownames(exp),colnames(exp))
rt=matrix(as.numeric(as.matrix(exp)),nrow=nrow(exp),dimnames=dimnames)
rt=avereps(rt)
rt=normalizeBetweenArrays(as.matrix(rt));max(rt)
rt=log2(rt+1);max(rt)

modType=ifelse(colnames(rt) %in% normSam,"Normal","Tumor")
design <- model.matrix(~0+factor(modType))
colnames(design) <- levels(factor(modType))
fit <- lmFit(rt,design)
my_comparisons <- c("Tumor-Normal")
cont.matrix<-makeContrasts(my_comparisons,levels=design)
fit2 <- contrasts.fit(fit, cont.matrix)
fit2 <- eBayes(fit2)

allDiff=topTable(fit2,adjust='fdr',number=200000)
write.table(allDiff,file="limmaTab.xls",sep="\t",quote=F)
diffSig <- allDiff[with(allDiff, (adj.P.Val < adjustP )), ]
write.table(cbind(Symbol=rownames(diffSig),diffSig),file="diff.xls",row.names = F,sep="\t",quote=F)
diffUp <- allDiff[with(allDiff, (logFC>logFoldChange & adj.P.Val  < adjustP )), ]#
write.table(cbind(Symbol=rownames(diffUp),diffUp),file="up.xls",row.names = F,sep="\t",quote=F)
diffDown <- allDiff[with(allDiff, (logFC<(-logFoldChange) & adj.P.Val  < adjustP )), ]#
write.table(cbind(Symbol=rownames(diffDown),diffDown),file="down.xls",row.names = F,sep="\t",quote=F)

DiffRes <- list(allDiff=allDiff,
                diffSig=diffSig,
                diffUp=diffUp,
                diffDown=diffDown)
save(DiffRes,file = "DiffRes.rda")#load("DiffRes.rda")
##---##
GeneSet=read.csv("GeneCards-SearchResults.csv")
dim(GeneSet)
head(GeneSet)
Dat <- allDiff
Dat$threshold <- factor(ifelse(Dat$adj.P.Val < adjustP & abs(Dat$logFC) >logFoldChange,
                               ifelse(Dat$logFC > logFoldChange ,'Up','Down'),'NoSignifi'),levels=c('Up','Down','NoSignifi'))
Dat$lab <- ""
Dat[order(Dat$logFC),][c(1:10,(nrow(Dat)-9):nrow(Dat)),]$lab <- rownames(Dat[order(Dat$logFC),][c(1:10,(nrow(Dat)-9):nrow(Dat)),])

p <- ggplot(Dat,aes(x=logFC,y=-log10(adj.P.Val),color=threshold))+
  geom_point(alpha=0.4, size=2,)+
  scale_color_manual(values=c("#DC143C","#00008B","#808080"))+
  geom_text_repel(data = Dat,
                  aes(x=logFC,y=-log10(adj.P.Val),label = lab),
                  size = 4, box.padding = unit(0.5, "lines"),
                  point.padding = unit(0.8, "lines"),segment.color = "black", show.legend = F)+
  theme_bw()+
  theme(legend.title = element_blank())+
  ylab('-log10 (adj.P.Val)')+
  xlab('log2 (logFC)')+
  geom_vline(xintercept=c(-logFoldChange,logFoldChange),lty=3,col="black",lwd=0.5) +
  geom_hline(yintercept = -log10(adjustP),lty=3,col="black",lwd=0.5)
ggsave(p, filename = "Volcano.pdf", width = 15, height = 12)

##-----##
datGroup <- datGroup[order(datGroup$Tissue),]
annCol <- data.frame(Group = datGroup$Tissue,
                     row.names = datGroup$Acc,
                     stringsAsFactors = F)
annColors <- list("Group"=c("Control"="#1AFD02",
                            "COVID19"="#FD8602"))
plotdata <- rt[rownames(rt) %in% rownames(diffSig),]
plotdata <- t(scale(t(plotdata)))
plotdata[plotdata > 1] <- 1
plotdata[plotdata < -1] <- -1
pdf(file="Heatmap.pdf",width = 8,height = 5)
pheatmap(plotdata,
         scale = "none",
         #annotation_row=annRow, 
         annotation_col=annCol, 
         annotation_colors = annColors,
         color = colorRampPalette(c("navy", "white", "firebrick3"))(20),
         #color = greenred(64),
         fontsize_row=12,
         fontsize_col=8,
         fontsize=12,
         cluster_cols = F,
         cluster_rows = T,
         show_rownames = F,
         show_colnames = F)
dev.off()

##---##
load("DiffRes.rda")
GeneSet=read.csv("GeneCards-SearchResults.csv")
dim(GeneSet)
head(GeneSet)

jco <- c("#2874C5","#EABF00","#868686","#C6524A","#80A7DE")
length(intersect(GeneSet$Gene.Symbol,rownames(DiffRes$diffSig)))

DEG_FM <- intersect(GeneSet$Gene.Symbol,rownames(DiffRes$diffSig))
save(DEG_FM,file = "DEG_FM.rda")#load("DEG_FM.rda")

library(VennDiagram)
T <- venn.diagram(list(FructoseMetabolism=GeneSet$Gene.Symbol,
                       DEG=rownames(DiffRes$diffSig)),
                  filename=NULL,lwd=1,lty=2,
                  col=jco[1:2],fill=jco[1:2],
                  cat.col=jco[1:2],rotation.degree=0)
pdf("Venn.pdf",width = 8,height = 8)
grid.draw(T)
dev.off()

setwd("F:/")
library(clusterProfiler)
library(enrichplot)
library(ggplot2)
library(org.Hs.eg.db)
library(R.utils)

#---------------#
load("DEG_FM.rda")
genes <- unique(DEG_FM);length(genes)


entrezIDs <- mget(genes, org.Hs.egSYMBOL2EG, ifnotfound=NA)
outTab <- NULL
for (i in names(entrezIDs)) {
  tmp1 <- as.character(entrezIDs[[i]])
  tmp2 <- data.frame(Symbol=i,entrezID=tmp1)
  outTab <- rbind(outTab,tmp2)
}
write.table(outTab,file="id.txt",sep="\t",quote=F,row.names=T)
###
rt=read.table("id.txt",sep="\t",header=T,check.names=F)
rt=rt[is.na(rt[,"entrezID"])==F,]
gene=rt$entrezID

kk <- enrichGO(gene = gene, OrgDb = org.Hs.eg.db, pvalueCutoff =0.05, qvalueCutoff = 1, ont="ALL", readable =T)
write.table(kk,file="GO.txt",sep="\t",quote=F,row.names = F)
#
pdf(file="GObarplot.pdf",width = 7,height = 7)
barplot(kk, drop = TRUE, showCategory =5,split="ONTOLOGY") + facet_grid(ONTOLOGY~., scale='free')
dev.off()
pdf(file="GObubble.pdf",width = 7,height = 7)
dotplot(kk,showCategory = 5,split="ONTOLOGY") + facet_grid(ONTOLOGY~., scale='free')
dev.off()

kk <- enrichKEGG(gene = gene, organism = "hsa", pvalueCutoff =0.05, qvalueCutoff =0.05)
write.table(kk,file="KEGG.txt",sep="\t",quote=F,row.names = F)
#
pdf(file="KEGGbarplot.pdf",width = 8,height = 7)
barplot(kk, drop = TRUE, showCategory = 15)
dev.off()
pdf(file="KEGGbubble.pdf",width = 8,height = 7)
dotplot(kk, showCategory = 15)
dev.off()

setwd("F:/")
library(reshape2)
library(ggplot2)
library(ggpubr)

Data <- read.table("CIBERSORT-Results.txt",row.names = 1,sep="\t",header=T,check.names=F,quote = "")
head(Data)
Data <- Data[,setdiff(colnames(Data), c("P-value", "Correlation", "RMSE"))]
Data$Acc <- rownames(Data)
dim(Data)
head(Data)

RiskGroup <- read.table("risk.txt",sep = "\t",check.names = F,stringsAsFactors = F,header = T,quote = "")
colnames(RiskGroup)[1] <- "Acc"
data_p <- dplyr::inner_join(Data, RiskGroup, by = c("Acc"))
data_p <- melt(data_p, id.vars = colnames(RiskGroup))
head(data_p)

p <- ggplot(data_p,
            aes(x=variable, y=value, 
                fill = riskgroup,
                color = riskgroup)) + 
  geom_boxplot(notch = F, alpha = 0.95, 
               outlier.shape = 16,
               outlier.size = 0.65) +
  xlab("") + ylab("Fraction") +
  scale_fill_manual(values= c("#D5EBFB","#FBEEB7","#B4FBCD","#F5B3FC")) +
  scale_color_manual(values= c("#0073C2","#EFC000","#00C244","#C501D7")) +
  ggtitle("") + 
  theme_classic() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1,size = 10), 
        axis.text.y = element_text(angle = 90, size = 12),
        axis.title.y = element_text(angle = 90, size = 15)) +
  theme(legend.position = "top") +
  stat_compare_means(method ="wilcox.test",hide.ns = TRUE,label = "p.signif")
ggsave(p, filename = "CIBERSORT ~ RiskGroup.pdf", width = 12, height = 6)

##
library(Hmisc)

##-----##
rownames(Data) <- Data$Acc
tmp <- Data[,setdiff(colnames(Data), colnames(RiskGroup))]
res <- rcorr(as.matrix(tmp))
res_1 <- melt(res$r)
colnames(res_1) <- c("row", "column", "cor")
res_2 <- melt(res$P)
colnames(res_2) <- c("row", "column", "p")
result_1 <- dplyr::inner_join(res_1,res_2,by=c("row", "column"))
head(result_1)
data <- result_1
data$pv <- ""
data[which(data$p < 0.05),]$pv <- "*"
data[which(data$p < 0.01),]$pv <- "**"
data[which(data$p < 0.001),]$pv <- "***"

p <- ggplot(data,aes(x=row,y=column)) +
  geom_tile(aes(fill = cor))+
  geom_text(aes(label=pv),col ="black",size = 5) +
  labs(x="",y="") +
  scale_fill_gradient2(low = "blue", high = "red", mid = "white",
                       midpoint = 0, space = "Lab",#, limit = c(-1, 1)
                       name="Pearson\nCorrelation") +
  theme_bw() + 
  theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank())  +
  theme(axis.text=element_text(size = 15)) +
  theme(axis.text.x=element_text(colour = "black",angle=45,hjust=1,size = 20)) +
  theme(axis.text.y=element_text(colour = "black", vjust=0,size = 20)) +
  theme(axis.title =element_text(size = 25)) +
  theme(text = element_text(size = 20))
ggsave(p, filename = "CIBERSORT ~ cormap-R.pdf", width = 15, height = 12)

###########-------------------------------------------########
library(dplyr)

Expr <- read.table("risk.txt",row.names = 1,sep = "\t",check.names = F,stringsAsFactors = F,header = T,quote = "")
Expr <- Expr[,"riskscore",drop=FALSE]
ciber <- read.table("CIBERSORT-Results.txt",sep = "\t",row.names = 1,check.names = F,stringsAsFactors = F,header = T)

# extract common samples
comsam <- intersect(rownames(Expr),rownames(ciber))
expr <- as.data.frame(t(Expr[comsam,,drop=FALSE]))
ciber <- ciber[comsam,setdiff(colnames(ciber), c("P-value", "Correlation", "RMSE"))]

for (i in rownames(expr)) {
  message(paste0("analysis of ",i," starts..."))
  subexpr <- as.numeric(expr[i,])
  names(subexpr) <- colnames(expr)
  
  # immune correlation
  dat <- as.numeric(expr[i,]); names(dat) <- colnames(expr)
  comsam <- intersect(names(dat), rownames(ciber))
  tmp1 <- dat[comsam]
  tmp2 <- ciber[comsam,]
  
  var <- setdiff(colnames(ciber),"CancerType")
  data <- data.frame(var)
  for (j in 1:length(var)){
    test <- cor.test(as.numeric(tmp2[,j]),tmp1,method = "pearson")
    data[j,2] <- test$estimate                                            
    data[j,3] <- test$p.value
  }
  names(data) <- c("symbol","correlation","pvalue")
  data <- as.data.frame(na.omit(data))
  data <- data[data$pvalue < 0.05,]
  if(nrow(data) > 0){
    data %>% 
      ggplot(aes(correlation,forcats::fct_reorder(symbol,correlation))) +
      geom_segment(aes(xend=0,yend=symbol)) +
      geom_point(aes(col=pvalue,size=abs(correlation))) +
      scale_colour_gradientn(colours=c("#7fc97f","#984ea3")) +
      scale_size_continuous(range =c(2,8))  +
      theme_minimal() +
      ylab(NULL)
    ggsave(paste0("correlation/correlation between cibersort and expression of ", i,".pdf"),width = 8,height = 6)
  }
}

######################-------------------------------########
library(ImageGP)
library(plyr)
load("tcga.exp.rda")

RiskGroup <- read.table("risk.txt",sep = "\t",check.names = F,stringsAsFactors = F,header = T,quote = "")
colnames(RiskGroup)[1] <- "Acc"
Expr <- as.data.frame(t(tcga.exp[rowSums(tcga.exp) > 0,]))
Expr <- log2(Expr + 1)
Expr$Acc <- rownames(Expr)
head(Expr[,1:3])
dim(Expr)
DatGroup <- dplyr::inner_join(RiskGroup, Expr, by="Acc")
head(DatGroup[,1:3])
dim(DatGroup)
data_p <- melt(DatGroup, id.vars = colnames(RiskGroup))
head(data_p[,1:3])
dim(data_p)

c <- read.table("Immunomodulator_and_chemokines.txt",header = F,sep = "\t", quote = "",fill = T,check.names=F)
colnames(c) <- c("id","type","ID")
head(c)
dim(c)
#
for (i in unique(c$type)) {
  
  ##-----##
  plotgene <- as.character(c[c$type == i,]$ID)
  tmp <- data_p[data_p$variable %in% plotgene,]
  a <- intersect(data_p$variable, plotgene)
  if(nrow(tmp) > length(unique(data_p$Acc))){
    
    p <- ggplot(tmp,aes(x=variable,y=value,
                        fill = riskgroup,
                        color = riskgroup)) + 
      geom_boxplot(notch = F, alpha = 0.95, 
                   outlier.shape = 16,
                   outlier.size = 0.65) +
      scale_fill_manual(values= c("#D5EBFB","#FBEEB7","#B4FBCD","#F5B3FC")) +
      scale_color_manual(values= c("#0073C2","#EFC000","#00C244","#C501D7")) +
      ggtitle("") + 
      labs(x=i,y="")
    p <- p + theme_bw() + 
      theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank())  +
      theme(axis.text=element_text(size = 15)) +
      theme(axis.text.x=element_text(colour = "black",angle=45,hjust=1,size = 15)) +
      theme(axis.text.y=element_text(colour = "black", vjust=0,size = 15)) +
      theme(axis.title =element_text(size = 20)) +
      theme(text = element_text(size = 15)) +
      stat_compare_means(aes(group=riskgroup),method ="wilcox.test",hide.ns = TRUE,label = "p.signif")
    ggsave(p, filename = paste0("Immunomodulator_and_chemokines ~ ",i,"-group by riskscore.pdf"), width = ((length(a)/2)+5), height = 7)
  }
}

###########-------------------------------------------########
library(reshape2)
library(ggplot2)

ciber <- read.table("CIBERSORT-Results.txt",sep = "\t",row.names = 1,check.names = F,stringsAsFactors = F,header = T)
ciber <- ciber[,setdiff(colnames(ciber), c("P-value", "Correlation", "RMSE"))]
ciber$Acc <- rownames(ciber)
RiskGroup <- read.table("risk.txt",sep = "\t",check.names = F,stringsAsFactors = F,header = T,quote = "")
colnames(RiskGroup)[1] <- "Acc"
ciber <- dplyr::inner_join(ciber, RiskGroup, by="Acc")
ciber <- ciber[order(ciber$riskgroup, decreasing = T),]
data_p <- melt(ciber, id.vars = colnames(RiskGroup))
head(data_p)
data_p$Acc <- factor(data_p$Acc, levels = ciber$Acc)

legendcol <- c(rep("#1CFA04",length(unique(data_p[data_p$riskgroup == "LRisk",]$Acc))),
               rep("#C705FF",length(unique(data_p[data_p$riskgroup != "LRisk",]$Acc))))
p <- ggplot(data_p, aes(Acc, value, fill=variable)) +
  geom_bar(stat="identity", position = "fill", width = 0.5) +
  geom_col(position = 'stack', width = 0.6) +
  guides(fill=guide_legend(title = NULL)) +
  ylab("Relative Percent") + xlab("") +
  theme_bw() +
  theme(axis.ticks.length=unit(0.5,'cm')) +
  theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank())  +
  theme(axis.text=element_text(size = 15)) +
  theme(axis.text.x=element_text(colour = legendcol,angle=45,hjust=1,size = 15)) +
  theme(axis.text.y=element_text(colour = "black", vjust=0,size = 15)) +
  theme(axis.title =element_text(size = 20)) +
  theme(text = element_text(size = 15)) +
  scale_y_continuous(expand=c(0,0))
ggsave(p, filename = "Immune infiltration-R__.pdf", width = 30, height = 6)

###########-------------------------------------------########
library(pRRophetic)
library(ggplot2)
library(ggpubr)
library(SimDesign)
library(cowplot)
library(dplyr)
library(GSVA)
library(limma)
library(stringr)
library(ComplexHeatmap)
library(xCell)

jco <- c("#BDD5EA","#FFA5AB","#011627","#2874C5","#EABF00","#868686","#C6524A","#80A7DE")

load("tcga.exp.rda")

RiskGroup <- read.table("risk.txt",row.names = 1,sep = "\t",check.names = F,stringsAsFactors = F,header = T,quote = "")
RiskGroup$riskgroup <- ifelse(RiskGroup$riskgroup == "HRisk",1,0)
comsam <- intersect(rownames(RiskGroup), colnames(tcga.exp));length(comsam)
expr <- tcga.exp[,comsam]
expr["riskgroup",] <- RiskGroup[comsam,"riskgroup"]
##---##
drug <- read.table("drug-new.txt",sep = "\t",row.names = NULL,check.names = F,stringsAsFactors = F,header = F)

i <- "riskgroup"
message(paste0("analysis of ",i," starts..."))
subexpr <- as.numeric(expr[i,])
names(subexpr) <- colnames(expr)

predictedPtype <- predictedBoxdat <- list() 
dat <- log2(expr + 1)
hsam <- colnames(dat)[as.numeric(dat[i,]) == 1 ]
lsam <- setdiff(colnames(dat),hsam)

plotp <- list()
for (d in drug$V1[1:6]) {
  set.seed(20201013) 
  cat(paste0("-- drug of ",d," is calculating...\n")) 
  
  predictedPtype[[d]] <- quiet(pRRopheticPredict(testMatrix = as.matrix(dat[,c(hsam,lsam)]),
                                                 drug = d,
                                                 tissueType = "allSolidTumors",
                                                 selection = 1)) 
  
  predictedBoxdat[[d]] <- data.frame("est.ic50" = predictedPtype[[d]],
                                     "group" = rep(c("HRisk","LRisk"),c(length(hsam),length(lsam))), 
                                     row.names = names(predictedPtype[[d]])) 
  predictedBoxdat[[d]]$group <- factor(predictedBoxdat[[d]]$group,levels = c("HRisk","LRisk")) 
  
  p <- ggplot(data = predictedBoxdat[[d]],aes(x = group, y = est.ic50, fill = group))+
    scale_fill_manual(values = jco[1:3]) + 
    geom_violin(alpha=0.4, position = position_dodge(width = .75),size=0.8,color="black") +
    geom_boxplot(notch = TRUE,  outlier.size = -1, color="black",lwd=0.8, alpha = 0.7)+
    geom_point( shape = 21,size=2, position = position_jitterdodge(), color="black",alpha=1)+
    theme_pubr()+
    ylab(bquote("Estimated IC"[50]~"of"~.(d))) +
    xlab(paste0("Expression of ",i))  +
    rremove("legend.title")+
    theme(panel.border = element_rect(colour = "black", fill=NA, size=0.2),
          axis.ticks = element_line(size=0.2,color="black"),
          axis.ticks.length=unit(0.2,"cm"),
          legend.position = "none")+
    font("xylab",size=15)+  
    font("xy",size=15)+ 
    font("xy.text", size = 15) +  
    font("legend.text",size = 15) + 
    stat_compare_means(method = "kruskal",
                       label.x = 1.5,hjust = 0.5)
  plotp[[d]] <- p 
  ggsave(paste0("violin plot of IC50 for ", d, " between expression groups of ", i,".pdf"),width = 4,height = 4)
}
p2 <- plot_grid(plotlist = plotp, ncol = 3)
ggsave(paste0("violin plot of IC50 between expression groups of ", i,".pdf"),width = 10,height = 8)


###########-------------------------------------------########
library(GSVA)
library(ggplot2)
library(stringr)
library(limma)
load("hallmark.gs.RData")
load("tcga.exp.rda")
col_3 <- c('palegreen3', 'snow3', 'dodgerblue4')

RiskGroup <- read.table("risk.txt",row.names = 1,sep = "\t",check.names = F,stringsAsFactors = F,header = T,quote = "")
comsam <- intersect(rownames(RiskGroup), colnames(tcga.exp));length(comsam)
tcga.expr <- tcga.exp[,comsam]
tcga.expr[1:3,1:3]
dim(tcga.expr)

i <- "riskgroup"
tcga.group <- RiskGroup[comsam,i, drop = F]
gsva_es <- gsva(as.matrix(tcga.expr), gs)
cutoff <- 1
group_list <- data.frame(sample = rownames(tcga.group), group = tcga.group[,i])
design <- model.matrix(~ 0 + factor(group_list$group))
colnames(design) <- levels(factor(group_list$group))
rownames(design) <- colnames(gsva_es)
my_comparisons <- c("HRisk-LRisk")
contrast.matrix <- makeContrasts(contrasts=my_comparisons, levels = design)

fit <- lmFit(gsva_es[,group_list$sample], design)
fit2 <- contrasts.fit(fit, contrast.matrix)
fit2 <- eBayes(fit2)
x <- topTable(fit2, coef = 1, n = Inf, adjust.method = "BH", sort.by = "P")

pathway <- str_replace(row.names(x), "HALLMARK_", "")
df <- data.frame(ID = pathway, score = x$t)
df$group <- cut(df$score, breaks = c(-Inf, -cutoff, cutoff, Inf),labels = c(1,2,3))
sortdf <- df[order(df$score),]
sortdf$ID <- factor(sortdf$ID, levels = sortdf$ID)

ggplot(sortdf, aes(ID, score, fill = group)) + geom_bar(stat = 'identity') + 
  coord_flip() + 
  scale_fill_manual(values = col_3, guide = FALSE) + 
  geom_hline(yintercept = c(-cutoff,cutoff), 
             color="white",
             linetype = 2, 
             size = 0.3) + 
  geom_text(data = subset(df, score < 0),
            aes(x=ID, y= 0.05, label= ID, color = group),
            size = 3, 
            hjust = "outward" ) +  
  geom_text(data = subset(df, score > 0),
            aes(x=ID, y= -0.05, label= ID, color = group),
            size = 3, hjust = "outward") +  
  scale_colour_manual(values = col_3, guide = FALSE) +
  
  xlab("") +ylab("t value of GSVA score\n between HRisk and LRisk") +
  theme_bw() + 
  theme(panel.grid =element_blank()) + 
  theme(panel.border = element_rect(size = 0.6)) + 
  theme(axis.line.y = element_blank(), axis.ticks.y = element_blank(), axis.text.y = element_blank())
ggsave(paste0("GSVA plot-",i,".pdf"),width = 8,height = 7)

#############
setwd("F:/")

a5 <- read.table("input1.txt",header = T,row.names = 1,sep = "\t", quote = "",fill = T,check.names = F,stringsAsFactors = F)   
head(a5)
a5$died <- a5$fustat==1
str(a5)
a5$futime <- as.numeric(a5$futime)
a5$fustat <- as.numeric(a5$fustat)
a5$age <- as.numeric(a5$age)
a5$stage <- as.numeric(a5$stage)
a5$T <- as.numeric(a5$T)
a5$M <- as.numeric(a5$M)
a5$N <- as.numeric(a5$N)
str(a5)
data6 <- a5
head(data6)
library(rms)

dd<-datadist(data6)
options(datadist="dd")
options(na.action="na.delete")
summary(data6$futime)

coxpbc<-cph(formula = Surv(futime,died) ~ age + gender + stage + T + M + N + riskscore,data=data6,x=T,y=T,surv = T,na.action=na.delete)

print(coxpbc)

surv<-Survival(coxpbc) 
surv3<-function(x) surv(1095,x)
surv4<-function(x) surv(1825,x)

x<-nomogram(coxpbc,fun = list(surv3,surv4),lp=T,
            funlabel = c('3-year survival Probability','5-year survival Probability'),
            maxscale = 100,fun.at = c(0.95,0.8,0.5,0.2))

pdf("nomogram_classical.pdf",width = 12,height = 10)
plot(x, lplabel="Linear Predictor",
     xfrac=.35,varname.label=TRUE, varname.label.sep="=", ia.space=.2, 
     tck=NA, tcl=-0.20, lmgp=0.3,
     points.label='Points', total.points.label='Total Points',
     total.sep.page=FALSE, 
     cap.labels=FALSE,cex.var = 1.6,cex.axis = 1.05,lwd=5,
     label.every = 1,col.grid = gray(c(0.8, 0.95)))
dev.off()

##---##
f5<-cph(formula = Surv(futime,died) ~ age + gender + stage + T + M + N + riskscore,data=data6,x=T,y=T,surv = T,na.action=na.delete,time.inc = 1095) 
cal5<-calibrate(f5, cmethod="KM", method="boot",u=1095,m=200,B=1000)

pdf("calibration_3y.pdf",width = 8,height = 8)
plot(cal5,
     lwd = 2,
     lty = 1,
     errbar.col = c("#2166AC"),
     xlim = c(0,1),ylim= c(0,1),
     xlab = "Nomogram-prediced OS (%)",ylab = "Observed OS (%)",
     cex.lab=1.2, cex.axis=1, cex.main=1.2, cex.sub=0.6)
lines(cal5[,c('mean.predicted',"KM")], 
      type = 'b',
      lwd = 2, 
      pch = 16, 
      col = c("#2166AC")) 
mtext("")
box(lwd = 1) 
abline(0,1,lty = 3, 
       lwd = 2, 
       col = c("#224444")
) 
dev.off()

##---##
f8<-cph(formula = Surv(futime,died) ~ age + gender + stage + T + M + N + riskscore,data=data6,x=T,y=T,surv = T,na.action=na.delete,time.inc = 1825) 
cal8<-calibrate(f8, cmethod="KM", method="boot",u=1825,m=200,B=1000)

pdf("calibration_5y.pdf",width = 8,height = 8)
plot(cal8,
     lwd = 2,
     lty = 1,
     errbar.col = c("#B2182B"),
     xlim = c(0,1),ylim= c(0,1),
     xlab = "Nomogram-prediced OS (%)",ylab = "Observed OS (%)",
     col = c("#B2182B"),
     cex.lab=1.2,cex.axis=1, cex.main=1.2, cex.sub=0.6)
lines(cal8[,c('mean.predicted',"KM")],
      type= 'b',
      lwd = 2,
      col = c("#B2182B"),
      pch = 16)
mtext("")
box(lwd = 1)
abline(0,1,lty= 3,
       lwd = 2,
       col =c("#224444"))
dev.off()

pdf("calibration_compare.pdf",width = 8,height = 8)
plot(cal5,lwd = 2,lty = 0,errbar.col = c("#2166AC"),
     bty = "l", 
     xlim = c(0,1),ylim= c(0,1),
     xlab = "Nomogram-prediced OS (%)",ylab = "Observed OS (%)",
     col = c("#2166AC"),
     cex.lab=1.2,cex.axis=1, cex.main=1.2, cex.sub=0.6)
lines(cal5[,c('mean.predicted',"KM")],
      type = 'b', lwd = 1, col = c("#2166AC"), pch = 16)
mtext("")

plot(cal8,lwd = 2,lty = 0,errbar.col = c("#B2182B"),
     xlim = c(0,1),ylim= c(0,1),col = c("#B2182B"),add = T)
lines(cal8[,c('mean.predicted',"KM")],
      type = 'b', lwd = 1, col = c("#B2182B"), pch = 16)

abline(0,1, lwd = 2, lty = 3, col = c("#224444"))

legend("topleft", 
       legend = c("3-year","5-year"), 
       col =c("#2166AC","#B2182B"), 
       lwd = 2,
       cex = 1.2,
       bty = "n")
dev.off()

library(survival)
setwd("F:/")
rt=read.table("input1.txt",header=T,sep="\t",check.names=F,row.names=1)

#
uniTab=data.frame()
for(i in colnames(rt[,3:ncol(rt)])){
  cox <- coxph(Surv(futime, fustat) ~ rt[,i], data = rt)
  coxSummary = summary(cox)
  uniTab=rbind(uniTab,
               cbind(id=i,
                     HR=coxSummary$conf.int[,"exp(coef)"],
                     HR.95L=coxSummary$conf.int[,"lower .95"],
                     HR.95H=coxSummary$conf.int[,"upper .95"],
                     pvalue=coxSummary$coefficients[,"Pr(>|z|)"])
  )
}
write.table(uniTab,file="uniCox.txt",sep="\t",row.names=F,quote=F)

##
multiCox=coxph(Surv(futime, fustat) ~ ., data = rt)
multiCoxSum=summary(multiCox)
multiTab=data.frame()
multiTab=cbind(
  HR=multiCoxSum$conf.int[,"exp(coef)"],
  HR.95L=multiCoxSum$conf.int[,"lower .95"],
  HR.95H=multiCoxSum$conf.int[,"upper .95"],
  pvalue=multiCoxSum$coefficients[,"Pr(>|z|)"])
multiTab=cbind(id=row.names(multiTab),multiTab)
write.table(multiTab,file="multiCox.txt",sep="\t",row.names=F,quote=F)


##---##
bioForest=function(coxFile=null,forestFile=null){
  #
  rt <- read.table(coxFile,header=T,sep="\t",row.names=1,check.names=F)
  gene <- rownames(rt)
  hr <- sprintf("%.3f",rt$"HR")
  hrLow  <- sprintf("%.3f",rt$"HR.95L")
  hrHigh <- sprintf("%.3f",rt$"HR.95H")
  Hazard.ratio <- paste0(hr,"(",hrLow,"-",hrHigh,")")
  pVal <- ifelse(rt$pvalue<0.001, "<0.001", sprintf("%.3f", rt$pvalue))
  
  #
  pdf(file=forestFile, width = 7,height = 4)
  n <- nrow(rt)
  nRow <- n+1
  ylim <- c(1,nRow)
  layout(matrix(c(1,2),nc=2),width=c(3,2.5))
  
  #
  xlim = c(0,3)
  par(mar=c(4,2.5,2,1))
  plot(1,xlim=xlim,ylim=ylim,type="n",axes=F,xlab="",ylab="")
  text.cex=0.8
  text(0,n:1,gene,adj=0,cex=text.cex)
  text(1.5-0.5*0.2,n:1,pVal,adj=1,cex=text.cex);text(1.5-0.5*0.2,n+1,'pvalue',cex=text.cex,font=2,adj=1)
  text(3,n:1,Hazard.ratio,adj=1,cex=text.cex);text(3,n+1,'Hazard ratio',cex=text.cex,font=2,adj=1,)
  
  #
  par(mar=c(4,1,2,1),mgp=c(2,0.5,0))
  xlim = c(0,max(as.numeric(hrLow),as.numeric(hrHigh)))
  plot(1,xlim=xlim,ylim=ylim,type="n",axes=F,ylab="",xaxs="i",xlab="Hazard ratio")
  arrows(as.numeric(hrLow),n:1,as.numeric(hrHigh),n:1,angle=90,code=3,length=0.05,col="darkblue",lwd=2.5)
  abline(v=1,col="black",lty=2,lwd=2)
  boxcolor = ifelse(as.numeric(hr) > 1, 'red', 'green')
  points(as.numeric(hr), n:1, pch = 15, col = boxcolor, cex=1.3)
  axis(1)
  dev.off()
}
###-------------------------------------------------------###

bioForest(coxFile="uniCox.txt",forestFile="uniForest.pdf")
bioForest(coxFile="multiCox.txt",forestFile="multiForest.pdf")

setwd("F:/")
library(beeswarm)

rt=read.table("input1.txt",sep="\t",header=T,check.names=F)
clinicalNum=7
pFilter=0.999
rt$age <- ifelse(rt$age > 65,65,64)
GeneSet <- "riskscore"
#
outTab=data.frame(gene=gsub("-","_",GeneSet))
for(clinical in setdiff(colnames(rt[,4:ncol(rt)]),gsub("-","_",GeneSet))){
  xlabel=vector()
  tab1=table(rt[,clinical])
  labelNum=length(tab1)
  dotCol=c("blue","red")
  if(labelNum==3){
    dotCol=c(2,3,4)
  }
  if(labelNum==4){
    dotCol=c(2,3,4,5)
  }
  if(labelNum>4){
    dotCol=rainbow(labelNum)
  }
  for(i in 1:labelNum){
    xlabel=c(xlabel,names(tab1[i]) )
  }
  clinicalPvalVector=c()
  for(i in gsub("-","_",GeneSet)){
    rt1=rbind(expression=rt[,i],clinical=rt[,clinical])
    rt1=as.matrix(t(rt1))
    if(labelNum==2){
      cliTest<-t.test(expression ~ clinical, data=rt1)
    }else{
      cliTest<-kruskal.test(expression ~ clinical, data = rt1)}
    pValue=cliTest$p.value
    stat=round(cliTest$statistic,3)
    pval=0
    if(pValue<0.05){
      pval=signif(pValue,4)
      pval=format(pval, scientific = TRUE)
    }else{
      pval=sprintf("%.03f",pValue)
    }
    clinicalPvalVector=c(clinicalPvalVector,paste0(stat,"(",pval,")"))
    if(pValue<pFilter){
      b = boxplot(expression ~ clinical, data = rt1,outline = FALSE, plot=F)
      yMin=min(b$stats)
      yMax = max(b$stats/5+b$stats)
      n = ncol(b$stats)
      outPdf=paste0(gsub("_","-",i),".",clinical,".pdf")
      pdf(file=outPdf,width = 7,height = 5)
      par(mar = c(4.5,6,3,3))
      ylab=ifelse(i=="riskScore","Risk score","Gene expression")
      boxplot(expression ~ clinical, data = rt1,names=xlabel,
              ylab = ylab,main=paste0(gsub("_","-",i)," (p=",pval,")"),xlab=clinical,
              cex.main=1.4, cex.lab=1.4, cex.axis=1.3,ylim=c(yMin,yMax),outline = FALSE)
      beeswarm(expression ~ clinical, data = rt1, col =dotCol, lwd=0.1,
               pch = 16, add = TRUE, corral="wrap")
      dev.off()
    }
  }
  outTab=cbind(outTab,clinicalPvalVector)
}
colnames(outTab)=c("id",setdiff(colnames(rt[,4:ncol(rt)]),gsub("-","_",GeneSet)))
write.table(outTab,file="clinicalCor.xls",sep="\t",row.names=F,quote=F)

workdir <- "F:/"; setwd(workdir)
library(RcisTarget.hg19.motifDBs.cisbpOnly.500bp)
library(visNetwork)
library(RcisTarget)
library(AUCell)
library(doRNG)
library(doMC)
library(DT)

###########-------------################
gene <- read.table("lasso coefficient.txt",row.names = 1,sep="\t",header=T,check.names=F,quote = "")
geneList1 <- rownames(gene)
(geneList1)

geneLists <- list(Module_Gene=geneList1)
data(motifAnnotations_hgnc)
data(hg19_500bpUpstream_motifRanking_cispbOnly)
motifRankings <- hg19_500bpUpstream_motifRanking_cispbOnly
motifRankings

#
motifEnrichmentTable_wGenes <- cisTarget(geneLists, motifRankings,
                                         motifAnnot=motifAnnotations_hgnc)
head(motifEnrichmentTable_wGenes)


motifEnrichmentTable_wGenes_wLogo <- addLogo(motifEnrichmentTable_wGenes)

resultsSubset <- motifEnrichmentTable_wGenes_wLogo

datatable(resultsSubset,
          escape = FALSE,
          filter="top", options=list(pageLength=5))

###---###
motifs_AUC <- calcAUC(geneLists, motifRankings, nCores=1)
(motifs_AUC )

par(mfrow = c(1,2))

pdf(file="motif enrichment.pdf",width=8,height=8)
for(i in names(geneLists)){
  auc <- getAUC(motifs_AUC)[i,]
  hist(auc, main=i, xlab="AUC histogram",
       breaks=100, col="#ff000050", border="darkred")
  nes3 <- (3*sd(auc)) + mean(auc)
  abline(v=nes3, col="red")
}
dev.off()

###---###
motifEnrichmentTable <- addMotifAnnotation(motifs_AUC, nesThreshold=3,
                                           motifAnnot=motifAnnotations_hgnc,
                                           highlightTFs=list(Key_Gene="PFKFB1"))
head(motifEnrichmentTable[,-"TF_lowConf", with=FALSE])

motifEnrichmentTable_wGenes <- addSignificantGenes(motifEnrichmentTable,
                                                   rankings=motifRankings, 
                                                   geneSets=geneLists)

motifEnrichmentTable_wGenes[1:4,]

geneSetName <- names(geneLists)[1]
selectedMotifs <- c("cisbp__M6345","cisbp__M6454","cisbp__M0465")

pdf(file="motif enrichment best.pdf",width=8,height=8)
par(mfrow=c(2,2))
getSignificantGenes(geneLists[[geneSetName]], 
                    motifRankings,
                    signifRankingNames=selectedMotifs,
                    plotCurve=TRUE, maxRank=5000, genesFormat="none",
                    method="aprox")
dev.off()