Sys.setenv(LANGUAGE = "en")
options(stringsAsFactors = FALSE)
rm(list = ls())

library(data.table)
library(dplyr)
library(tidyverse)
library(GSVA)

setwd("E:\\analysis")

load("exp.rdata")

gene_list = read.csv("gene_list.csv")

# Ensure exp1 is in matrix format
exp_matrix <- as.matrix(exp1)

# Prepare gene_list for GSVA in list format
genes <- as.character(gene_list$gene)
gene_set_list <- list(myGeneSet = genes)

# Run GSVA
ssgsea_scores <- gsva(
  exp_matrix,
  gene_set_list,
  method = "ssgsea",
  min.sz = 1,
  max.sz = Inf,
  verbose = FALSE
)

ssgsea_scores_df <- as.data.frame(t(ssgsea_scores))

# Calculate the median score as the threshold
median_score <- median(ssgsea_scores_df$myGeneSet, na.rm = TRUE)

# Group samples based on median threshold
ssgsea_scores_df$ExpressionGroup <- ifelse(ssgsea_scores_df$myGeneSet > median_score, "High", "Low")

# View group results
head(ssgsea_scores_df)

table(ssgsea_scores_df$ExpressionGroup)

exp = exp1
exp = as.data.frame(t(exp))

expre = merge(ssgsea_scores_df, exp, by = 0)

library(DESeq2)
conditions <- factor(c(rep("Normal", 171), rep("Tumor", 178)))

all.data.rounded <- exp1

# Filter low-quality genes
{
  all.data.rounded = all.data.rounded[apply(all.data.rounded, 1, function(x)
    sum(x > 0) > 0.5 * ncol(all.data.rounded)), ]
  min_count <- 1
  min_samples <- 0.1
  
  gene_expression_present <- rowSums(all.data.rounded >= min_count) / ncol(all.data.rounded)
  
  filtered_data <- all.data.rounded[gene_expression_present >= min_samples, ]
}

# Create DESeqDataSet with the filtered data
dds <- DESeqDataSetFromMatrix(
  countData = filtered_data,
  colData = ssgsea_scores_df$ExpressionGroup,
  design = ~ ExpressionGroup
)

dds <- DESeq(dds)
res <- results(dds)

#### Filtering 1
significant_genes_DESeq2_1 <- subset(res, padj < 0.05)
df_DESeq2_1 <- as.data.frame(significant_genes_DESeq2_1)

#### Filtering 2
significant_genes_DESeq2 <- subset(res, padj < 0.05 &
                                     abs(log2FoldChange) > 1)
df_DESeq2 <- as.data.frame(significant_genes_DESeq2)
write.csv(df_DESeq2_1, "DEG_p0.05.csv", row.names = TRUE)
write.csv(df_DESeq2, "PC_DEG_p0.05_log2FC1.csv", row.names = TRUE)

pc_deg = rownames(df_DESeq2_1)

# survival analysis -------------------------------------------------------
library(data.table)
library(dplyr)
library(tidyverse)
library(GSVA)

deg = read.csv(file = "deg.csv", header = T)
deg2 = read.csv(file = "deg2.csv", header = T)

common = intersect(deg$X, deg2$gene)

load("mrna_expr_tpm.rdata")
load(
  clinical.rdata")
expression = mrna_expr_tpm[common,]

exp_df <- data.frame(t(expression))

rownames(exp_df) <- sub(" ^ (.{
  16
}). * ", "\\1", rownames(exp_df))

clin_subset <- clin[, 3:4]

merged_data <- merge(clin_subset, exp_df, by = 0)

merged_data = column_to_rownames(merged_data, var = "Row.names")

df = merged_data

#### Univariate Cox Regression Analysis ----
library(survival)
library(survminer)

pfilter <- 0.05

uniresult <- data.frame()

for (i in 3:ncol(df)) {
  unicox <- coxph(Surv(time = df$os.time, event = df$status) ~ df[, i], data = df)
  unisum <- summary(unicox)

  pvalue <- round(unisum$coefficients[, 5], 3)
  if (!is.na(pvalue) && pvalue < pfilter) {
    gene_name <- colnames(df)[i]
    result_row <- cbind(gene = gene_name,
                        HR = unisum$coefficients[, 2],
                        L95CI = unisum$conf.int[, 3],
                        H95CI = unisum$conf.int[, 4],
                        pvalue = pvalue)
    uniresult <- rbind(uniresult, result_row)
  }
}

print(uniresult)

#### Survival Analysis ####
data = df

output = c()

for (i in 3:length(df)) {
  tmp <- df[, c(1, 2, i), drop = FALSE]

  tmp <- na.omit(tmp)

  if (nrow(tmp) > 0) {
    tmp$group <- ifelse(tmp[, 3] > median(tmp[, 3], na.rm = TRUE), "high", "low")

    if (any(tmp$group == "high") && any(tmp$group == "low")) {
      fit <- survfit(Surv(time = os.time, event = status) ~ group, data = tmp)
      p_value_result <- surv_pvalue(fit)

      p <- p_value_result[, 2]

      if (!is.na(p) && all(p < 0.05)) {
        output <- c(output, i)
      }
    }
  }
}

km_gene = colnames(data)[output]
cox_gene = uniresult$gene

comgene = intersect(km_gene, cox_gene)


#### LASSO Analysis, Cox Model ####

lasso <- subset(df, select = c("status", "os.time", comgene))

lasso_clin = lasso[, c(1, 2)]
lasso_clin$os.time = round(lasso_clin$os.time / 30, 2)
lasso_exp = lasso[, -c(1, 2)]

x <- as.matrix(lasso_exp)
y <- data.matrix(Surv(time = lasso_clin$os.time, event = lasso_clin$status))

{
  zero_time_indices <- which(cl$os.time == 0)
  cl$os.time[zero_time_indices] <- 1
}

library(glmnet)

set.seed(2345)
fit <- glmnet(x, y, family = "cox", nlambda = 1000, alpha = 1)
plot(fit , xvar = "lambda")

lasso_fit <- cv.glmnet(x, y, family = "cox", type.measure = "deviance", alpha = 1, nfolds = 10)
plot(lasso_fit)

lambda.min <- lasso_fit$lambda.min

model_lasso_min <- glmnet(x, y, family = 'cox', alpha = 1, lambda = lambda.min)

gene_min <- rownames(model_lasso_min$beta)[as.numeric(model_lasso_min$beta) != 0]
gene_min

coef(model_lasso_min)

#### Random Forest ####
library(randomForestSRC)

rfs = lasso

fit1 <- rfsrc(Surv(os.time, status) ~ ., data = rfs,
             ntree = 1000, nodesize = 14,
             splitrule = 'logrank',
             importance = T,
             proximity = T,
             forest = T)

plot(fit1)
rftop <- var.select(fit1)
rftop2 <- data.frame(
  Feature = rftop$topvars,
  vimp = rftop$varselect[rftop$topvars, 2])

rf_results = rftop2$Feature

share = intersect(gene_min, rftop2$Feature)

#### Multivariate Cox Regression ####
unigene <- subset(df, select = c("status", "os.time", end_gene))

multicox <- coxph(Surv(time = os.time, event = status) ~ ., data = unigene)
multisum <- summary(multicox)
gene <- colnames(unigene)[3:ncol(unigene)]
HR <- multisum$coefficients[, 2]
L95CI <- multisum$conf.int[, 3]
H95CI <- multisum$conf.int[, 4]
pvalue <- multisum$coefficients[, 5]
multiresult <- data.frame(gene = gene,
                          HR = HR,
                          L95CI = L95CI,
                          H95CI = H95CI,
                          pvalue = pvalue)
multiresult <- multiresult[multiresult$pvalue < pfilter, ]

#### SVM-RFE Algorithm #####
library(caret)
library(e1071)
source('msvmRFE.R')

set.seed(123)
input = lasso[, -2]

nfold = 5
nrows = nrow(input)
folds = rep(1:nfold, len = nrows)[sample(nrows)]
folds = lapply(1:nfold, function(x) which(folds == x))

results = lapply(folds, svmRFE.wrap, input, k = 10, halve.above = 100)
top.features = WriteFeatures(results, input, save = F)

{
  library(parallel)

  numCores <- detectCores()
  cl <- makeCluster(numCores - 1)
  clusterEvalQ(cl, {
    library(e1071)
  })

  featsweep <- parLapply(cl, 1:20, FeatSweep.wrap, results, input)

  stopCluster(cl)
}

no.info = min(prop.table(table(input[, 1])))
errors = sapply(featsweep, function(x) ifelse(is.null(x), NA, x$error))

PlotErrors(errors, no.info = no.info)
Plotaccuracy(1 - errors, no.info = no.info)
pdf("svm_rfe.pdf", height = 8, width = 10)
accuracy <- 1 - errors

plot(accuracy, type = 'o', col = 'blue', xlab = 'Number of Features', ylab = 'Accuracy', main = 'Accuracy Plot')

svm_results = top.features$FeatureName[1:5]

temp_intersect <- intersect(gene_min, rf_results)

end_gene <- intersect(temp_intersect, svm_results)

save(gene_min, rf_results, svm_results, end_gene, file = "ITL分析/end_gene.rdata")

load("ITL分析/end_gene.rdata")

#### Risk Plot #####
library(ggrisk)
library(survival)
df1 = subset(df, select = c("status", "os.time", end_gene))

fit1 <- coxph(Surv(os.time, status) ~ GBP2 + PARP9 +
              ESRP1 + FERMT1 + ZNF814, df1)
fit1
ggrisk(fit1)

ggrisk(
  fit1,
  cutoff.value = "roc",
  cutoff.x = NULL,
  size.points = 2,
  cutoff.y = 1,
  cutoff.label = c("cutoff(roc):-0.3"),
  code.highrisk = "High Risk",
  code.lowrisk = "Low Risk",
  title.A.ylab = "Risk Score",
  title.B.ylab = "OS_Time",
  title.A.legend = "Risk Group",
  title.B.legend = "Status",
  title.C.legend = "Expression",
  color.A = c(low = "#5ACFC9", high = "#FA9F42"),
color.B = c(code.0 = "#5ACFC9", code.1 = "#FA9F42"),
color.C = c(low = "#5ACFC9", median = "white", high = "#FA9F42")
)

ggrisk(
  fit1,
  cutoff.value = "median",
  cutoff.x = NULL,
  size.points = 2,
  size.dashline = 0.75,
  size.cutoff = 4,
  cutoff.y = 1,
  cutoff.label = c("cutoff"),
  code.highrisk = "High Risk",
  code.lowrisk = "Low Risk",
  title.A.ylab = "Risk Score",
  title.B.ylab = "OS_Time",
  title.A.legend = "Risk Group",
  title.B.legend = "Status",
  title.C.legend = "Expression",
  color.A = c(low = "#ECC68C", high = "#BD4146"),
  color.B = c(code.0 = "#ECC68C", code.1 = "#BD4146"),
  color.C = c(
    low = "#f77f00",
    median = "white",
    high = "#BD4146"
  )
)

#### Prognostic Model and Risk Score Calculation #######

risk_plot = subset(df, select = c("status", "os.time", end_gene))

multiCox <- coxph(Surv(time =  os.time, event = status) ~ ., data = risk_plot)

summary(multiCox)

riskScore = predict(multiCox, type = "risk", newdata = risk_plot)
riskScore <- as.data.frame(riskScore)

riskScore$sample <- rownames(riskScore)
head(riskScore, 2)

cl = subset(df, select = c("status", "os.time"))

riskScore_cli <- merge(riskScore, cl, by = 0)
riskScore_cli = column_to_rownames(riskScore_cli, var = "Row.names")

riskScore_cli$riskScore2 <- ifelse(riskScore_cli$riskScore > median(riskScore_cli$riskScore),
                                   "High",
                                   "Low")
riskScore_cli$riskgroup <- ifelse(riskScore_cli$riskScore > mean(riskScore_cli$riskScore),
                                  "High",
                                  "Low")
table(riskScore_cli$riskScore2)
table(riskScore_cli$riskgroup)

write.csv(riskScore_cli, file = "riskScore.csv")

fit <- survfit(Surv(os.time, as.numeric(status)) ~ riskScore2, data = riskScore_cli)

lasso_KM <- ggsurvplot(
  fit,
  data = riskScore_cli,
  pval = T,
  risk.table = T,
  surv.median.line = "hv",
  palette = c("#E7B800", "#2E9FDF"),
  legend.labs = c("High risk", "Low risk"),
  legend.title = "RiskScore",
  title = "Overall survival",
  ylab = "Cumulative survival (percentage)",
  xlab = " Time (Days)",
  censor.shape = 124,
  censor.size = 2,
  break.x.by = 720,
  conf.int = TRUE
)

lasso_KM

#### ROC Curve ######
library(timeROC)
with(
  riskScore_cli,
  ROC_riskscore <<- timeROC(
    T = os.time,
    delta = status,
    marker = riskScore,
    cause = 1,
    weighting = "marginal",
    times = c(365, 1080, 1800),
    ROC = TRUE,
    iid = TRUE
  )
)

plot(
  ROC_riskscore,
  time = 365,
  col = "#D2544B",
  add = F,
  title = ""
)
plot(ROC_riskscore,
     time = 1080,
     col = "#FFC800",
     add = T)
plot(ROC_riskscore,
     time = 1800,
     col = "#7389C3",
     add = T)
legend(
  "bottomright",
  c("1-Year", "3-Year", "5-Year"),
  col = c("#D2544B", "#FFC800", "#7389C3"),
  lty = 1,
  lwd = 2
)
text(0.5, 0.2, paste("1-Year AUC = ", round(ROC_riskscore$AUC[1], 3)), col = "#D2544B")
text(0.5, 0.15, paste("3-Year AUC = ", round(ROC_riskscore$AUC[2], 3)), col = "#FFC800")
text(0.5, 0.1, paste("5-Year AUC = ", round(ROC_riskscore$AUC[3], 3)), col = "#7389C3")



#### Nomogram Plot ####
mul_cox <- coxph(Surv(os.time, status) ~ age + gender + T_stage + N_stage + riskscore,
                 data = pbc)

mul_cox

library(rms)

mul_cox_2 <- cph(
  Surv(os.time, status) ~ age + gender + T_stage + N_stage + riskscore,
  data = pbc,
  x = TRUE,
  y = TRUE,
  surv = TRUE
)

mul_cox_2

sur <- Survival(mul_cox_2)

sur1 <- function(x)
  sur(365, x)
sur3 <- function(x)
  sur(1095, x)
sur5 <- function(x)
  sur(1825, x)
dd <- datadist(pbc)
options(datadist = 'dd')

nom <- nomogram(
  mul_cox_2,
  fun = list(sur1, sur3, sur5),
  fun.at = c(0.1, seq(0.1, 0.9, by = 0.1), 0.9),
  funlabel = c("1 year survival", "3 years survival", "5 years survival")
)

plot(nom)

x <- nomogram(
  mul_cox_2,
  fun = list(sur1, sur3, sur5),
  lp = TRUE,
  funlabel = c(
    '1-year survival Probability',
    '3-year survival Probability',
    '5-year survival Probability'
  ),
  maxscale = 100,
  fun.at = list(
    seq(0.1, 0.9, by = 0.1),
    seq(0.1, 0.8, by = 0.1),
    seq(0.1, 0.7, by = 0.1)
  )
)

plot(x)

library(regplot)

regplot(
  mul_cox,
  observation = a[6, ],
  points = TRUE,
  plots = c("density", "no plot"),
  failtime = c(365, 1095, 1825),
  odds = F,
  leftlabel = T,
  prfail = TRUE,
  showP = T,
  droplines = T,
  colors = "#ff7f0e",
  rank = "range",
  interval = "confidence",
  title = "Cox regression"
)

##### Calibration Curves Comparison ####

f1 <- cph(
  Surv(os.time, status) ~ age + gender + T_stage + N_stage + riskscore,
  data = pbc,
  x = TRUE,
  y = TRUE,
  surv = TRUE,
  na.action = na.delete,
  time.inc = 365
)

cal1 <- calibrate(
  f1,
  cmethod = 'KM',
  method = 'boot',
  u = 365,
  m = 40,
  B = 100
)
plot(
  cal1,
  lwd = 2,
  lty = 1,
  errbar.col = "#D2544B",
  xlim = c(0, 1),
  ylim = c(0, 1),
  xlab = "Nomogram predicted survival probability",
  ylab = "Observed fraction survival probability",
  subtitles = F,
  cex.lab = 1.2,
  cex.axis = 1,
  cex.main = 1.2,
  col = "#D2544B"
)
lines(
  cal1[, c("mean.predicted", "KM")],
  type = "b",
  lwd = 2,
  col = "#D2544B",
  pch = 16
)

f3 <- cph(
  Surv(os.time, status) ~ age + gender + T_stage + N_stage + riskscore,
  data = pbc,
  x = TRUE,
  y = TRUE,
  surv = TRUE,
  na.action = na.delete,
  time.inc = 1095
)
cal3 <- calibrate(
  f3,
  cmethod = 'KM',
  method = 'boot',
  u = 1095,
  m = 50,
  B = 100
)
plot(
  cal3,
  lwd = 2,
  lty = 1,
  errbar.col = "#FFC800",
  xlim = c(0, 1),
  ylim = c(0, 1),
  add = TRUE,
  col = "#FFC800"
)
lines(
  cal3[, c("mean.predicted", "KM")],
  type = "b",
  lwd = 2,
  col = "#FFC800",
  pch = 16
)

f5 <- cph(
  Surv(os.time, status) ~ age + gender + T_stage + N_stage + riskscore,
  data = pbc,
  x = TRUE,
  y = TRUE,
  surv = TRUE,
  na.action = na.delete,
  time.inc = 1825
)
cal5 <- calibrate(
  f5,
  cmethod = 'KM',
  method = 'boot',
  u = 1825,
  m = 50,
  B = 50
)
plot(
  cal5,
  lwd = 2,
  lty = 1,
  errbar.col = "#7389C3",
  xlim = c(0, 1),
  ylim = c(0, 1),
  add = TRUE,
  col = "#7389C3"
)
lines(
  cal5[, c("mean.predicted", "KM")],
  type = "b",
  lwd = 2,
  col = "#7389C3",
  pch = 16
)
abline(0,
       1,
       lty = 1,
       lwd = 2,
       col = "grey")
legend(
  "bottomright",
  legend = c("1-year", "3-year", "5-year", "Ideal line"),
  col = c("#D2544B", "#FFC800", "#7389C3", "grey"),
  lwd = 2,
  cex = 0.8,
  bty = "n",
  ncol = 1,
  x.intersp = 0.4,
  y.intersp = 1
)

#### Risk Model Construction, Risk Score Calculation #######

risk_plot = subset(df, select = c("status", "os.time", end_gene))

multiCox <- coxph(Surv(time = os.time, event = status) ~ ., data = risk_plot)

summary(multiCox)

riskScore = predict(multiCox, type = "risk", newdata = risk_plot)
riskScore <- as.data.frame(riskScore)

riskScore$sample <- rownames(riskScore)
head(riskScore, 2)

cl = subset(df, select = c("status", "os.time"))

riskScore_cli <- merge(riskScore, cl, by = 0)
riskScore_cli = column_to_rownames(riskScore_cli, var = "Row.names")

riskScore_cli$riskScore2 <- ifelse(riskScore_cli$riskScore > median(riskScore_cli$riskScore),
                                   "High",
                                   "Low")
riskScore_cli$riskgroup <- ifelse(riskScore_cli$riskScore > mean(riskScore_cli$riskScore),
                                  "High",
                                  "Low")
table(riskScore_cli$riskScore2)
table(riskScore_cli$riskgroup)


fit <- survfit(Surv(os.time, as.numeric(status)) ~ riskScore2, data = riskScore_cli)

lasso_KM <- ggsurvplot(
  fit,
  data = riskScore_cli,
  pval = T,
  risk.table = T,
  surv.median.line = "hv",
  palette = c("#E7B800", "#2E9FDF"),
  legend.labs = c("High risk", "Low risk"),
  legend.title = "RiskScore",
  title = "Overall survival",
  ylab = "Cumulative survival (percentage)",
  xlab = " Time (Days)",
  censor.shape = 124,
  censor.size = 2,
  break.x.by = 720,
  conf.int = TRUE
)

lasso_KM

#### ROC Curve ######
library(timeROC)
with(
  riskScore_cli,
  ROC_riskscore <<- timeROC(
    T = os.time,
    delta = status,
    marker = riskScore,
    cause = 1,
    weighting = "marginal",
    times = c(365, 1080, 1800),
    ROC = TRUE,
    iid = TRUE
  )
)

plot(
  ROC_riskscore,
  time = 365,
  col = "#D2544B",
  add = F,
  title = ""
)
plot(ROC_riskscore,
     time = 1080,
     col = "#FFC800",
     add = T)
plot(ROC_riskscore,
     time = 1800,
     col = "#7389C3",
     add = T)
legend(
  "bottomright",
  c("1-Year", "3-Year", "5-Year"),
  col = c("#D2544B", "#FFC800", "#7389C3"),
  lty = 1,
  lwd = 2
)
text(0.5, 0.2, paste("1-Year AUC = ", round(ROC_riskscore$AUC[1], 3)), col = "#D2544B")
text(0.5, 0.15, paste("3-Year AUC = ", round(ROC_riskscore$AUC[2], 3)), col = "#FFC800")
text(0.5, 0.1, paste("5-Year AUC = ", round(ROC_riskscore$AUC[3], 3)), col = "#7389C3")





# Drug sensitivity analysis -----------------------------------------------



library(data.table)
library(dplyr)
library(tidyverse)
library(readxl)
Drug <- read_excel(path = "DTP_NCI60_ZSCORE/output/DTP_NCI60_ZSCORE.xlsx", skip = 8)

Drug <- Drug[, -c(67, 68)]
table(Drug$`FDA status`)

Drug <- Drug[Drug$`FDA status` %in% c("FDA approved", "Clinical trial"), ]
Drug <- Drug[, -c(1, 3:6)]
data.frame(Drug[1:6, 1:6])

drugDat <- as.matrix(Drug)
rownames(drugDat) <- drugDat[, 1]
drug <- drugDat[, 2:ncol(drugDat)]
dimnames <- list(rownames(drug), colnames(drug))
drug <- matrix(as.numeric(as.matrix(drug)),
               nrow = nrow(drug),
               dimnames = dimnames)
drug[1:6, 1:6]

library(impute)
mat <- impute.knn(t(drug))
drug <- t(mat$data)
drug[1:6, 1:6]

Expression <- read_excel(path = "nci60_RNA__RNA_seq_composite_expression/output/RNA__RNA_seq_composite_expression.xls", skip = 10)

Expression <- Expression[, -c(2:6)]
data.frame(Expression[1:6, 1:6])

Expression2 <- data.frame(Expression)
rownames(Expression2) <- Expression2[, 1]
Expression2 <- Expression2[, 2:ncol(Expression2)]
colnames(Expression2) <- colnames(Expression)[-1]
Expression <- Expression2

identical(colnames(Expression), colnames(drug))

Genelist <- c("GBP2", "PARP9", "ESRP1", "FERMT1", "ZNF814")
Genelist <- intersect(Genelist, rownames(Expression))

exprSet <- t(rbind(Expression[Genelist, ], drug))
rownames(exprSet) <- colnames(drug)
colnames(exprSet) <- c(Genelist, rownames(drug))

library(Hmisc)
correlation <- rcorr(exprSet, type = "spearman")
Rvalue <- correlation$r[Genelist, -c(1:length(Genelist))]
Pvalue <- correlation$P[Genelist, -c(1:length(Genelist))]

Rvalue1 = as.data.frame(t(Rvalue))

library(ggplot2)
library(ggpubr)
formula <- y ~ poly(x, 1, raw = TRUE)
Druglist <- sort(colnames(Pvalue)[which(Pvalue["GBP2", ] < 0.001)])
Scatterplot <- lapply(Druglist, function(x) {
  plotData <- data.frame(Gene = as.numeric(Expression["GBP2", ]), Drug = as.numeric(drug[x, ]))
  plotData <- na.omit(plotData)
  p <- ggplot(data = plotData, mapping = aes(x = Gene, y = Drug)) +
    geom_point(size = 3,
               color = "#0077b6",
               alpha = 0.5) +
    geom_smooth(
      color = "#0077b6",
      fill = "#90e0ef",
      method = lm,
      formula = formula
    ) +
    labs(
      x = bquote("Relative Expression (" ~ Log[2] ~ "FPKM)"),
      y = "Compound Activity Z Scores",
      title = x
    ) +
    theme_bw() +
    theme(
      plot.title = element_text(hjust = 0.5, size = 12),
      axis.text.x = element_text(hjust = 0.5, size = 12),
      axis.text.y = element_text(hjust = 0.5, size = 12),
      axis.title.y = element_text(size = 12),
      axis.title.x = element_text(size = 12),
      axis.line = element_line(colour = "black", size = 0.5)
    ) +
    stat_cor(method = "spearman",
             size = 5 ,
             color = "#023e8a")
  return(p)
})
Scatterplot[[2]]

Druglist <- sort(colnames(Pvalue)[which(Pvalue["GBP2", ] < 0.001)])
Violinplot <- lapply(Druglist, function(x) {
  plotData <- data.frame(Gene = as.numeric(Expression["GBP2", ]), Drug = as.numeric(drug[x, ]))
  plotData <- na.omit(plotData)
  plotData$Group <- ifelse(plotData$Gene > median(plotData$Gene), "High", "Low")
  
  p = ggplot(plotData, aes(Group, Drug, fill = Group)) +
    geom_violin(aes(fill = Group), trim = FALSE) +
    geom_boxplot(width = 0.1, fill = "white") +
    geom_signif(
      comparisons = list(c("High", "Low")),
      step_increase = 0.1,
      map_signif_level = T,
      size = 0.5,
      textsize = 6,
      tip_length = 0.02,
      margin_top = 0.2,
      test = "t.test"
    ) +
    scale_fill_manual(values = c('#97cd99', '#fe7a7e')) +
    theme_bw() +
    labs(y = paste0("Activity Z Scores of ", x), title = "GBP2") +
    theme(
      plot.title = element_text(hjust = 0.5, size = 12),
      legend.position = "none",
      axis.text.x = element_text(hjust = 0.5, size = 12),
      axis.text.y = element_text(hjust = 0.5, size = 12),
      axis.title.y = element_text(size = 12),
      axis.title.x = element_blank(),
      axis.line = element_line(colour = "black", size = 0.5)
    )
})
Violinplot[[2]]
library(patchwork)
Scatterplot[[1]] + Violinplot[[1]] + plot_layout(widths = c(2.5, 1))

Scatterplot[[2]] + Violinplot[[2]] + plot_layout(widths = c(2.5, 1))

Scatterplot[[3]] + Violinplot[[3]] + plot_layout(widths = c(2.5, 1))

Scatterplot[[4]] + Violinplot[[4]] + plot_layout(widths = c(2.5, 1))

Scatterplot[[5]] + Violinplot[[5]] + plot_layout(widths = c(2.5, 1))

Scatterplot[[6]] + Violinplot[[6]] + plot_layout(widths = c(2.5, 1))

Scatterplot[[7]] + Violinplot[[7]] + plot_layout(widths = c(2.5, 1))

#### ZNF814 Analysis ####
Druglist1 <- sort(colnames(Pvalue)[which(Pvalue["ZNF814", ] < 0.01)])
Scatterplot <- lapply(Druglist1, function(x) {
  plotData <- data.frame(Gene = as.numeric(Expression["ZNF814", ]), Drug = as.numeric(drug[x, ]))
  plotData <- na.omit(plotData)
  p <- ggplot(data = plotData, mapping = aes(x = Gene, y = Drug)) +
    geom_point(size = 3,
               color = "#0077b6",
               alpha = 0.5) +
    geom_smooth(
      color = "#0077b6",
      fill = "#90e0ef",
      method = lm,
      formula = formula
    ) +
    labs(
      x = bquote("Relative Expression (" ~ Log[2] ~ "FPKM)"),
      y = "Compound Activity Z Scores",
      title = x
    ) +
    theme_bw() +
    theme(
      plot.title = element_text(hjust = 0.5, size = 12),
      axis.text.x = element_text(hjust = 0.5, size = 12),
      axis.text.y = element_text(hjust = 0.5, size = 12),
      axis.title.y = element_text(size = 12),
      axis.title.x = element_text(size = 12),
      axis.line = element_line(colour = "black", size = 0.5)
    ) +
    stat_cor(method = "spearman",
             size = 5 ,
             color = "#023e8a")
  return(p)
})
Scatterplot[[2]]

Druglist1 <- sort(colnames(Pvalue)[which(Pvalue["ZNF814", ] < 0.01)])
Violinplot <- lapply(Druglist1, function(x) {
  plotData <- data.frame(Gene = as.numeric(Expression["ZNF814", ]), Drug = as.numeric(drug[x, ]))
  plotData <- na.omit(plotData)
  plotData$Group <- ifelse(plotData$Gene > median(plotData$Gene), "High", "Low")
  
  p = ggplot(plotData, aes(Group, Drug, fill = Group)) +
    geom_violin(aes(fill = Group), trim = FALSE) +
    geom_boxplot(width = 0.1, fill = "white") +
    geom_signif(
      comparisons = list(c("High", "Low")),
      step_increase = 0.1,
      map_signif_level = T,
      size = 0.5,
      textsize = 6,
      tip_length = 0.02,
      margin_top = 0.2,
      test = "t.test"
    ) +
    scale_fill_manual(values = c('#97cd99', '#fe7a7e')) +
    theme_bw() +
    labs(y = paste0("Activity Z Scores of ", x), title = "ZNF814") +
    theme(
      plot.title = element_text(hjust = 0.5, size = 12),
      legend.position = "none",
      axis.text.x = element_text(hjust = 0.5, size = 12),
      axis.text.y = element_text(hjust = 0.5, size = 12),
      axis.title.y = element_text(size = 12),
      axis.title.x = element_blank(),
      axis.line = element_line(colour = "black", size = 0.5)
    )
})
Violinplot[[2]]
library(patchwork)
Scatterplot[[1]] + Violinplot[[1]] + plot_layout(widths = c(2.5, 1))

Scatterplot[[2]] + Violinplot[[2]] + plot_layout(widths = c(2.5, 1))

Scatterplot[[3]] + Violinplot[[3]] + plot_layout(widths = c(2.5, 1))

Scatterplot[[4]] + Violinplot[[4]] + plot_layout(widths = c(2.5, 1))

Scatterplot[[5]] + Violinplot[[5]] + plot_layout(widths = c(2.5, 1))

Scatterplot[[6]] + Violinplot[[6]] + plot_layout(widths = c(2.5, 1))

Scatterplot[[7]] + Violinplot[[7]] + plot_layout(widths = c(2.5, 1))

# single cell analysis-------------------------------------------

Sys.setenv(LANGUAGE = "en")
options(stringsAsFactors = FALSE)
rm(list = ls())

library(Seurat)
library(tidyverse)
library(dplyr)
library(patchwork)
library(harmony)
library(devtools)
library(scRNAtoolVis)

dir_name <- list.files('RAW/')

scRNAlist <- list()
for (i in 1:length(dir_name)) {
  counts <- Read10X(data.dir = paste("RAW/", dir_name[i], sep = ""))
  scRNAlist[[i]] <- CreateSeuratObject(
    counts,
    project = dir_name[i],
    min.cells = 3,
    min.features = 300
  )
}

for (i in 1:length(scRNAlist)) {
  sc <- scRNAlist[[i]]
  sc[["mt_percent"]] <- PercentageFeatureSet(sc, pattern = "^MT-")
  HB_genes <- c("HBA1",
                "HBA2",
                "HBB",
                "HBD",
                "HBE1",
                "HBG1",
                "HBG2",
                "HBM",
                "HBQ1",
                "HBZ")
  HB_m <- match(HB_genes, rownames(sc@assays$RNA))
  HB_genes <- rownames(sc@assays$RNA)[HB_m]
  HB_genes <- HB_genes[!is.na(HB_genes)]
  sc[["HB_percent"]] <- PercentageFeatureSet(sc, features = HB_genes)
  scRNAlist[[i]] <- sc
  rm(sc)
}

violin_before <- list()
for (i in 1:length(scRNAlist)) {
  violin_before[[i]] <- VlnPlot(
    scRNAlist[[i]],
    layer = "counts",
    features = c("nFeature_RNA", "nCount_RNA", "mt_percent", "HB_percent"),
    pt.size = 0.01,
    ncol = 4
  )
}

scRNAlist <- lapply(
  X = scRNAlist,
  FUN = function(x) {
    x <- subset(
      x,
      subset = nFeature_RNA > 300 & nFeature_RNA < 7000 &
        mt_percent < 15 &
        HB_percent < 3 &
        nCount_RNA < quantile(nCount_RNA, 0.97) &
        nCount_RNA > 1000
    )
  }
)

scRNAlist_merge <- merge(x = scRNAlist[[1]],
                         y = scRNAlist[-1],
                         add.cell.ids = dir_name)

VlnPlot(
  scRNAlist_merge,
  features = c("nFeature_RNA", "nCount_RNA", "mt_percent", "HB_percent"),
  split.by = "orig.ident",
  layer = "counts",
  pt.size = 0.01,
  ncol = 4
)

group = str_split(colnames(scRNAlist_merge@assays$RNA), '_', simplify = T)[, 1]
group = ifelse(str_detect(group, "^M"), "metastasis", "primary tumor")
scRNAlist_merge$group = group

scRNAlist_merge <- NormalizeData(scRNAlist_merge)
scRNAlist_merge <- FindVariableFeatures(scRNAlist_merge)
scRNAlist_merge <- ScaleData(scRNAlist_merge, vars.to.regress = c("mt_percent"))
scRNAlist_merge <- RunPCA(scRNAlist_merge, verbose = F)

scRNA_cca <- IntegrateLayers(
  object = scRNAlist_merge,
  method = CCAIntegration,
  orig.reduction = "pca",
  new.reduction = "integrated.cca",
  verbose = FALSE
)

scRNA_harmony <- IntegrateLayers(
  object = scRNAlist_merge,
  method = HarmonyIntegration,
  orig.reduction = "pca",
  new.reduction = "harmony",
  verbose = FALSE
)

scRNA_harmony[["RNA"]] <- JoinLayers(scRNA_harmony[["RNA"]])

ElbowPlot(scRNA_harmony, ndims = 50)
scRNA_harmony <- FindNeighbors(scRNA_harmony, reduction = "harmony", dims = 1:20)
scRNA_harmony <- FindClusters(scRNA_harmony, resolution = seq(from = 0.1, to = 1.0, by = 0.1))
scRNA_harmony <- RunUMAP(scRNA_harmony, dims = 1:20, reduction = "harmony")
scRNA_harmony <- RunTSNE(scRNA_harmony, dims = 1:20, reduction = "harmony")

save(scRNA_harmony, file = "scRNA_harmony.Rdata")
load("scRNA_harmony.Rdata")

library(clustree)
clustree(scRNA_harmony)

DimPlot(scRNA_harmony, reduction = "umap", group.by = "orig.ident") + ggtitle("Harmony")
Idents(scRNA_harmony) <- "RNA_snn_res.0.5"
DimPlot(scRNA_harmony, reduction = "umap")

DimPlot(scRNA_harmony, reduction = "umap", split.by = "group")

library(future)
plan(multisession, workers = 4)
markers <- FindAllMarkers(
  object = scRNA_harmony,
  test.use = "wilcox",
  only.pos = F,
  logfc.threshold = 0.25
)
plan(sequential)

all.markers = markers %>% dplyr::select(gene, everything()) %>% subset(p_val < 0.05)

top10 = all.markers %>% group_by(cluster) %>% top_n(n = 10, wt = avg_log2FC)

DoHeatmap(scRNA_harmony, features = top10$gene) + NoLegend()

library(SingleR)
refdata <- HumanPrimaryCellAtlasData()
testdata <- GetAssayData(scRNA_harmony, layer = "data")
clusters <- scRNA_harmony@meta.data$seurat_clusters
cellpred <- SingleR(
  test = testdata,
  ref = refdata,
  labels = refdata$label.main,
  method = "cluster",
  clusters = clusters,
  assay.type.test = "logcounts",
  assay.type.ref = "logcounts"
)
celltype = data.frame(
  ClusterID = rownames(cellpred),
  celltype = cellpred$labels,
  stringsAsFactors = FALSE
)
for (i in 1:nrow(celltype)) {
  scRNA_harmony@meta.data[which(scRNA_harmony@meta.data$seurat_clusters == celltype$ClusterID[i]), 'celltype'] <- celltype$celltype[i]
}

DimPlot(
  scRNA_harmony,
  group.by = "celltype",
  label = T,
  label.size = 5
)

FeatureCornerAxes(
  object = scRNA_harmony,
  reduction = 'umap',
  groupFacet = 'group',
  relLength = 0.5,
  relDist = 0.2,
  features = c("GBP2", "PARP9", "ESRP1", "FERMT1", "ZNF814")
)