├── Dependent_Escape.R ├── Dependent_Monocle.R ├── Dependent_SCENIC.R ├── Main_Part1.R ├── Main_Part2.R ├── Main_Part3.R ├── Main_Part4.R ├── Main_Part5.R ├── README.md ├── Seurat_Process.R └── Seurat_Read.R /Dependent_Escape.R: -------------------------------------------------------------------------------- 1 | # %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2 | # Functions 3 | # %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 4 | #' Hallmarker analysis 5 | #' 6 | #' This function is applied to calculate the hallmarker value for each cell 7 | #' 8 | 9 | RunEscape <- function(object, 10 | lib = "H") { 11 | gshallmark <- getGeneSets(library = lib) 12 | esseurat <- enrichIt( 13 | obj = object, gene.sets = gshallmark, 14 | groups = 1000, cores = 30 15 | ) 16 | write.table(esseurat, "Hall_Marker.txt", quote = F, sep = "\t") # nolint 17 | object <- Seurat::AddMetaData(object, esseurat) 18 | return(object) 19 | } 20 | -------------------------------------------------------------------------------- /Dependent_Monocle.R: -------------------------------------------------------------------------------- 1 | # %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2 | # Functions 3 | # %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 4 | #' Trajactory analysis 5 | #' 6 | #' This function is used to construct the possible evolutionary 7 | #' trajectory of the incorporated cells based on their 8 | #' @param object the object 9 | #' 10 | 11 | RunMonocle <- function(object) { 12 | monomatrix <- as( 13 | as.matrix(GetAssayData(object, slot = "counts")), "sparseMatrix" 14 | ) 15 | feature_ann <- data.frame( 16 | gene_id = rownames(monomatrix), gene_short_name = rownames(monomatrix) 17 | ) 18 | rownames(feature_ann) <- rownames(monomatrix) 19 | monofd <- new("AnnotatedDataFrame", data = feature_ann) 20 | sample_ann <- object@meta.data 21 | monopd <- new("AnnotatedDataFrame", data = sample_ann) 22 | 23 | monocds <- newCellDataSet(monomatrix, 24 | phenoData = monopd, 25 | featureData = monofd, 26 | lowerDetectionLimit = 0.1, 27 | expressionFamily = negbinomial.size() 28 | ) 29 | 30 | head(pData(monocds)) 31 | head(fData(monocds)) 32 | 33 | monocds <- estimateSizeFactors(monocds) 34 | monocds <- estimateDispersions(monocds) 35 | 36 | monocds <- detectGenes(monocds, min_expr = 0.1) 37 | print(head(fData(monocds))) 38 | expressed_genes <- row.names(subset(fData(monocds), num_cells_expressed >= 50)) # nolint 39 | monocds <- monocds[expressed_genes, ] 40 | 41 | disp_table <- dispersionTable(monocds) 42 | unsup_clustering_genes <- subset( 43 | disp_table, mean_expression >= 0.05 & 44 | dispersion_empirical >= 2 * dispersion_fit 45 | ) # 46 | monocds <- setOrderingFilter(monocds, unsup_clustering_genes$gene_id) 47 | 48 | monocds <- reduceDimension( 49 | monocds, 50 | max_components = 2, 51 | method = "DDRTree" 52 | ) 53 | monocds <- orderCells(monocds) 54 | return(monocds) 55 | } 56 | -------------------------------------------------------------------------------- /Dependent_SCENIC.R: -------------------------------------------------------------------------------- 1 | # %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2 | # Functions 3 | # %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 4 | #' SCENIC analysis 5 | #' 6 | #' This function is used to probe the transcription factor. 7 | #' @param exp the raw counts of the incorporated object 8 | #' 9 | #' 10 | 11 | RunSCENIC <- function(exp) { 12 | org <- "hgnc" 13 | dbs <- defaultDbNames[[org]] 14 | scenicoptions <- initializeScenic( 15 | org = org, dbDir = "/work/xiaxy/work/cisTarget_databases", 16 | dbs = dbs, nCores = 60 17 | ) 18 | 19 | Genes_Keep <- geneFiltering(exp, # nolint 20 | scenicOptions = scenicoptions, 21 | minCountsPerGene = 3 * .01 * ncol(exp), 22 | minSamples = ncol(exp) * .01 23 | ) 24 | exprmat_filtered <- exp[Genes_Keep, ] 25 | 26 | runCorrelation(exprmat_filtered, scenicoptions) 27 | exprmat_filtered <- log2(exprmat_filtered + 1) 28 | runGenie3(exprmat_filtered, scenicoptions) 29 | 30 | ### Build and score the GRN 31 | exprmat_log <- log2(exp + 1) 32 | scenicoptions <- runSCENIC_1_coexNetwork2modules(scenicoptions) 33 | scenicoptions <- runSCENIC_2_createRegulons( 34 | scenicoptions, 35 | coexMethod = c("top5perTarget") 36 | ) #** Only for toy run!! 37 | scenicoptions@settings$nCores <- 1 38 | scenicoptions <- runSCENIC_3_scoreCells(scenicoptions, exprmat_log) 39 | 40 | saveRDS( 41 | scenicoptions, 42 | file = "morescenicoptions.Rds" 43 | ) 44 | 45 | regulons <- loadInt(scenicoptions, "regulons") 46 | regulons <- loadInt(scenicoptions, "aucell_regulons") 47 | regulontargetsinfo <- loadInt(scenicoptions, "regulonTargetsInfo") 48 | 49 | regulonauc <- loadInt(scenicoptions, "aucell_regulonAUC") 50 | regulonauc <- regulonauc[onlyNonDuplicatedExtended(rownames(regulonauc)), ] 51 | write.table( 52 | regulonauc@assays@data$AUC, "SCENIC.txt", 53 | quote = F, sep = "\t" 54 | ) 55 | } 56 | -------------------------------------------------------------------------------- /Main_Part1.R: -------------------------------------------------------------------------------- 1 | pkgs <- c( 2 | "Seurat", "SeuratWrappers", "ggplot2", "batchelor", 3 | "dplyr", "optparse", "reshape2", "data.table", "magrittr", 4 | "patchwork", "scales", "GSVA", "RColorBrewer", "ggridges", 5 | "clusterProfiler", "survminer", "survminer", "monocle", 6 | "psych", "ggrepel", "pheatmap", "escape", "multcomp", "agricolae" 7 | ) 8 | 9 | lapply(pkgs, function(x) require(package = x, character.only = TRUE, quietly = TRUE, warn.conflicts = FALSE)) # nolint 10 | 11 | # lymphocyte--9 12 | yr <- c( 13 | "#fafac0", "#f5eca6", "#fee391", "#fec44f", 14 | "#fe9929", "#ec7014", "#cc4c02", "#8c2d04", 15 | "#611f03" 16 | ) 17 | # endothelium--5 18 | gr <- c( 19 | "#b9e9e0", "#7dc9b7", "#59b898", "#41ae76", 20 | "#16d355", "#238b45", "#116d37", "#025826", 21 | "#003516" 22 | ) 23 | # fibroblast--9 24 | bl <- c( 25 | "#82cbf5", "#7ba7e0", "#5199cc", "#488dbe", 26 | "#3690c0", "#0570b0", "#0d71aa", "#045a8d", 27 | "#023858" 28 | ) 29 | # myeloid--7 30 | pur <- c( 31 | "#8c97c6", "#a28abd", "#997abd", "#9362cc", 32 | "#88419d", "#810f7c", "#4d004b" 33 | ) 34 | # plasma--6 35 | bro <- c( 36 | "#8c510a", "#995401", "#be7816", "#be9430", 37 | "#ad8d36", "#a07540" 38 | ) 39 | 40 | color1 <- c(bl[1:8], yr, pur, gr[c(3, 5, 6, 7, 9)], bro, "#A9A9A9") 41 | color2 <- c( 42 | "#E0D39B", "#D05146", "#748EAE", "#567161", 43 | "#574F84", "#967447" 44 | ) 45 | 46 | data <- readRDS("final_input1.Rds") 47 | 48 | 49 | ## Tissue and sample number analysis 50 | tissue_sample_number <- read.table("number.txt", header = T, sep = "\t") 51 | tissue_sample_number <- melt(tissue_sample_number) 52 | tissue_sample_number$variable <- factor( 53 | tissue_sample_number$variable, 54 | levels = c("Normal", "Adjacent", "Tumor_1", "Tumor_2") 55 | ) 56 | 57 | pdf("F2B.pdf", width = 6, height = 3) 58 | ggplot(tissue_sample_number, aes(x = tissue, y = value, fill = variable)) + 59 | geom_bar(stat = "identity") + 60 | scale_fill_manual(values = c("#9362cc", "#5199cc", "#fe9929", "#fcbf47")) + 61 | theme_bw() + 62 | labs(x = "", y = "Number of samples") + 63 | theme( 64 | legend.title = element_blank(), 65 | axis.text.x = element_text(angle = 45, hjust = 1, color = "black", size = 10), # nolint 66 | axis.text.y = element_text(color = "black", size = 10), 67 | axis.title = element_text(color = "black", size = 12) 68 | ) 69 | dev.off() 70 | 71 | 72 | ## The Umap of clusters and celltype 73 | mat <- data.frame(data@reductions$umap@cell.embeddings, group = data$celltype) 74 | mt <- mat[order(mat$group != "Epithelium"), ] 75 | 76 | 77 | pdf("umap_subtype.pdf", width = 10, height = 9) 78 | ggplot(mt, aes(x = UMAP_1, y = UMAP_2, color = group)) + 79 | geom_point(size = 1e-5) + 80 | theme_classic() + 81 | scale_color_manual(values = color2) + 82 | theme( 83 | legend.title = element_blank(), 84 | legend.text = element_text(size = 20, color = "black"), 85 | axis.text = element_blank(), 86 | axis.title = element_blank(), 87 | axis.ticks = element_blank(), 88 | axis.line = element_blank() 89 | ) + 90 | guides(colour = guide_legend(override.aes = list(size = 8))) 91 | dev.off() 92 | 93 | pdf("umap_subcluster.pdf", width = 10, height = 10) 94 | DimPlot(data, label = F) + 95 | NoLegend() + 96 | scale_color_manual(values = color1) + 97 | theme( 98 | axis.text = element_blank(), 99 | axis.title = element_blank(), 100 | axis.ticks = element_blank(), 101 | axis.line = element_blank() 102 | ) 103 | dev.off() 104 | 105 | 106 | ## Proportion chart of cells from different sources in each cluster 107 | percent_result <- read.table("percent_result.txt", header = T, sep = "\t") 108 | percent_result <- melt(percent_result) 109 | percent_result$variable <- factor( 110 | percent_result$variable, 111 | levels = c("Normal", "Adjacent", "Tumor") 112 | ) 113 | 114 | pdf("Percent_types.pdf", width = 4, height = 3) 115 | ggplot(percent_result, aes(x = tissue, y = value, fill = variable)) + 116 | geom_bar(stat = "identity", position = "fill") + 117 | labs(y = "Proportion (%)") + 118 | scale_fill_manual(values = c("#9362cc", "#5199cc", "#fe9929")) + 119 | coord_flip() + 120 | theme( 121 | axis.line = element_blank(), 122 | legend.title = element_blank(), 123 | panel.grid = element_blank(), 124 | legend.text = element_text(size = 12), 125 | axis.text.y = element_text(size = 10, color = "black"), 126 | axis.title.x = element_text(size = 12), 127 | axis.title.y = element_blank(), 128 | legend.key.size = unit(0.6, "cm"), 129 | axis.text.x = element_text( 130 | angle = 45, hjust = 1, 131 | color = "black", size = 7 132 | ), 133 | plot.title = element_text(hjust = 0.5) 134 | ) + 135 | scale_y_continuous(expand = c(0, 0.01), labels = percent) 136 | dev.off() 137 | 138 | percent_subtypes <- read.table("percent_subtype.txt", header = T, sep = "\t") 139 | percent_subtypes <- melt(percent_subtypes) 140 | percent_subtypes$variable <- factor( 141 | percent_subtypes$variable, 142 | levels = c("Normal", "Adjacent", "Tumor") 143 | ) 144 | percent_subtypes$cluster <- factor( 145 | percent_subtypes$cluster, 146 | levels = c(paste0("c", 34:1), "total") 147 | ) 148 | 149 | plot_list <- foreach::foreach(gp = unique(percent_subtypes$group)) %do% { 150 | plot_dat <- percent_subtypes[percent_subtypes$group == gp, ] 151 | ggplot(plot_dat, aes(x = cluster, y = value, fill = variable)) + 152 | geom_bar(stat = "identity", position = "fill") + 153 | labs(y = "Proportion (%)", title = i) + 154 | scale_fill_manual(values = c("#9362cc", "#5199cc", "#fe9929")) + 155 | coord_flip() + 156 | theme( 157 | axis.line = element_blank(), 158 | legend.title = element_blank(), 159 | panel.grid = element_blank(), 160 | legend.text = element_text(size = 12), 161 | axis.text.y = element_text(size = 10, color = "black"), 162 | axis.title.x = element_text(size = 12), 163 | axis.title.y = element_blank(), 164 | legend.key.size = unit(0.6, "cm"), 165 | axis.text.x = element_text( 166 | angle = 45, hjust = 1, 167 | color = "black", size = 7 168 | ), 169 | plot.title = element_text(hjust = 0.5) 170 | ) + 171 | scale_y_continuous(expand = c(0, 0.01), labels = percent) 172 | } 173 | final <- wrap_plots(plot_list, ncol = length(plot_list), guides = "collect") 174 | ggsave("percent_subtype.pdf", final, width = 10, height = 3) 175 | 176 | 177 | ## FeaturePlot or each tissue 178 | subtype <- c( 179 | "Bladder", "Breast", "Colorectal", "Gastric", "Intrahepatic duct", 180 | "Lung", "Ovarian", "Pancreas", "Prostate", "Thyroid" 181 | ) 182 | 183 | plot_tissue <- foreach::foreach(ts = unique(data$tissue)) %do% { 184 | data$co <- ifelse( 185 | data$tissue != ts | data$clusters == 34, "Others", subtype[k] 186 | ) 187 | mat <- data.frame(data@reductions$umap@cell.embeddings, group = data$co) 188 | mt <- rbind(mat[which(mat$group == "Others"), ], mat[which(mat$group == subtype[k]), ]) # nolint 189 | mt$group <- factor(mt$group, levels = c("Others", subtype[k])) 190 | 191 | ggplot(mt, aes(x = cluster, y = value, fill = variable)) + 192 | geom_bar(stat = "identity", position = "fill") + 193 | labs(y = "Proportion (%)", title = i) + 194 | scale_fill_manual(values = c("#9362cc", "#5199cc", "#fe9929")) + 195 | coord_flip() + 196 | theme( 197 | axis.line = element_blank(), 198 | legend.title = element_blank(), 199 | panel.grid = element_blank(), 200 | legend.text = element_text(size = 12), 201 | axis.text.y = element_text(size = 10, color = "black"), 202 | axis.title.x = element_text(size = 12), 203 | axis.title.y = element_blank(), 204 | legend.key.size = unit(0.6, "cm"), 205 | axis.text.x = element_text( 206 | angle = 45, hjust = 1, 207 | color = "black", size = 7 208 | ), 209 | plot.title = element_text(hjust = 0.5) 210 | ) + 211 | scale_y_continuous(expand = c(0, 0.01), labels = percent) 212 | } 213 | 214 | final_plot_tissue <- wrap_plots(plot_tissue, ncol = length(plot_tissue) / 2, guides = "collect") # nolint 215 | ggsave("featureplot_each_cluster.pdf", final_plot_tissue, width = 30, height = 13) # nolint 216 | 217 | 218 | ## Subcluster analysis for DC 219 | dc_clusters <- subset(data, ident = 13) 220 | dc_clusters %<>% NormalizeData(object = ., normalization.method = "LogNormalize") %>% # nolint 221 | FindVariableFeatures(selection.method = "vst") 222 | 223 | all.genes <- rownames(dc_clusters) 224 | dc_clusters %<>% ScaleData(object = ., features = all.genes) %>% 225 | ScaleData(object = ., vars.to.regress = "percent.mt") 226 | dc_clusters %<>% RunPCA(object = ., features = VariableFeatures(object = .)) %>% 227 | RunFastMNN(object = ., object.list = SplitObject(., split.by = "SampleID")) 228 | 229 | dc_clusters %<>% FindNeighbors(reduction = "mnn", dims = 1:30) %>% 230 | FindClusters(resolution = 0.7) %<>% 231 | RunTSNE(reduction = "mnn", dims = 1:30) %>% 232 | RunUMAP(reduction = "mnn", dims = 1:30) 233 | 234 | dc_clusters <- RenameIdents(dc_clusters, 235 | "0" = "1", "1" = "1", "2" = "1", "3" = "1", 236 | "8" = "1", "7" = "5", "5" = "2", "4" = "4", 237 | "6" = "3", "10" = "3", "9" = "6" 238 | ) 239 | 240 | dc_clusters$seurat_clusters <- dc_clusters@active.ident 241 | dc_clusters$seurat_clusters <- factor(dc_clusters$seurat_clusters, levels = 1:6) 242 | saveRDS(dc_clusters, "DC_sub-clusters.Rds") 243 | 244 | pdf("DC_sub-clusters_VlnPlot.pdf", width = 3, height = 6) 245 | VlnPlot(dc_clusters, 246 | features = c("CD3D", "CD3E"), 247 | pt.size = 0, cols = pal_npg()(6), ncol = 1 248 | ) & 249 | theme( 250 | axis.text.x = element_text(angle = 0, hjust = 0.5, color = "black"), 251 | axis.title.x = element_blank() 252 | ) 253 | dev.off() 254 | 255 | dot_plot_genes <- c( 256 | "CLEC10A", "FCGR2B", "FCER1G", "FCGR2A", "S100B", "LTB", 257 | "CD1A", "CD1E", "STMN1", "TUBB", "TYMS", "TOP2A", "CLEC9A", 258 | "LGALS2", "CPVL", "XCR1", "CCL22", "BIRC3", "CCL19", "CCR7", 259 | "TRAC", "CD3D", "CD3E", "CD2" 260 | ) 261 | 262 | dc_clusters@active.ident <- factor(dc_clusters@active.ident, levels = 6:1) 263 | pdf("DC_sub-clusters_DotPlot.pdf", width = 8, height = 3.5) 264 | DotPlot(dc_clusters, 265 | features = dot_plot_genes, 266 | cols = c( 267 | "#FAFCFA", "#4D9157" 268 | ) 269 | ) + 270 | theme_bw() + 271 | theme( 272 | axis.title = element_blank(), 273 | axis.text.x = element_text(angle = 45, hjust = 1, color = "black"), 274 | axis.text.y = element_text(color = "black"), 275 | panel.grid.major = element_blank() 276 | ) 277 | dev.off() 278 | 279 | ## Subcluster analysis for Endothelium 280 | endothelium_clusters <- subset(data, ident = c(25, 26, 28)) 281 | endothelium_clusters$div <- ifelse(endothelium_clusters@active.ident == 25, "TEC", "NEC") # nolint 282 | endothelium_clusters@active.ident <- factor(endothelium_clusters$div, levels = c("NEC", "TEC")) # nolint 283 | 284 | pdf("endothelium_cluster_vln_plot.pdf", width = 4.5, height = 7) 285 | VlnPlot(endothelium_clusters, features = c( 286 | "IGFBP2", "IGFBP4", "INSR", 287 | "SPRY1", "CD320", "IGHG4" 288 | ), pt.size = 0, cols = pal_npg()(6), ncol = 2) & 289 | theme( 290 | axis.text.x = element_text(angle = 0, hjust = 0.5, color = "black"), 291 | axis.title.x = element_blank() 292 | ) 293 | dev.off() 294 | 295 | TEC_NEC_DEG_Marker <- FindAllMarkers(endothelium_clusters, min.pct = 0.25, only.pos = T) # nolint 296 | 297 | TEC_NEC_DEG_Marker$fc <- ifelse( 298 | TEC_NEC_DEG_Marker$cluster == "NEC", 299 | -1 * TEC_NEC_DEG_Marker$avg_log2FC, TEC_NEC_DEG_Marker$avg_log2FC 300 | ) # nolint 301 | TEC_NEC_DEG_Marker$q_value <- -log(TEC_NEC_DEG_Marker$p_val_adj, 10) 302 | TEC_NEC_DEG_Marker$group <- ifelse( 303 | TEC_NEC_DEG_Marker$fc > 0.5 & TEC_NEC_DEG_Marker$p_val_adj < 0.05, 304 | "sig up", 305 | ifelse(TEC_NEC_DEG_Marker$fc < -0.5 & TEC_NEC_DEG_Marker$p_val_adj < 0.05, 306 | "sig down", "not sig" 307 | ) 308 | ) 309 | select_genes <- c( 310 | TEC_NEC_DEG_Marker[which(TEC_NEC_DEG_Marker$group == "sig up"), "gene"][1:10], # nolint 311 | TEC_NEC_DEG_Marker[which(TEC_NEC_DEG_Marker$group == "sig down"), "gene"][1:10] # nolint 312 | ) 313 | TEC_NEC_DEG_Marker$label <- ifelse( 314 | TEC_NEC_DEG_Marker$gene %in% select_genes, 315 | TEC_NEC_DEG_Marker$gene, NA 316 | ) 317 | 318 | p <- ggplot(TEC_NEC_DEG_Marker, aes(x = fc, y = q_value)) + 319 | geom_point(aes(color = group), size = 1) + 320 | scale_color_manual(values = c("gray", "blue", "red")) + 321 | labs(x = "log2 fold change", y = "-log10 padj", title = "CAMR vs stable") + 322 | geom_text_repel(aes(label = label), size = 2) + 323 | geom_hline(yintercept = 1.30103, linetype = "dotted") + 324 | geom_vline(xintercept = c(-0.5, 0.5), linetype = "dotted") + 325 | theme(plot.title = element_text(hjust = 0.5)) 326 | ggsave("TEC_NEC_DEG_Volcano_Plot.pdf", p, width = 6.5, height = 6) 327 | 328 | 329 | ## Cluster analysis of tissue origin specificity 330 | Percent_Calculated <- read.table( 331 | "Percent_Calculated.txt", 332 | header = T, sep = "\t" 333 | ) 334 | Percent_Calculated <- melt(Percent_Calculated) 335 | Percent_Calculated$variable <- factor( 336 | Percent_Calculated$variable, 337 | levels = c("c21", "c17", "c6", "c5", "c4") 338 | ) 339 | npg_color <- pal_npg(alpha = 0.8)(10) 340 | color_for_use <- rev( 341 | c( 342 | "#9269A2", "#7dc9b7", colo[3], "#5199cc", "#6479cc", 343 | npg_color[c(10, 1, 8, 2, 6, 9)], 344 | "#EEC877", npg_color[5] 345 | ) 346 | ) 347 | 348 | p <- ggplot(Percent_Calculated, aes(x = variable, y = value, fill = cluster)) + 349 | geom_bar(stat = "identity", position = "fill") + 350 | labs(y = "Proportion (%)") + 351 | scale_fill_manual(values = color_for_use) + # nolint 352 | coord_flip() + 353 | theme( 354 | axis.line = element_blank(), 355 | legend.title = element_blank(), 356 | panel.grid = element_blank(), 357 | legend.text = element_text(size = 12), 358 | axis.text.y = element_text(size = 10, color = "black"), 359 | axis.title.x = element_text(size = 12), 360 | axis.title.y = element_blank(), 361 | legend.key.size = unit(0.6, "cm"), 362 | axis.text.x = element_text( 363 | angle = 45, hjust = 1, 364 | color = "black", size = 10 365 | ), 366 | plot.title = element_text(hjust = 0.5) 367 | ) + 368 | scale_y_continuous(expand = c(0, 0.01), labels = percent) 369 | ggsave( 370 | "Tissue_Origin_Specificity_Percent_Calculated.pdf", p, 371 | width = 5, height = 3.8 372 | ) 373 | 374 | 375 | ## Analysis of the distribution of cells of tumor, adjacent and normal tissue origin, respectively 376 | plot_list <- foreach::foreach(gp = c("Normal", "Adjacent", "Tumor")) %do% { 377 | select_subsets <- data 378 | select_subsets$group_for_color <- ifelse( 379 | select_subsets$clusters != 35 & select_subsets$group == gp, gp, "Others" 380 | ) 381 | plot_data <- data.frame( 382 | select_subsets@reductions$umap@cell.embeddings, 383 | group = select_subsets$group_for_color 384 | ) 385 | plot_data$group <- factor(plot_data$group, levels = c("Others", gp)) 386 | plot_data <- plot_data[order(plot_data$group), ] 387 | 388 | ggplot(tt, aes(x = UMAP_1, y = UMAP_2, color = group)) + 389 | geom_point(size = 0.1) + 390 | scale_color_manual(values = c("#D9D9D9", "#9362cc")) + 391 | labs(title = gp) + 392 | theme_classic() + 393 | theme( 394 | axis.text = element_blank(), 395 | axis.title = element_blank(), 396 | axis.ticks = element_blank(), 397 | axis.line = element_blank(), 398 | plot.title = element_text(hjust = 0.5, size = 25, color = "black"), 399 | legend.position = "none" 400 | ) 401 | } 402 | final <- wrap_plots(plot_list, ncol = length(plot_list), guides = "collect") 403 | ggsave("Subtype_Umap_Plot", final, width = 24, height = 8) 404 | 405 | 406 | ## Subcluster analysis for C24 407 | C24_cluster <- subset(data, ident = 24) 408 | C24_cluster_clusters %<>% NormalizeData(object = ., normalization.method = "LogNormalize") %>% # nolint 409 | FindVariableFeatures(selection.method = "vst") 410 | 411 | all.genes <- rownames(C24_cluster) 412 | C24_cluster %<>% ScaleData(object = ., features = all.genes) %>% 413 | ScaleData(object = ., vars.to.regress = "percent.mt") 414 | C24_cluster %<>% RunPCA(object = ., features = VariableFeatures(object = .)) %>% 415 | RunFastMNN(object = ., object.list = SplitObject(., split.by = "SampleID")) 416 | 417 | C24_cluster %<>% FindNeighbors(reduction = "mnn", dims = 1:30) %>% 418 | FindClusters(resolution = 0.7) %<>% 419 | RunTSNE(reduction = "mnn", dims = 1:30) %>% 420 | RunUMAP(reduction = "mnn", dims = 1:30) 421 | 422 | pdf("C24_Sub_Cluster_Umap.pdf", width = 4, height = 3.5) 423 | DimPlot(C24_cluster, label = F) + 424 | scale_color_manual(values = pal_npg()(6)) 425 | dev.off() 426 | 427 | pdf("C24_Sub_Cluster_Vln_Plot.pdf", width = 3, height = 4.5) 428 | VlnPlot(C24_cluster, 429 | features = "RGS13", 430 | pt.size = 0, cols = pal_npg()(6), ncol = 1 431 | ) & 432 | theme( 433 | axis.text.x = element_text(angle = 0, hjust = 0.5, color = "black"), 434 | axis.title.x = element_blank() 435 | ) 436 | dev.off() 437 | 438 | ## Analysis of FABP4+ macrophage (c20) proportion 439 | Validation_Results <- readRDS("Validation_Results/input.Rds") # nolint 440 | Validation_Matrix <- table(Validation_Results@meta.data[, c("sampleid", "seurat_clusters")]) # nolint 441 | Validation_Matrix_Sum <- 100 * rowSums(Validation_Matrix[, c(4, 32)]) / as.vector(table(Validation_Results$sampleid)) # nolint 442 | Validation_Matrix_Value <- data.frame(name = names(Validation_Matrix_Sum), value = as.numeric(Validation_Matrix_Sum)) # nolint 443 | Reference <- unique(Validation_Results@meta.data[, c("sampleid", "group")]) # nolint 444 | Validation_Matrix_Draw <- merge(Validation_Matrix_Value, Reference, by.x = "name", by.y = "sampleid") # nolint 445 | 446 | Validation_Matrix_Draw <- Validation_Matrix_Draw[ 447 | which(Validation_Matrix_Draw$group %in% c("Lung_N", "Lung_T", "tLB", "mBrain")), # nolint 448 | ] 449 | Validation_Matrix_Draw$group <- factor( 450 | Validation_Matrix_Draw$group, 451 | levels = c("Lung_N", "Lung_T", "tLB", "mBrain") 452 | ) 453 | 454 | model <- aov(value ~ group, data = tt) 455 | rht <- glht(model, linfct = mcp(group = "Dunnett"), alternative = "two.side") 456 | summary(rht) 457 | 458 | p <- ggplot(tt, aes(x = group, y = value)) + 459 | geom_boxplot( 460 | size = 0.8, fill = "white", outlier.fill = NA, 461 | outlier.color = NA, outlier.size = 0 462 | ) + 463 | geom_point(aes(fill = group, color = group), shape = 21, size = 3) + 464 | scale_color_manual(values = pal_npg()(4)) + 465 | scale_fill_manual(values = pal_npg()(4)) + 466 | theme_classic() + 467 | labs(y = "Proportion (%)") + 468 | theme( 469 | axis.title.x = element_blank(), 470 | axis.title.y = element_text(size = 12, color = "black"), 471 | axis.text.x = element_text( 472 | size = 10, color = "black", angle = 45, hjust = 1 473 | ), 474 | legend.title = element_blank(), 475 | legend.position = "none", 476 | axis.text.y = element_text(size = 10, color = "black"), 477 | panel.grid.major = element_blank(), 478 | panel.grid.minor = element_blank() 479 | ) 480 | ggsave("Validation_FABP4_Macrophage_Proportion.pdf", width = 2.3, height = 3) 481 | -------------------------------------------------------------------------------- /Main_Part2.R: -------------------------------------------------------------------------------- 1 | pkgs <- c( 2 | "Seurat", "SeuratWrappers", "ggplot2", "batchelor", "circlize", 3 | "dplyr", "optparse", "reshape2", "data.table", "magrittr", 4 | "patchwork", "scales", "GSVA", "RColorBrewer", "ggridges", 5 | "clusterProfiler", "survminer", "survminer", "monocle", 6 | "psych", "ggrepel", "pheatmap", "escape", "multcomp", "agricolae" 7 | ) 8 | 9 | color_for_use <- c( 10 | "#8F2A47", "#B83A4D", "#D25C52", "#E27E56", 11 | "#ECA86B", "#F4CB85", "#F8E8A2", "#FAF8C7", "#EBF0AF", 12 | "#CEE2A2", "#ABD3A6", "#82C3A5", "#609EB0", "#4C78B1", 13 | "#5C519B" 14 | ) 15 | 16 | lapply(pkgs, function(x) require(package = x, character.only = TRUE, quietly = TRUE, warn.conflicts = FALSE)) # nolint 17 | source("Dependent_SCENIC.R") 18 | source("Dependent_Monocle.R") 19 | source("Dependent_Escape.R") 20 | 21 | data <- readRDS("final_input1.Rds") 22 | 23 | ## The interaction of TME in normal, adjacent and tumor. 24 | Count_Network <- read.table("/work/xiaxy/work/Pancancer/GO/go4/r15/out/count_network.txt", header = T, sep = "\t") # nolint 25 | 26 | screen <- function(x) { 27 | Count_Network_Screen <- Count_Network[ 28 | intersect( 29 | grep(x, Count_Network$SOURCE), grep(x, Count_Network$TARGET) 30 | ), 31 | ] 32 | Count_Network_Screen <- dcast(Count_Network_Screen, SOURCE ~ TARGET) 33 | rownames(Count_Network_Screen) <- Count_Network_Screen$SOURCE 34 | Count_Network_Screen <- Count_Network_Screen[, -1] 35 | return(Count_Network_Screen) 36 | } 37 | 38 | bk <- c(seq(0, 5, by = 0.01)) 39 | pdf("TME_Interaction_Heatmap_Tumor.pdf", width = 5.5, height = 5) 40 | p <- pheatmap(log1p(screen("Tumor")), 41 | show_colnames = TRUE, 42 | annotation_colors = ann_colors, 43 | show_rownames = T, cluster_cols = TRUE, scale = "none", 44 | cluster_rows = T, color = c( 45 | colorRampPalette(colors = col1[15:11])(length(bk) * 2 / 3), 46 | colorRampPalette(colors = col1[11:1])(length(bk) / 3) 47 | ), 48 | breaks = bk, annotation_legend = TRUE, 49 | treeheight_row = 0, treeheight_col = 0, 50 | legend_breaks = c(0, 5), legend_labels = c("Low", "High"), 51 | fontsize = 12, annotation_names_col = FALSE, border_color = "gray", 52 | ) 53 | dev.off() 54 | 55 | Adjacent_Order <- c( 56 | "Fibroblast_Adjacent", "Myeloid_Adjacent", "Endothelium_Adjacent", 57 | "Epithelium_Adjacent", "Lymphocyte_Adjacent", "Plasma_Adjacent" 58 | ) 59 | pdf("TME_Interaction_Heatmap_Adjacent.pdf", width = 5.5, height = 5) 60 | p <- pheatmap(log1p(screen("Adjacent")[Adjacent_Order, Adjacent_Order]), 61 | show_colnames = TRUE, 62 | annotation_colors = ann_colors, 63 | show_rownames = T, cluster_cols = FALSE, scale = "none", 64 | cluster_rows = FALSE, color = c( 65 | colorRampPalette(colors = col1[15:11])(length(bk) * 2 / 3), 66 | colorRampPalette(colors = col1[11:1])(length(bk) / 3) 67 | ), 68 | breaks = bk, annotation_legend = TRUE, 69 | treeheight_row = 0, treeheight_col = 0, 70 | legend_breaks = c(0, 5), legend_labels = c("Low", "High"), 71 | fontsize = 12, annotation_names_col = FALSE, border_color = "gray", 72 | ) 73 | dev.off() 74 | 75 | Normal_Order <- c( 76 | "Fibroblast_Normal", "Myeloid_Normal", "Endothelium_Normal", 77 | "Epithelium_Normal", "Lymphocyte_Normal", "Plasma_Normal" 78 | ) 79 | pdf("TME_Interaction_Heatmap_Normal.pdf", width = 5.5, height = 5) 80 | p <- pheatmap(log1p(screen("Normal")[Normal_Order, Normal_Order]), 81 | show_colnames = TRUE, 82 | annotation_colors = ann_colors, 83 | show_rownames = T, cluster_cols = FALSE, scale = "none", 84 | cluster_rows = FALSE, color = c( 85 | colorRampPalette(colors = col1[15:11])(length(bk) * 2 / 3), 86 | colorRampPalette(colors = col1[11:1])(length(bk) / 3) 87 | ), 88 | breaks = bk, annotation_legend = TRUE, 89 | treeheight_row = 0, treeheight_col = 0, 90 | legend_breaks = c(0, 5), legend_labels = c("Low", "High"), 91 | fontsize = 12, annotation_names_col = FALSE, border_color = "gray", 92 | ) 93 | dev.off() 94 | 95 | ## Comparison Dendrograms for sub_clusters of fibroblast 96 | FIBROBLAST <- subset(data, ident = 1:34) 97 | FIBROBLAST$Label <- paste("c", FIBROBLAST$clusters, " ", FIBROBLAST$tissue, sep = "") # nolint 98 | FIBROBLAST <- FindVariableFeatures(FIBROBLAST, 99 | selection.method = "vst", 100 | nfeatures = 2000 101 | ) 102 | FIBROBLAST_EXP <- FIBROBLAST@assays$RNA@data[VariableFeatures(FIBROBLAST), ] 103 | FIBROBLAST_EXP <- t(as.matrix(FIBROBLAST_EXP)) 104 | FIBROBLAST_EXP_Mean <- aggregate(FIBROBLAST_EXP, list(FIBROBLAST$Label), mean) 105 | rownames(FIBROBLAST_EXP_Mean) <- FIBROBLAST_EXP_Mean$Group.1 106 | FIBROBLAST_EXP_Mean <- FIBROBLAST_EXP_Mean[, -1] 107 | 108 | FIBROBLAST_EXP_R <- corr.test(t(FIBROBLAST_EXP_Mean), method = "pearson") 109 | Distance <- hclust(as.dist((1 - FIBROBLAST_EXP_R$r) / 2), method = "ward.D2") 110 | pdf("Comparison_Dendrograms_Fibroblast.pdf", width = 9, height = 9) 111 | fviz_dend(Distance, 112 | k = 7, 113 | cex = 0.8, 114 | k_colors = pal_npg()(7), 115 | color_labels_by_k = FALSE, 116 | rect_border = pal_npg()(5), 117 | rect = TRUE, 118 | type = "circular", 119 | rect_fill = TRUE, 120 | horiz = TRUE, 121 | main = "", ylab = "" 122 | ) 123 | dev.off() 124 | 125 | ## circlize analysis 126 | for (i in c("Normal", "Adjacent", "Normal")) { 127 | Select_Object <- subset(data, cells = rownames(data@meta.data[which(data$group == i), ])) # nolint 128 | Select_Cells <- c() 129 | for (i in c(1:34)) { 130 | Select_Subset <- subset(Select_Object, ident = i) 131 | set.seed(1) 132 | if (nrow(Select_Subset@meta.data) > 2000) { 133 | Select_Cells <- append( 134 | Select_Cells, 135 | rownames(Select_Subset@meta.data[sample(1:nrow(Select_Subset@meta.data), 2000), ]) # nolint 136 | ) 137 | } else { 138 | Select_Cells <- append(Select_Cells, rownames(Select_Subset@meta.data)) # nolint 139 | } 140 | } 141 | 142 | Object_Final <- subset(data, cells = Select_Cells) 143 | write.table( 144 | Select_Object@assays$RNA@counts, 145 | paste0(i, "/count.txt"), 146 | quote = F, sep = "\t" 147 | ) 148 | meta <- data.frame( 149 | Cell = rownames(Select_Object@meta.data), 150 | Cell_type = paste0(Select_Object$celltype) 151 | ) 152 | 153 | write.table( 154 | meta, 155 | paste0(i, "/meta.txt"), 156 | quote = F, sep = "\t", row.names = F 157 | ) 158 | } 159 | Tumor <- read.table("Tumor/out/count_network.txt", header = T, sep = "\t") # nolint 160 | Normal <- read.table("Normal/out/count_network.txt", header = T, sep = "\t") # nolint 161 | Adjacent <- read.table("Adjacent/out/count_network.txt", header = T, sep = "\t") # nolint 162 | 163 | gr <- function(x, y) { 164 | x <- x[which(x$SOURCE != x$TARGET), ] 165 | x <- dcast(x, SOURCE ~ TARGET) 166 | x$SOURCE <- paste(x$SOURCE, y, sep = "_") 167 | rownames(x) <- x$SOURCE 168 | x <- x[, -1] 169 | colnames(x) <- paste(colnames(x), y, sep = "_") 170 | return(x) 171 | } 172 | Interaction_Counts_1 <- as.matrix(gr(Tumor, "tumor")) 173 | Interaction_Counts_2 <- as.matrix(gr(Normal, "normal")) 174 | Interaction_Counts_3 <- as.matrix(gr(Adjacent, "adjacent")) 175 | for (i in 1:5) { 176 | Interaction_Counts_1[i, i] <- 0 177 | } 178 | for (i in 1:5) { 179 | Interaction_Counts_2[i, i] <- 0 180 | } 181 | for (i in 1:5) { 182 | Interaction_Counts_3[i, i] <- 0 183 | } 184 | Interaction_Counts <- matrix(0, nrow = 15, ncol = 15) 185 | rownames(Interaction_Counts) <- c(rownames(Interaction_Counts_1), rownames(Interaction_Counts_2), rownames(Interaction_Counts_3)) # nolint 186 | colnames(Interaction_Counts) <- c(colnames(Interaction_Counts_1), colnames(Interaction_Counts_2), colnames(Interaction_Counts_3)) # nolint 187 | Interaction_Counts[rownames(Interaction_Counts_1), colnames(Interaction_Counts_1)] <- Interaction_Counts_1 # nolint 188 | Interaction_Counts[rownames(Interaction_Counts_2), colnames(Interaction_Counts_2)] <- Interaction_Counts_2 # nolint 189 | Interaction_Counts[rownames(Interaction_Counts_3), colnames(Interaction_Counts_3)] <- Interaction_Counts_3 # nolint 190 | Name_Order <- sort(rownames(Interaction_Counts))[c(2, 1, 3, 5, 4, 6, 8, 7, 9, 11, 10, 12, 14, 13, 15)] # nolint 191 | Interaction_Counts <- Interaction_Counts[Name_Order, Name_Order] 192 | Label_Name <- unique(unlist(dimnames(Interaction_Counts))) 193 | group <- structure(rep(1:5, each = 3), names = Label_Name) 194 | 195 | grid.col <- structure( 196 | rep(pal_aaas()(3)[c(1, 3, 2)], time = 5), 197 | names = names(group) 198 | ) 199 | 200 | pdf("cir.pdf", width = 4, height = 4) 201 | # 最外层添加一个空白轨迹 202 | chordDiagram( 203 | Interaction_Counts, 204 | group = group, grid.col = grid.col, 205 | annotationTrack = c("grid", "axis"), 206 | preAllocateTracks = list( 207 | track.height = mm_h(4), 208 | track.margin = c(mm_h(4), 0) 209 | ) 210 | ) 211 | circos.track( 212 | track.index = 2, 213 | panel.fun = function(x, y) { 214 | sector.index <- get.cell.meta.data("sector.index") 215 | xlim <- get.cell.meta.data("xlim") 216 | ylim <- get.cell.meta.data("ylim") 217 | circos.text( 218 | mean(xlim), mean(ylim), 219 | sector.index, 220 | cex = 0.6, 221 | niceFacing = TRUE 222 | ) 223 | }, 224 | bg.border = NA 225 | ) 226 | highlight.sector( 227 | names(group)[1:3], 228 | track.index = 1, col = "#fb8072", 229 | text = "Endothelium", cex = 0.8, text.col = "white", 230 | niceFacing = TRUE 231 | ) 232 | highlight.sector( 233 | names(group)[4:6], 234 | track.index = 1, col = "#80b1d3", 235 | text = "Fibroblast", cex = 0.8, text.col = "white", 236 | niceFacing = TRUE 237 | ) 238 | highlight.sector( 239 | names(group)[7:9], 240 | track.index = 1, col = "#fdb462", 241 | text = "Lymphocyte", cex = 0.8, text.col = "white", 242 | niceFacing = TRUE 243 | ) 244 | highlight.sector( 245 | names(group)[10:12], 246 | track.index = 1, col = "#73428A", 247 | text = "Myeloid", cex = 0.8, text.col = "white", 248 | niceFacing = TRUE 249 | ) 250 | highlight.sector( 251 | names(group)[13:15], 252 | track.index = 1, col = "#6EA056", 253 | text = "Plasma", cex = 0.8, text.col = "white", 254 | niceFacing = TRUE 255 | ) 256 | dev.off() 257 | 258 | ## SCENIC analysis for sub_clusters of fibroblast 259 | Select_Cells <- c() 260 | for (i in 1:8) { 261 | select_cluster <- subset(data, ident = i) 262 | set.seed(1) 263 | if (nrow(select_cluster@meta.data) > 500) { 264 | Select_Cells <- append( 265 | Select_Cells, 266 | rownames( 267 | select_cluster@meta.data[sample(1:nrow(select_cluster@meta.data), 500), ] # nolint 268 | ) 269 | ) 270 | } else { 271 | Select_Cells <- append(Select_Cells, rownames(select_cluster@meta.data)) 272 | } 273 | } 274 | Select_Object <- subset(data, cells = Select_Cells) 275 | Select_Counts <- as.matrix(Select_Object@assays$RNA@counts) 276 | RunSCENIC(Select_Counts) 277 | 278 | scenic <- read.table("moreSCENIC.txt", header = T, sep = "\t") 279 | name <- gsub("-", "_", rownames(Select_Object@meta.data)) 280 | colnames(scenic) <- name 281 | 282 | annotation <- data.frame( 283 | celltype = paste0("c", Select_Object$Clusters) 284 | ) 285 | rownames(annotation) <- name 286 | colnames(annotation) <- "celltype" 287 | 288 | color1 <- pal_npg()(9)[c(2, 5, 6, 3, 4, 1, 7, 8)] 289 | names(color1) <- paste0("c", 1:8) 290 | ann_colors <- list( 291 | celltype = color1 292 | ) 293 | Cellname <- c() 294 | for (i in paste0("c", Select_Object$Clusters)) { 295 | Cellname <- append(Cellname, rownames(annotation)[which(annotation$celltype == i)]) # nolint 296 | } 297 | 298 | SCENIC_Select <- scenic[ 299 | c( 300 | "EGR1 (14g)", "CREB3L1 (84g)", "TCF21 (13g)", 301 | "TWIST2_extended (17g)", 302 | "SOX2_extended (101g)", "SOX10 (123g)", "SOX17_extended (13g)", 303 | "ETS1 (305g)", "ETS2 (60g)", "SOX18 (59g)", "ERG (90g)", 304 | "MAFB_extended (51g)", "SPI1 (338g)", "IKZF1 (64g)", 305 | "MEF2C_extended (50g)", "TBX2_extended (24g)" 306 | ), Cellname 307 | ] 308 | 309 | bk <- c(seq(-1, -0.1, by = 0.01), seq(0, 1, by = 0.01)) 310 | 311 | pdf("FIBROBLAST_SCENIC_Heatmap.pdf", width = 8, height = 3.5) 312 | pheatmap(SCENIC_Select, 313 | show_colnames = FALSE, annotation_col = annotation, 314 | annotation_colors = ann_colors, 315 | show_rownames = T, scale = "row", cluster_cols = FALSE, 316 | cluster_rows = T, 317 | color = c( 318 | colorRampPalette( 319 | colors = brewer.pal(11, "RdYlBu")[11:6] 320 | )(length(bk) / 2), 321 | colorRampPalette( 322 | colors = brewer.pal(11, "RdYlBu")[6:1] 323 | )(length(bk) / 2) 324 | ), 325 | breaks = bk, annotation_legend = TRUE, 326 | legend_breaks = c(-1, 1), legend_labels = c("Low", "High"), 327 | fontsize = 12, annotation_names_col = TRUE, border_color = "gray" 328 | ) 329 | dev.off() 330 | 331 | ## SCENIC analysis for sub_clusters of fibroblast 332 | Select_cells <- c() 333 | for (i in 1:8) { 334 | Fibroblast_Select <- subset(data, ident = i) 335 | set.seed(1) 336 | if (nrow(Fibroblast_Select@meta.data) > 5000) { 337 | Select_cells <- append( 338 | Select_cells, 339 | rownames(Fibroblast_Select@meta.data[sample(1:nrow(Fibroblast_Select@meta.data), 5000), ]) # nolint 340 | ) 341 | } else { 342 | Select_cells <- append(Select_cells, rownames(Fibroblast_Select@meta.data)) # nolint 343 | } 344 | } 345 | sce <- subset(data, cells = Select_cells) 346 | RunEscape(sce) 347 | 348 | esc <- read.table("Hall_Marker.txt", header = T, sep = "\t") 349 | mat <- aggregate(esc, list(sce$Clusters), mean) 350 | rownames(mat) <- mat$Group.1 351 | mat <- mat[c(1, 2, 4, 6:8), -1] 352 | colnames(mat) <- gsub("HALLMARK_", "", colnames(mat)) 353 | mat <- as.data.frame(t(mat)) 354 | annotation_col <- data.frame( 355 | celltype = colnames(mat) 356 | ) 357 | rownames(annotation_col) <- colnames(mat) 358 | col1 <- pal_npg(alpha = 0.9)(9)[c(1, 2, 4, 6, 7, 8)] 359 | names(col1) <- colnames(mat) 360 | 361 | ann_colors <- list( 362 | celltype = col1 363 | ) 364 | 365 | bk <- c(seq(-1, -0.1, by = 0.01), seq(0, 1, by = 0.01)) 366 | pdf("pheatmap.pdf", width = 4.2, height = 4) 367 | pheatmap(mat, 368 | show_colnames = FALSE, annotation_col = annotation_col, 369 | annotation_colors = ann_colors, 370 | show_rownames = T, scale = "row", cluster_cols = FALSE, 371 | cluster_rows = T, color = c( 372 | colorRampPalette(colors = brewer.pal(11, "RdYlBu")[11:6])(length(bk) / 2), # nolint 373 | colorRampPalette(colors = brewer.pal(11, "RdYlBu")[6:1])(length(bk) / 2) # nolint 374 | ), 375 | breaks = bk, annotation_legend = TRUE, 376 | legend_breaks = c(-1, 1), 377 | legend_labels = c("Low", "High"), 378 | fontsize = 6, annotation_names_col = FALSE, 379 | border_color = "gray", treeheight_row = 10 380 | ) 381 | dev.off() 382 | 383 | ## Interaction comparison in tumor, adjacent and normal tissue 384 | nom <- read.table("Normal/out/count_network.txt", header = T, sep = "\t") # nolint 385 | adj <- read.table("Adjacent/out/count_network.txt", header = T, sep = "\t") # nolint 386 | tum <- read.table("Tumor/out/count_network.txt", header = T, sep = "\t") # nolint 387 | 388 | deal <- function(x) { 389 | x <- x[which(x$SOURCE != x$TARGET), ] 390 | interaction_table <- matrix(NA, nrow = length(unique(x$SOURCE)), ncol = 2) # nolint 391 | k <- 1 392 | for (i in unique(x$SOURCE)) { 393 | table_select <- x[which(x$SOURCE == i), ] 394 | interaction_table[k, 1] <- i 395 | interaction_table[k, 2] <- sum(table_select$count) 396 | k <- k + 1 397 | } 398 | colnames(interaction_table) <- c("iterm", "count") 399 | interaction_table <- as.data.frame(interaction_table) 400 | interaction_table$type <- sapply( 401 | strsplit(interaction_table$iterm, "_", fixed = T), "[", 1 402 | ) 403 | interaction_table$tissue <- sapply( 404 | strsplit(interaction_table$iterm, "_", fixed = T), "[", 2 405 | ) 406 | return(interaction_table) 407 | } 408 | 409 | npg_color <- pal_npg(alpha = 0.8)(10) 410 | color_new <- rev(c( 411 | "#9269A2", colo[3], "#6479cc", 412 | npg_color[c(10, 8, 2, 6, 9)], "#EEC877", npg_color[5] 413 | )) 414 | 415 | p1 <- ggplot(deal(tum), aes(x = type, y = as.numeric(count))) + 416 | geom_boxplot() + 417 | geom_jitter( 418 | aes(color = tissue, fill = tissue), 419 | shape = 21, width = 0.2, size = 3 420 | ) + 421 | scale_color_manual(values = color_new) + 422 | scale_fill_manual(values = color_new) + 423 | theme_bw() + 424 | labs(x = "", y = "The counts of interaction") + 425 | theme( 426 | axis.text.x = element_text( 427 | size = 10, angle = 45, 428 | hjust = 1, color = "black" 429 | ), 430 | axis.text.y = element_text(size = 10, color = "black"), 431 | axis.title = element_text(size = 12, color = "black"), 432 | legend.title = element_blank() 433 | ) 434 | ggsave("Interaction_Tumor.pdf", p1, width = 4.2, height = 3.2) 435 | 436 | p1 <- ggplot(deal(adj), aes(x = type, y = as.numeric(count))) + 437 | geom_boxplot() + 438 | geom_jitter( 439 | aes(color = tissue, fill = tissue), 440 | shape = 21, width = 0.2, size = 3 441 | ) + 442 | scale_color_manual(values = color_new[c(1, 3:8, 10)]) + 443 | scale_fill_manual(values = color_new[c(1, 3:8, 10)]) + 444 | theme_bw() + 445 | labs(x = "", y = "The counts of interaction") + 446 | theme( 447 | axis.text.x = element_text( 448 | size = 10, angle = 45, 449 | hjust = 1, color = "black" 450 | ), 451 | axis.text.y = element_text(size = 10, color = "black"), 452 | axis.title = element_text(size = 12, color = "black"), 453 | legend.title = element_blank() 454 | ) 455 | ggsave("Interaction_Adjacent.pdf", p1, width = 4.2, height = 3.2) 456 | 457 | 458 | p1 <- ggplot(deal(nom), aes(x = type, y = as.numeric(count))) + 459 | geom_boxplot() + 460 | geom_jitter( 461 | aes(color = tissue, fill = tissue), 462 | shape = 21, width = 0.2, size = 3 463 | ) + 464 | scale_color_manual(values = color_new[c(1, 3:4, 6, 8, 9, 10)]) + 465 | scale_fill_manual(values = color_new[c(1, 3:4, 6, 8, 9, 10)]) + 466 | theme_bw() + 467 | labs(x = "", y = "The counts of interaction") + 468 | theme( 469 | axis.text.x = element_text( 470 | size = 10, angle = 45, 471 | hjust = 1, color = "black" 472 | ), 473 | axis.text.y = element_text(size = 10, color = "black"), 474 | axis.title = element_text(size = 12, color = "black"), 475 | legend.title = element_blank() 476 | ) 477 | ggsave("Interaction_Normal.pdf", p1, width = 4.2, height = 3.2) 478 | 479 | ## FeaturePlot for sub-clusters of fibroblast 480 | Fibroblast_Subset <- subset(data, ident = 1:5) 481 | Fibroblast_Subset@active.ident <- factor( 482 | paste0("c", Fibroblast_Subset@active.ident), 483 | levels = c("c3", "c5", "c4", "c2", "c1") 484 | ) 485 | names(Fibroblast_Subset@active.ident) <- rownames(Fibroblast_Subset@meta.data) 486 | 487 | Embeddings <- as.data.frame(Fibroblast_Subset@reductions$umap@cell.embeddings) 488 | Select_Cells <- rownames(Embeddings[which(Embeddings$UMAP_1 < 2 & Embeddings$UMAP_2 > -2 & Embeddings$UMAP_2 < 5), ]) # nolint 489 | Select_Object <- subset(Fibroblast_Subset, cells = Select_Cells) 490 | 491 | pdf("newout/sf2/c_fea.pdf", width = 7, height = 6.5) 492 | FeaturePlot(Select_Object, 493 | features = c("ACTA2", "CFD", "FAP", "TGFB1"), 494 | cols = rev(color_for_use), ncol = 2, order = T, pt.size = 0.5 495 | ) 496 | dev.off() 497 | 498 | ## DotPlot analysis for sub-clusters of fibroblast 499 | CAF_Clusters <- subset(data, ident = 1:8) # nolint 500 | CAF_Clusters_DEG_Markers <- FindAllMarkers( # nolint 501 | CAF_Clusters, 502 | only.pos = T, min.pct = 0.25 503 | ) 504 | 505 | CAF_Clusters_DEG_Genes <- do.call( # nolint 506 | rbind, lapply( 507 | split(data.table(CAF_Clusters_DEG_Markers), by = "cluster"), 508 | function(x) x[1:5, "gene"] 509 | ) 510 | ) 511 | 512 | CAF_Clusters@active.ident <- factor(CAF_Clusters@active.ident, levels = 8:1) 513 | pdf("CAF_Clusters_DEG_DotPlot.pdf", width = 8, height = 3) 514 | DotPlot(CAF_Clusters, 515 | features = unique(CAF_Clusters_DEG_Genes$gene), 516 | cols = c( 517 | "#FAFCFA", "#4D9157" 518 | ) 519 | ) + 520 | theme_bw() + 521 | theme( 522 | axis.title = element_blank(), 523 | axis.text.x = element_text(angle = 45, hjust = 1, color = "black"), 524 | axis.text.y = element_text(color = "black"), 525 | panel.grid.major = element_blank() 526 | ) 527 | dev.off() 528 | 529 | 530 | ## Marker analysis of CAF and NIF 531 | CAF_NIF <- subset(data, ident = 1:5) 532 | CAF_NIF$group <- ifelse(CAF_NIF@active.ident %in% c(1, 2, 4), "CAF", "NIF") 533 | CAF_NIF$label <- ifelse(CAF_NIF@active.ident %in% c(3, 5), "NIF", 534 | ifelse(CAF_NIF@active.ident == 1, "CAFmyo", 535 | ifelse(CAF_NIF@active.ident == 2, "CAFinfla", "CAFadi") 536 | ) 537 | ) 538 | CAF_NIF@active.ident <- factor(sub$group) 539 | names(CAF_NIF@active.ident) <- rownames(CAF_NIF@meta.data) 540 | 541 | pdf("CAF_NIF_VlnPlot.pdf", width = 9, height = 4.5) 542 | VlnPlot(sub, 543 | features = c("PDGFRA", "PDGFRB", "NOTCH3", "HES4", "FAP", "THY1"), 544 | pt.size = 0, ncol = 4 545 | ) & 546 | scale_fill_manual(values = pal_npg()(10)) & 547 | theme( 548 | axis.title.x = element_blank(), 549 | axis.text.x = element_text(angle = 0, hjust = 0.5) 550 | ) 551 | dev.off() 552 | 553 | ## Trajactory analysis of CAF and NIF 554 | CAF_NIF <- subset(data, ident = 1:5) 555 | CAF_NIF@active.ident <- factor( 556 | paste0("c", CAF_NIF@active.ident), 557 | levels = c("c1", "c2", "c4", "c3", "c5") 558 | ) 559 | names(CAF_NIF@active.ident) <- rownames(CAF_NIF@meta.data) 560 | 561 | Randomly_Selected_Cells <- c() 562 | for (i in c("c1", "c2", "c3", "c4", "c5")) { 563 | CAF_NIF <- subset(CAF_NIF, ident = i) 564 | set.seed(1) 565 | Randomly_Selected_Cells <- append( 566 | Randomly_Selected_Cells, 567 | rownames(CAF_NIF@meta.data[sample(1:nrow(CAF_NIF@meta.data), 1500), ]) # nolint 568 | ) 569 | } 570 | 571 | CAF_NIF_Randomly <- subset(data, cells = Randomly_Selected_Cells) 572 | CAF_NIF_Randomly$group <- ifelse( 573 | CAF_NIF_Randomly@active.ident %in% c(1, 2, 4), 574 | "CAF", "NIF" 575 | ) 576 | 577 | monocds <- RunMonocle(CAF_NIF_Randomly) 578 | monocds <- orderCells(monocds, root_state = 2) 579 | 580 | pdf("CAF_NIF_Trajactory_State.pdf", width = 3.5, height = 3.5) 581 | plot_cell_trajectory( 582 | monocds, 583 | cell_size = 1, color_by = "State", 584 | show_tree = FALSE, show_branch_points = FALSE 585 | ) + 586 | scale_color_manual( 587 | values = c(pal_aaas()(9)[1], "#fe9929", pal_aaas()(9)[3]) 588 | ) + 589 | theme( 590 | axis.text = element_blank(), 591 | axis.title = element_blank(), 592 | axis.ticks = element_blank(), 593 | axis.line = element_blank(), 594 | axis.line.x = NULL, 595 | axis.line.y = NULL, 596 | ) 597 | dev.off() 598 | 599 | pdf("CAF_NIF_Trajactory_Label.pdf", width = 4, height = 4) 600 | plot_cell_trajectory(monocds, 601 | cell_size = 1, 602 | color_by = "label", show_tree = FALSE, show_branch_points = FALSE 603 | ) + 604 | scale_color_manual(values = colo[c(1, 4, 3, 9)]) 605 | dev.off() 606 | 607 | ## The percentage of clusters in each state 608 | mat <- melt(table(monocds@phenoData@data[, c("State", "label")])) 609 | 610 | p <- ggplot(mat, aes(x = State, y = value, fill = label)) + 611 | geom_bar(stat = "identity", position = "fill") + 612 | labs(y = "Proportion (%)") + 613 | scale_fill_manual(values = pal_npg()(4)) + 614 | coord_flip() + 615 | theme_classic() + 616 | theme( 617 | axis.line = element_blank(), 618 | legend.title = element_blank(), 619 | legend.position = "bottom", 620 | panel.grid = element_blank(), 621 | legend.text = element_text(size = 12), 622 | axis.text.y = element_text(size = 10, color = "black"), 623 | axis.title.x = element_text(size = 12), 624 | axis.title.y = element_blank(), 625 | legend.key.size = unit(0.6, "cm"), 626 | axis.text.x = element_text( 627 | color = "black", size = 10 628 | ), 629 | plot.title = element_text(hjust = 0.5) 630 | ) + 631 | scale_y_continuous(expand = c(0, 0.01), labels = percent) 632 | ggsave("CAF_NIF_Trajactory_Proportion.pdf", p, height = 2.5, width = 5) 633 | 634 | beam_res <- BEAM(monocds, branch_point = 1, cores = 40) 635 | beam_res <- beam_res[order(beam_res$qval), ] 636 | beam_res <- beam_res[, c("gene_short_name", "pval", "qval")] 637 | 638 | pdf("CAF_NIF_Trajactory_Heatmap.pdf", height = 8, width = 6) 639 | plot_genes_branched_heatmap(monocds[row.names(subset( 640 | beam_res, 641 | qval < 1e-4 642 | )), ], 643 | branch_point = 1, 644 | num_clusters = 4, 645 | cores = 30, 646 | use_gene_short_name = T, 647 | show_rownames = F 648 | ) 649 | dev.off() 650 | 651 | p <- plot_genes_branched_heatmap(monocds[row.names(subset( 652 | beam_res, 653 | qval < 1e-4 654 | )), ], 655 | branch_point = 1, 656 | num_clusters = 4, 657 | cores = 30, 658 | use_gene_short_name = T, 659 | show_rownames = T, 660 | return_heatmap = T 661 | ) 662 | write.table( 663 | p$annotation_row, "CAF_NIF_Trajactory_Heatmap_Label.txt", 664 | quote = F, sep = "\t" 665 | ) 666 | 667 | hallmark <- getGeneSets(library = "H") 668 | data_set <- list(enriched = hallmark[[14]]@geneIds) 669 | EMT_Scores <- gsva( 670 | as.matrix(CAF_NIF_Randomly@assays$RNA@data), data_set, 671 | min.sz = 5, kcdf = "Poisson", method = "ssgsea", 672 | mx.diff = TRUE, verbose = FALSE, parallel.sz = 20 673 | ) 674 | 675 | monocds@phenoData@data$EMT <- scale(as.vector(t(EMT_Scores))) 676 | monocds@phenoData@data$EMT <- ifelse( 677 | monocds@phenoData@data$EMT > 1.5, 1.5, monocds@phenoData@data$EMT 678 | ) 679 | 680 | pdf("CAF_NIF_Trajactory_EMT.pdf", width = 3.5, height = 3.5) 681 | plot_cell_trajectory( 682 | monocds, 683 | cell_size = 0.5, color_by = "EMT", 684 | show_tree = FALSE, show_branch_points = FALSE 685 | ) + 686 | scale_color_gradientn(colors = rev(col1)) + 687 | theme( 688 | legend.title = element_blank(), 689 | axis.text = element_blank(), 690 | axis.title = element_blank(), 691 | axis.ticks = element_blank(), 692 | axis.line = element_blank(), 693 | axis.line.x = NULL, 694 | axis.line.y = NULL 695 | ) 696 | dev.off() 697 | 698 | EMT_Value <- data.frame( 699 | State = monocds@phenoData@data$State, 700 | EMT = as.vector(t(EMT_Scores)), 701 | subtype = monocds@phenoData@data$tissue 702 | ) 703 | 704 | p <- ggplot(EMT_Value, aes(x = State, y = EMT)) + 705 | geom_jitter(aes(fill = State, color = State), 706 | width = 0.2, shape = 21, size = 0.5 707 | ) + 708 | scale_color_manual( 709 | values = c(pal_aaas()(9)[1], "#fe9929", pal_aaas()(9)[3]) 710 | ) + 711 | scale_fill_manual( 712 | values = c(pal_aaas()(9)[1], "#fe9929", pal_aaas()(9)[3]) 713 | ) + 714 | geom_boxplot( 715 | size = 0.6, fill = "white", 716 | outlier.fill = NA, outlier.color = NA, outlier.size = 0 717 | ) + 718 | theme_classic() + 719 | labs(title = "EMT scores") + 720 | theme( 721 | axis.title.y = element_blank(), 722 | axis.text = element_text(size = 11, color = "black"), 723 | axis.ticks.length = unit(0.4, "lines"), 724 | legend.position = "none", 725 | panel.grid.major = element_blank(), 726 | panel.grid.minor = element_blank(), 727 | axis.line = element_line(color = "black"), 728 | plot.title = element_text(hjust = 0.5) 729 | ) 730 | ggsave("CAF_NIF_Trajactory_EMT_BoxPlot.pdf", p, width = 2.8, height = 3.3) 731 | 732 | CREB3L1_Matrix <- data.frame( 733 | t(monocds@reducedDimS), CAF_NIF_Randomly@assays$RNA@data["CREB3L1", ] 734 | ) 735 | colnames(CREB3L1_Matrix) <- c("Component1", "Component2", "CREB3L1") 736 | CREB3L1_Matrix$group <- monocds@phenoData@data$State 737 | CREB3L1_Matrix <- CREB3L1_Matrix[order(mat$CREB3L1), ] 738 | pdf("creb3l1.pdf", width = 5, height = 3) 739 | ggplot(CREB3L1_Matrix, aes(x = Component1, y = Component2, color = CREB3L1)) + 740 | geom_point(size = 0.5) + 741 | scale_color_gradientn(colors = rev(color_for_use)) + 742 | theme_classic() + 743 | theme( 744 | axis.text = element_blank(), 745 | axis.title = element_blank(), 746 | axis.ticks = element_blank(), 747 | axis.line = element_blank(), 748 | axis.line.x = NULL, 749 | axis.line.y = NULL, 750 | ) 751 | dev.off() 752 | 753 | CREB3L1_Matrix$group <- paste0("State", CREB3L1_Matrix$group) 754 | pdf("CAF_NIF_Trajactory_CREB3L1_Box.pdf", width = 2, height = 3) 755 | ggplot(CREB3L1_Matrix, aes(x = group, y = CREB3L1, fill = group)) + 756 | geom_boxplot(outlier.color = "white", outlier.size = 0) + 757 | theme_classic() + 758 | scale_fill_manual( 759 | values = 760 | c(pal_aaas()(9)[1], "#fe9929", pal_aaas()(9)[3]) 761 | ) + 762 | labs(x = "", y = "Expression levels of CREB3L1") + 763 | theme(legend.position = "none") 764 | dev.off() 765 | 766 | CREB3L1_Matrix$tissue <- CAF_NIF_Randomly$tissue 767 | 768 | p <- ggplot(CREB3L1_Matrix, aes(x = tissue, y = CREB3L1, fill = group)) + 769 | scale_fill_manual(values = c(pal_aaas()(10), rev(pal_aaas()(5)))) + 770 | geom_boxplot( 771 | size = 0.6, 772 | outlier.fill = NA, outlier.color = NA, outlier.size = 0 773 | ) + 774 | theme_bw() + 775 | labs(title = "Expression levels of CREB3L1") + 776 | theme( 777 | axis.title = element_blank(), 778 | axis.text.x = element_text( 779 | size = 11, angle = 45, hjust = 1, color = "black" 780 | ), 781 | axis.text.y = element_text(size = 11, color = "black"), 782 | legend.title = element_blank(), 783 | plot.title = element_text(hjust = 0.5) 784 | ) 785 | ggsave("e_state_creb3l1.pdf", p, width = 5.5, height = 3.3) 786 | 787 | CREB3L1_Target_Genes <- read.table( 788 | "CREB3L1_Target_Genes.txt", 789 | header = T, sep = "\t" 790 | ) 791 | CREB3L1_Target_Genes_Enrichment <- gsva( 792 | as.matrix(CAF_NIF_Randomly@assays$RNA@data), 793 | list(CREB3L1_Target_Genes$gene), 794 | min.sz = 5, kcdf = "Poisson", method = "ssgsea", 795 | mx.diff = TRUE, verbose = FALSE, parallel.sz = 20 796 | ) 797 | monocds@phenoData@data$target <- scale( 798 | as.vector(t(CREB3L1_Target_Genes_Enrichment)) 799 | ) 800 | monocds@phenoData@data$target <- ifelse( 801 | monocds@phenoData@data$target > 1.5, 1.5, monocds@phenoData@data$target 802 | ) 803 | 804 | pdf("CREB3L1_Target_Genes_Enrichment.pdf", width = 3.5, height = 3.5) 805 | plot_cell_trajectory( 806 | monocds, 807 | cell_size = 0.5, color_by = "target", 808 | show_tree = FALSE, show_branch_points = FALSE 809 | ) + 810 | scale_color_gradientn(colors = rev(col1)) + 811 | theme( 812 | legend.title = element_blank(), 813 | axis.text = element_blank(), 814 | axis.title = element_blank(), 815 | axis.ticks = element_blank(), 816 | axis.line = element_blank(), 817 | axis.line.x = NULL, 818 | axis.line.y = NULL 819 | ) 820 | dev.off() 821 | 822 | CREB3L1_Target_Value <- data.frame( # nolint 823 | target = scale(as.vector(t(CREB3L1_Target_Genes_Enrichment))), 824 | t(monocds@reducedDimS), 825 | group = paste0("State", monocds@phenoData@data$State) 826 | ) 827 | colnames(CREB3L1_Target_Value)[2:3] <- c("Component1", "Component2") 828 | pdf("CREB3L1_Target_BoxPlot.pdf", width = 2, height = 2.6) 829 | ggplot(CREB3L1_Target_Value, aes(x = group, y = target, fill = group)) + 830 | geom_boxplot(outlier.color = "white", outlier.size = 0) + 831 | theme_classic() + 832 | scale_fill_manual( 833 | values = c(pal_aaas()(9)[1], "#fe9929", pal_aaas()(9)[3]) 834 | ) + 835 | labs(x = "", y = "Regulon activity of CREB3L1") + 836 | theme( 837 | legend.position = "none", 838 | axis.title.y = element_text(size = 7, color = "black") 839 | ) 840 | dev.off() 841 | -------------------------------------------------------------------------------- /Main_Part3.R: -------------------------------------------------------------------------------- 1 | pkgs <- c( 2 | "Seurat", "SeuratWrappers", "ggplot2", "batchelor", "circlize", 3 | "dplyr", "optparse", "reshape2", "data.table", "magrittr", 4 | "patchwork", "scales", "GSVA", "RColorBrewer", "ggridges", 5 | "clusterProfiler", "survminer", "survminer", "monocle", 6 | "psych", "ggrepel", "pheatmap", "escape", "multcomp", "agricolae" 7 | ) 8 | 9 | color_for_use <- c( 10 | "#8F2A47", "#B83A4D", "#D25C52", "#E27E56", 11 | "#ECA86B", "#F4CB85", "#F8E8A2", "#FAF8C7", "#EBF0AF", 12 | "#CEE2A2", "#ABD3A6", "#82C3A5", "#609EB0", "#4C78B1", 13 | "#5C519B" 14 | ) 15 | 16 | lapply(pkgs, function(x) require(package = x, character.only = TRUE, quietly = TRUE, warn.conflicts = FALSE)) # nolint 17 | source("Dependent_SCENIC.R") 18 | source("Dependent_Monocle.R") 19 | source("Dependent_Escape.R") 20 | 21 | data <- readRDS("final_input1.Rds") 22 | 23 | ## Subcluster analysis for Lymphocyte 24 | lymphocyte_clusters <- subset(data, ident = 9:17) 25 | lymphocyte_clusters %<>% NormalizeData(object = ., normalization.method = "LogNormalize") %>% # nolint 26 | FindVariableFeatures(selection.method = "vst") 27 | 28 | all.genes <- rownames(lymphocyte__clusters) 29 | lymphocyte_clusters %<>% ScaleData(object = ., features = all.genes) %>% 30 | ScaleData(object = ., vars.to.regress = "percent.mt") 31 | lymphocyte_clusters %<>% RunPCA( 32 | object = ., 33 | features = VariableFeatures(object = .) 34 | ) %>% 35 | RunFastMNN(object = ., object.list = SplitObject(., split.by = "SampleID")) 36 | 37 | lymphocyte_clusters %<>% FindNeighbors(reduction = "mnn", dims = 1:30) %>% 38 | FindClusters(resolution = 1.2) %<>% 39 | RunTSNE(reduction = "mnn", dims = 1:30) %>% 40 | RunUMAP(reduction = "mnn", dims = 1:30) 41 | 42 | saveRDS(lymphocyte_clusters, "lymphocyte_clusters.Rds") 43 | 44 | lymphocyte_clusters_anno <- subset(lymphocyte_clusters, ident = c(0:12, 14, 16)) 45 | lymphocyte_clusters_anno <- RenameIdents(lymphocyte_clusters_anno, 46 | "0" = "CD8+ TEM", "5" = "CD8+ TEM", "8" = "CD8+ TEM", 47 | "10" = "CD8+ TEM", "1" = "CD4+ TCM", "7" = "CD4+ TCM", 48 | "4" = "Treg", "14" = "Cycling CD4+ T", "2" = "DN T", 49 | "9" = "CD8+ CTL", "3" = "PDCD1+ CD8+ T", 50 | "12" = "Cycling CD8+ T", "16" = "Cycling NKC", 51 | "6" = "TIM3+ NKC", "11" = "CD160+ NKC" 52 | ) 53 | 54 | pdf("Lymphocyte_Umap.pdf", width = 4, height = 4) 55 | DimPlot(lymphocyte_clusters_anno, label = T) + NoLegend() + 56 | scale_color_manual(values = c(pal_npg()(9), pal_jama()(5))) + 57 | theme( 58 | axis.text = element_blank(), 59 | axis.title = element_blank(), 60 | axis.ticks = element_blank(), 61 | axis.line = element_blank() 62 | ) 63 | dev.off() 64 | 65 | Lymphocyte_Marker <- FindAllMarkers( 66 | ss, 67 | only.pos = TRUE, min.pct = 0.25, logfc.threshold = 0.25 68 | ) 69 | write.table(Lymphocyte_Marker, "Lymphocyte_Marker.txt", quote = F, sep = "\t") 70 | 71 | Select_Genes <- c() 72 | for (i in unique(Lymphocyte_Marker$cluster)) { 73 | Select_Genes <- append( 74 | Select_Genes, 75 | marker[which(Lymphocyte_Marker$cluster == i), "gene"][1:5] 76 | ) 77 | } 78 | 79 | lymphocyte_clusters_anno@active.ident <- factor( 80 | lymphocyte_clusters_anno@active.ident, 81 | levels = rev(levels(lymphocyte_clusters_anno)) 82 | ) 83 | pdf("Lymphocyte_.pdf", width = 11, height = 4.5) 84 | DotPlot(lymphocyte_clusters_anno, 85 | features = unique(Select_Genes), 86 | cols = c( 87 | "#FAFCFA", "#4D9157" 88 | ) 89 | ) + 90 | theme_bw() + 91 | theme( 92 | axis.title = element_blank(), 93 | axis.text.x = element_text(angle = 45, hjust = 1, color = "black"), 94 | axis.text.y = element_text(color = "black"), 95 | panel.grid.major = element_blank() 96 | ) 97 | dev.off() 98 | 99 | lymphocyte_clusters_anno$seurat_clusters <- lymphocyte_clusters_anno@active.ident # nolint 100 | lymphocyte_table <- table( 101 | lymphocyte_clusters_anno@meta.data[, c("group", "seurat_clusters")] 102 | ) 103 | lymphocyte_table <- melt(lymphocyte_table / as.vector(table(data$group))) 104 | lymphocyte_table$group <- factor( 105 | lymphocyte_table$group, 106 | levels = c("Normal", "Adjacent", "Tumor") 107 | ) 108 | p <- ggplot( 109 | lymphocyte_table, 110 | aes(x = seurat_clusters, y = value, fill = group) 111 | ) + 112 | geom_bar(stat = "identity", position = "fill") + 113 | theme_classic() + 114 | coord_flip() + 115 | scale_fill_manual( 116 | values = c( 117 | pal_aaas()(9)[c(1, 3, 2)] 118 | ) 119 | ) + 120 | labs(y = "Proportion", x = "") + 121 | theme( 122 | axis.line = element_blank(), 123 | legend.title = element_blank(), 124 | axis.text.x = element_text(angle = 45, hjust = 1, color = "black"), 125 | panel.grid = element_blank(), 126 | legend.text = element_text(size = 12), 127 | axis.text.y = element_text(size = 10, color = "black"), 128 | axis.title = element_text(size = 12), 129 | legend.key.size = unit(0.6, "cm") 130 | ) + 131 | scale_y_continuous(expand = c(0, 0.01), labels = percent) 132 | 133 | ggsave("Lymphocyte_Clusters_Percent.pdf", p, width = 5, height = 3.5) 134 | 135 | ## CAF vs DC sub-clusters 136 | CAF_DC <- read.table("GO/go4/r11/out/count_network.txt", header = T, sep = "\t") 137 | set.seed(15) 138 | pdf("CAF_DC.pdf", width = 3.5, height = 3.5) 139 | chordDiagram(CAF_DC, transparency = 0.5) 140 | dev.off() 141 | 142 | mypvals <- read.delim("GO/go4/r11/out/pvalues.txt", check.names = FALSE) 143 | mymeans <- read.delim("GO/go4/r11/out/means.txt", check.names = FALSE) 144 | 145 | costimulatory1 <- read.table("lire/DC-CAF.txt", header = F, sep = "\t") 146 | costimulatory2 <- read.table("lire/CAF-DC.txt", header = F, sep = "\t") 147 | 148 | mypvals %>% 149 | dplyr::filter(interacting_pair %in% costimulatory2$V1) %>% 150 | dplyr::select("interacting_pair", starts_with("state")) %>% 151 | reshape2::melt() -> pvalsdf 152 | pvalsdf <- pvalsdf[-grep("[|]state", pvalsdf$variable), ] 153 | colnames(pvalsdf) <- c("interacting_pair", "CC", "pvals") 154 | mat <- dcast(pvalsdf, CC ~ interacting_pair) 155 | rownames(mat) <- mat$CC 156 | mat <- t(mat[, -1]) 157 | mat <- -log10(mat + 0.0001) 158 | for (i in 1:nrow(mat)) { 159 | for (j in 1:ncol(mat)) { 160 | if (mat[i, j] < 0) { 161 | mat[i, j] <- 0 162 | } 163 | } 164 | } 165 | 166 | mat <- mat[-nrow(mat), ] 167 | annotation_col <- data.frame( 168 | celltype = rep(paste0("state2", "state3"), each = 6), 169 | group = rep(paste0("dc", 0:5), time = 3) 170 | ) 171 | rownames(annotation_col) <- colnames(mat) 172 | 173 | col1 <- pal_npg("nrc")(3) 174 | names(col1) <- paste0("state", 1:3) 175 | col2 <- pal_aaas()(6) 176 | names(col2) <- paste0("dc", 0:5) 177 | ann_colors <- list( 178 | group = col2, 179 | celltype = col1 180 | ) 181 | 182 | bk <- c(seq(0, 4, by = 0.01)) 183 | pdf("CAF-DC_Ligand_Receptor1.pdf", width = 6.5, height = 3) 184 | pheatmap(mat, 185 | show_colnames = FALSE, annotation_col = annotation_col, 186 | annotation_colors = ann_colors, 187 | show_rownames = T, cluster_cols = FALSE, 188 | cluster_rows = T, color = colorRampPalette( 189 | colors = rev(c(brewer.pal(11, "RdGy")[1:6], "white")) 190 | )(length(bk)), 191 | annotation_legend = TRUE, treeheight_row = 5, 192 | fontsize = 12, annotation_names_col = FALSE, border_color = "gray", 193 | ) 194 | dev.off() 195 | 196 | mypvals %>% 197 | dplyr::filter(interacting_pair %in% costimulatory1$V1) %>% 198 | dplyr::select("interacting_pair", grep("state[1-3]$", names(mypvals))) %>% 199 | reshape2::melt() -> pvalsdf 200 | pvalsdf <- pvalsdf[-grep("^state", pvalsdf$variable), ] 201 | colnames(pvalsdf) <- c("interacting_pair", "CC", "pvals") 202 | mat <- dcast(pvalsdf, CC ~ interacting_pair) 203 | rownames(mat) <- mat$CC 204 | mat <- t(mat[, -1]) 205 | mat <- -log10(mat + 0.0001) 206 | for (i in 1:nrow(mat)) { 207 | for (j in 1:ncol(mat)) { 208 | if (mat[i, j] < 0) { 209 | mat[i, j] <- 0 210 | } 211 | } 212 | } 213 | ord <- colnames(mat)[c( 214 | grep("state1", colnames(mat)), 215 | grep("state2", colnames(mat)), 216 | grep("state3", colnames(mat)) 217 | )] 218 | mat <- mat[, ord] 219 | annotation_col <- data.frame( 220 | celltype = rep(paste0("state", 1:3), each = 6), 221 | group = rep(paste0("dc", 0:5), time = 3) 222 | ) 223 | rownames(annotation_col) <- colnames(mat) 224 | 225 | col1 <- pal_npg("nrc")(3) 226 | names(col1) <- paste0("state", 1:3) 227 | col2 <- pal_aaas()(6) 228 | names(col2) <- paste0("dc", 0:5) 229 | ann_colors <- list( 230 | group = col2, 231 | celltype = col1 232 | ) 233 | 234 | bk <- c(seq(0, 4, by = 0.01)) 235 | pdf("DC-CAF_Ligand_Receptor2.pdf", width = 6.5, height = 3) 236 | pheatmap(mat, 237 | show_colnames = FALSE, annotation_col = annotation_col, 238 | annotation_colors = ann_colors, 239 | show_rownames = T, cluster_cols = FALSE, 240 | cluster_rows = T, color = colorRampPalette( 241 | colors = rev(c(brewer.pal(11, "RdGy")[1:6], "white")) 242 | )(length(bk)), 243 | annotation_legend = TRUE, treeheight_row = 5, 244 | fontsize = 12, annotation_names_col = FALSE, border_color = "gray", 245 | ) 246 | dev.off() 247 | 248 | ## CAF vs B sub-clusters 249 | CAF_B <- read.table("GO/go4/r10/out/count_network.txt", header = T, sep = "\t") 250 | set.seed(15) 251 | pdf("caf_B.pdf", width = 3.5, height = 3.5) 252 | chordDiagram(CAF_B, transparency = 0.5) 253 | dev.off() 254 | 255 | mypvals <- read.delim("GO/go4/r10/out/pvalues.txt", check.names = FALSE) 256 | mymeans <- read.delim("GO/go4/r10/out/means.txt", check.names = FALSE) 257 | 258 | costimulatory1 <- read.table("lire/CAF-B.txt", header = F, sep = "\t") 259 | 260 | mypvals %>% 261 | dplyr::filter(interacting_pair %in% costimulatory1$V1) %>% 262 | dplyr::select("interacting_pair", starts_with("state")) %>% 263 | reshape2::melt() -> pvalsdf 264 | pvalsdf <- pvalsdf[-grep("[|]state", pvalsdf$variable), ] 265 | colnames(pvalsdf) <- c("interacting_pair", "CC", "pvals") 266 | mat <- dcast(pvalsdf, CC ~ interacting_pair) 267 | rownames(mat) <- mat$CC 268 | mat <- t(mat[, -1]) 269 | mat <- -log10(mat + 0.0001) 270 | for (i in 1:nrow(mat)) { 271 | for (j in 1:ncol(mat)) { 272 | if (mat[i, j] < 0) { 273 | mat[i, j] <- 0 274 | } 275 | } 276 | } 277 | 278 | annotation_col <- data.frame( 279 | celltype = rep(paste0("state", 1:3), each = 8), 280 | group = rep(paste0("B_sc", 0:7), time = 3) 281 | ) 282 | rownames(annotation_col) <- colnames(mat) 283 | 284 | col1 <- pal_npg("nrc")(3) 285 | names(col1) <- paste0("state", 1:3) 286 | col2 <- pal_aaas()(8) 287 | names(col2) <- paste0("B_sc", 0:7) 288 | ann_colors <- list( 289 | group = col2, 290 | celltype = col1 291 | ) 292 | 293 | bk <- c(seq(0, 4, by = 0.01)) 294 | pdf("CAF_B_Ligand_Receptor1.pdf", width = 6.5, height = 3) 295 | pheatmap(mat, 296 | show_colnames = FALSE, annotation_col = annotation_col, 297 | annotation_colors = ann_colors, 298 | show_rownames = T, cluster_cols = FALSE, 299 | cluster_rows = T, color = colorRampPalette( 300 | colors = rev(c(brewer.pal(11, "RdGy")[1:6], "white")) 301 | )(length(bk)), 302 | annotation_legend = TRUE, treeheight_row = 5, 303 | fontsize = 12, annotation_names_col = FALSE, border_color = "gray", 304 | ) 305 | dev.off() 306 | 307 | mypvals %>% 308 | dplyr::filter(interacting_pair %in% costimulatory1$V1) %>% 309 | dplyr::select("interacting_pair", grep("state[1-3]$", names(mypvals))) %>% 310 | reshape2::melt() -> pvalsdf 311 | pvalsdf <- pvalsdf[-grep("^state", pvalsdf$variable), ] 312 | colnames(pvalsdf) <- c("interacting_pair", "CC", "pvals") 313 | mat <- dcast(pvalsdf, CC ~ interacting_pair) 314 | rownames(mat) <- mat$CC 315 | mat <- t(mat[, -1]) 316 | mat <- -log10(mat + 0.0001) 317 | for (i in 1:nrow(mat)) { 318 | for (j in 1:ncol(mat)) { 319 | if (mat[i, j] < 0) { 320 | mat[i, j] <- 0 321 | } 322 | } 323 | } 324 | ord <- colnames(mat)[c( 325 | grep("state1", colnames(mat)), 326 | grep("state2", colnames(mat)), 327 | grep("state3", colnames(mat)) 328 | )] 329 | mat <- mat[, ord] 330 | 331 | annotation_col <- data.frame( 332 | celltype = rep(paste0("state", 1:3), each = 8), 333 | group = rep(paste0("B_sc", 0:7), time = 3) 334 | ) 335 | rownames(annotation_col) <- colnames(mat) 336 | 337 | col1 <- pal_npg("nrc")(3) 338 | names(col1) <- paste0("state", 1:3) 339 | col2 <- pal_aaas()(8) 340 | names(col2) <- paste0("B_sc", 0:7) 341 | ann_colors <- list( 342 | group = col2, 343 | celltype = col1 344 | ) 345 | 346 | bk <- c(seq(0, 4, by = 0.01)) 347 | pdf("B_CAF_Ligand_Receptor2.pdf", width = 6.5, height = 3) 348 | pheatmap(mat, 349 | show_colnames = FALSE, annotation_col = annotation_col, 350 | annotation_colors = ann_colors, 351 | show_rownames = T, cluster_cols = FALSE, 352 | cluster_rows = T, color = colorRampPalette( 353 | colors = rev(c(brewer.pal(11, "RdGy")[1:6], "white")) 354 | )(length(bk)), 355 | annotation_legend = TRUE, treeheight_row = 5, 356 | fontsize = 12, annotation_names_col = FALSE, border_color = "gray", 357 | ) 358 | dev.off() 359 | 360 | ## CAF vs TEC/NEC 361 | CAF_TECNEC <- read.table("GO/go4/r2/out/count_network.txt", header = T, sep = "\t") # nolint 362 | set.seed(15) 363 | pdf("CAF_TECNEC.pdf", width = 3.5, height = 3.5) 364 | chordDiagram(CAF_TECNEC, transparency = 0.5) 365 | dev.off() 366 | 367 | mypvals <- read.delim("GO/go4/r2/out/pvalues.txt", check.names = FALSE) 368 | mymeans <- read.delim("GO/go4/r2/out/means.txt", check.names = FALSE) 369 | 370 | costimulatory1 <- read.table("lire/TEC-CAF.txt", header = F, sep = "\t") 371 | costimulatory2 <- read.table("lire/CAF-TEC.txt", header = F, sep = "\t") 372 | 373 | mypvals %>% 374 | dplyr::filter(interacting_pair %in% costimulatory2$V1) %>% 375 | dplyr::select("interacting_pair", starts_with("state")) %>% 376 | reshape2::melt() -> pvalsdf 377 | pvalsdf <- pvalsdf[-grep("[|]state", pvalsdf$variable), ] 378 | colnames(pvalsdf) <- c("interacting_pair", "CC", "pvals") 379 | mat <- dcast(pvalsdf, CC ~ interacting_pair) 380 | rownames(mat) <- mat$CC 381 | mat <- t(mat[, -1]) 382 | mat <- -log10(mat + 0.0001) 383 | for (i in 1:nrow(mat)) { 384 | for (j in 1:ncol(mat)) { 385 | if (mat[i, j] < 0) { 386 | mat[i, j] <- 0 387 | } 388 | } 389 | } 390 | 391 | annotation_col <- data.frame( 392 | celltype = rep(paste0("state", 1:3), each = 2), 393 | group = rep(c("NEC", "TEC"), time = 3) 394 | ) 395 | rownames(annotation_col) <- colnames(mat) 396 | 397 | col1 <- pal_npg("nrc")(3) 398 | names(col1) <- paste0("state", 1:3) 399 | col2 <- pal_aaas()(2) 400 | names(col2) <- c("NEC", "TEC") 401 | ann_colors <- list( 402 | group = col2, 403 | celltype = col1 404 | ) 405 | 406 | bk <- c(seq(0, 4, by = 0.01)) 407 | pdf("CAF_TECNEC_Ligand_Receptor1.pdf", width = 4.5, height = 3) 408 | pheatmap(mat, 409 | show_colnames = FALSE, annotation_col = annotation_col, 410 | annotation_colors = ann_colors, 411 | show_rownames = T, cluster_cols = FALSE, 412 | cluster_rows = T, color = colorRampPalette( 413 | colors = rev(c(brewer.pal(11, "RdGy")[1:6], "white")) 414 | )(length(bk)), 415 | annotation_legend = TRUE, treeheight_row = 5, 416 | fontsize = 12, annotation_names_col = FALSE, border_color = "gray", 417 | ) 418 | dev.off() 419 | 420 | mypvals %>% 421 | dplyr::filter(interacting_pair %in% costimulatory1$V1) %>% 422 | dplyr::select("interacting_pair", grep("state[1-3]$", names(mypvals))) %>% 423 | reshape2::melt() -> pvalsdf 424 | pvalsdf <- pvalsdf[-grep("^state", pvalsdf$variable), ] 425 | colnames(pvalsdf) <- c("interacting_pair", "CC", "pvals") 426 | mat <- dcast(pvalsdf, CC ~ interacting_pair) 427 | rownames(mat) <- mat$CC 428 | mat <- t(mat[, -1]) 429 | mat <- -log10(mat + 0.0001) 430 | for (i in 1:nrow(mat)) { 431 | for (j in 1:ncol(mat)) { 432 | if (mat[i, j] < 0) { 433 | mat[i, j] <- 0 434 | } 435 | } 436 | } 437 | ord <- colnames(mat)[c( 438 | grep("state1", colnames(mat)), 439 | grep("state2", colnames(mat)), 440 | grep("state3", colnames(mat)) 441 | )] 442 | mat <- mat[, ord] 443 | annotation_col <- data.frame( 444 | celltype = rep(paste0("state", 1:3), each = 2), 445 | group = rep(c("NEC", "TEC"), time = 3) 446 | ) 447 | rownames(annotation_col) <- colnames(mat) 448 | 449 | col1 <- pal_npg("nrc")(3) 450 | names(col1) <- paste0("state", 1:3) 451 | col2 <- pal_aaas()(2) 452 | names(col2) <- c("NEC", "TEC") 453 | ann_colors <- list( 454 | group = col2, 455 | celltype = col1 456 | ) 457 | 458 | bk <- c(seq(0, 4, by = 0.01)) 459 | pdf("TECNEC_CAF_Ligand_Receptor2.pdf", width = 4.5, height = 3.5) 460 | pheatmap(mat, 461 | show_colnames = FALSE, annotation_col = annotation_col, 462 | annotation_colors = ann_colors, 463 | show_rownames = T, cluster_cols = FALSE, 464 | cluster_rows = T, color = colorRampPalette( 465 | colors = rev(c(brewer.pal(11, "RdGy")[1:6], "white")) 466 | )(length(bk)), 467 | annotation_legend = TRUE, treeheight_row = 5, 468 | fontsize = 12, annotation_names_col = FALSE, border_color = "gray", 469 | ) 470 | dev.off() 471 | 472 | ## CAF vs NKT sub-clusters 473 | CAF_NKT <- read.table("figure3/3C/out/count_network.txt", header = T, sep = "\t") # nolint 474 | set.seed(15) 475 | pdf("CAF_NKT.pdf", width = 3.5, height = 3.5) 476 | chordDiagram(CAF_NKT, transparency = 0.5) 477 | dev.off() 478 | 479 | mypvals <- read.delim("figure3/3C/out/pvalues.txt", check.names = FALSE) 480 | mymeans <- read.delim("figure3/3C/out/means.txt", check.names = FALSE) 481 | 482 | costimulatory1 <- read.table("lire/NKT-CAF.txt", header = F, sep = "\t") 483 | costimulatory2 <- read.table("lire/CAF-NKT.txt", header = F, sep = "\t") 484 | 485 | mypvals %>% 486 | dplyr::filter(interacting_pair %in% costimulatory2$V1) %>% 487 | dplyr::select("interacting_pair", starts_with("state")) %>% 488 | reshape2::melt() -> pvalsdf 489 | pvalsdf <- pvalsdf[-grep("[|]state", pvalsdf$variable), ] 490 | colnames(pvalsdf) <- c("interacting_pair", "CC", "pvals") 491 | mat <- dcast(pvalsdf, CC ~ interacting_pair) 492 | rownames(mat) <- mat$CC 493 | mat <- t(mat[, -1]) 494 | mat <- -log10(mat + 0.0001) 495 | for (i in 1:nrow(mat)) { 496 | for (j in 1:ncol(mat)) { 497 | if (mat[i, j] < 0) { 498 | mat[i, j] <- 0 499 | } 500 | } 501 | } 502 | 503 | annotation_col <- data.frame( 504 | celltype = rep(c("state1", "state2", "state3"), each = 11), 505 | group = rep(sapply(strsplit(colnames(mat), "|", fixed = T), "[", 2)[1:11], time = 3) 506 | ) 507 | rownames(annotation_col) <- colnames(mat) 508 | 509 | col1 <- pal_npg("nrc")(3) 510 | names(col1) <- c("state1", "state2", "state3") 511 | col2 <- c(pal_aaas()(9), "#C7A162", "black") 512 | names(col2) <- sapply(strsplit(colnames(mat), "|", fixed = T), "[", 2)[1:11] 513 | ann_colors <- list( 514 | group = col2, 515 | celltype = col1 516 | ) 517 | 518 | annotation_col$celltype <- factor( 519 | annotation_col$celltype, 520 | levels = paste0("state", 1:3) 521 | ) 522 | annotation_col$group <- factor( 523 | annotation_col$group, 524 | levels = annotation_col$group[1:11] 525 | ) 526 | annotation_col <- annotation_col[ 527 | order( 528 | annotation_col$group, 529 | annotation_col$celltype 530 | ), 531 | ] 532 | 533 | bk <- c(seq(0, 4, by = 0.01)) 534 | pdf("CAF-NKT_Ligand_Receptor1.pdf", width = 8, height = 4) 535 | pheatmap(mat[, rownames(annotation_col)], 536 | show_colnames = FALSE, annotation_col = annotation_col, 537 | annotation_colors = ann_colors, 538 | show_rownames = T, cluster_cols = FALSE, 539 | cluster_rows = T, color = colorRampPalette( 540 | colors = rev(c(brewer.pal(11, "RdGy")[1:6], "white")) 541 | )(length(bk)), 542 | annotation_legend = TRUE, treeheight_row = 5, 543 | fontsize = 12, annotation_names_col = FALSE, border_color = "gray", 544 | ) 545 | dev.off() 546 | 547 | mypvals %>% 548 | dplyr::filter(interacting_pair %in% costimulatory1$V1) %>% 549 | dplyr::select("interacting_pair", grep("state[1-3]$", names(mypvals))) %>% 550 | reshape2::melt() -> pvalsdf 551 | pvalsdf <- pvalsdf[-grep("^state", pvalsdf$variable), ] 552 | colnames(pvalsdf) <- c("interacting_pair", "CC", "pvals") 553 | mat <- dcast(pvalsdf, CC ~ interacting_pair) 554 | rownames(mat) <- mat$CC 555 | mat <- t(mat[, -1]) 556 | mat <- -log10(mat + 0.0001) 557 | for (i in 1:nrow(mat)) { 558 | for (j in 1:ncol(mat)) { 559 | if (mat[i, j] < 0) { 560 | mat[i, j] <- 0 561 | } 562 | } 563 | } 564 | ord <- colnames(mat)[ 565 | c( 566 | grep("state1", colnames(mat)), 567 | grep("state2", colnames(mat)), 568 | grep("state3", colnames(mat)) 569 | ) 570 | ] 571 | mat <- mat[, ord] 572 | 573 | annotation_col <- data.frame( 574 | celltype = rep(paste0("state", 1:3), each = 11), 575 | group = rep( 576 | unique(sapply(strsplit(colnames(mat), "|", fixed = T), "[", 1)), 577 | time = 3 578 | ) 579 | ) 580 | rownames(annotation_col) <- colnames(mat) 581 | 582 | col1 <- pal_npg("nrc")(3) 583 | names(col1) <- paste0("state", 1:3) 584 | col2 <- c(pal_aaas()(9), "#C7A162", "black") 585 | names(col2) <- unique(sapply(strsplit(colnames(mat), "|", fixed = T), "[", 1)) 586 | ann_colors <- list( 587 | group = col2, 588 | celltype = col1 589 | ) 590 | annotation_col$celltype <- factor( 591 | annotation_col$celltype, 592 | levels = paste0("state", 1:3) 593 | ) 594 | annotation_col$group <- factor( 595 | annotation_col$group, 596 | levels = annotation_col$group[1:11] 597 | ) 598 | annotation_col <- annotation_col[ 599 | order(annotation_col$group, annotation_col$celltype), 600 | ] 601 | 602 | bk <- c(seq(0, 4, by = 0.01)) 603 | pdf("NKT-CAF_Ligand_Receptor2.pdf", width = 8, height = 4) 604 | pheatmap(mat[, rownames(annotation_col)], 605 | show_colnames = FALSE, annotation_col = annotation_col, 606 | annotation_colors = ann_colors, 607 | show_rownames = T, cluster_cols = FALSE, 608 | cluster_rows = T, color = colorRampPalette( 609 | colors = rev(c(brewer.pal(11, "RdGy")[1:6], "white")) 610 | )(length(bk)), 611 | annotation_legend = TRUE, treeheight_row = 5, 612 | fontsize = 12, annotation_names_col = FALSE, border_color = "gray", 613 | ) 614 | dev.off() 615 | 616 | ## survival analysis 617 | ## UCC_CAF state3 618 | data <- read.table("UCC.txt", sep = "\t", header = T) 619 | 620 | data <- data[order(data$Fibroblast_3), ] 621 | mt <- rbind( 622 | data.frame(data[1:270, ], 623 | group = rep("LOW", 270) 624 | ), 625 | data.frame(data[(nrow(data) - 77):nrow(data), ], 626 | group = rep("HIGH", 78) 627 | ) 628 | ) 629 | 630 | mt$event <- ifelse(mt$event == 0, 1, 2) 631 | fit <- survfit(Surv(time, event) ~ group, data = mt) 632 | p <- ggsurvplot(fit, 633 | data = mt, pval = TRUE, conf.int = TRUE, 634 | risk.table = TRUE, risk.table.col = "strata", 635 | linetype = "strata", 636 | surv.median.line = "hv", 637 | ggtheme = theme_bw(), 638 | palette = c("red", "blue") 639 | ) 640 | 641 | pdf("UCC_CAF_State3.pdf") 642 | print(p, newpage = FALSE) 643 | dev.off() 644 | 645 | ### UUS_CAF state3 646 | data <- read.table("UUS.txt", sep = "\t", header = T) 647 | 648 | data <- data[order(data$Fibroblast_3), ] 649 | mt <- rbind( 650 | data.frame(data[1:16, ], 651 | group = rep("LOW", 16) 652 | ), 653 | data.frame(data[(nrow(data) - 33):nrow(data), ], 654 | group = rep("HIGH", 34) 655 | ) 656 | ) 657 | mt$event <- ifelse(mt$event == 0, 1, 2) 658 | fit <- survfit(Surv(time, event) ~ group, data = mt) 659 | p <- ggsurvplot(fit, 660 | data = mt, pval = TRUE, conf.int = TRUE, 661 | risk.table = TRUE, risk.table.col = "strata", 662 | linetype = "strata", 663 | surv.median.line = "hv", 664 | ggtheme = theme_bw(), 665 | palette = c("red", "blue") 666 | ) 667 | pdf("UUS_CAF_State3.pdf") 668 | print(p, newpage = FALSE) 669 | dev.off() 670 | 671 | ####### Melanoma_CAF state3 672 | data <- read.table("melanoma_liu.txt", sep = "\t", header = T) 673 | 674 | data <- data[order(data$Fibroblast_3), ] 675 | mt <- rbind( 676 | data.frame(data[1:41, ], 677 | group = rep("LOW", 41) 678 | ), 679 | data.frame(data[(nrow(data) - 79):nrow(data), ], 680 | group = rep("HIGH", 80) 681 | ) 682 | ) 683 | 684 | mt$event <- ifelse(mt$event == 0, 1, 2) 685 | fit <- survfit(Surv(time, event) ~ group, data = mt) 686 | p <- ggsurvplot(fit, 687 | data = mt, pval = TRUE, conf.int = TRUE, 688 | risk.table = TRUE, risk.table.col = "strata", 689 | linetype = "strata", 690 | surv.median.line = "hv", 691 | ggtheme = theme_bw(), 692 | palette = c("red", "blue") 693 | ) 694 | pdf("Melanoma_CAF_State3.pdf") 695 | print(p, newpage = FALSE) 696 | dev.off() 697 | -------------------------------------------------------------------------------- /Main_Part4.R: -------------------------------------------------------------------------------- 1 | pkgs <- c( 2 | "Seurat", "SeuratWrappers", "ggplot2", "batchelor", "circlize", 3 | "dplyr", "optparse", "reshape2", "data.table", "magrittr", 4 | "patchwork", "scales", "GSVA", "RColorBrewer", "ggridges", "ggridges", 5 | "clusterProfiler", "survminer", "survminer", "monocle", "tidyverse", 6 | "psych", "ggrepel", "pheatmap", "escape", "multcomp", "agricolae" 7 | ) 8 | 9 | color_for_use <- c( 10 | "#8F2A47", "#B83A4D", "#D25C52", "#E27E56", 11 | "#ECA86B", "#F4CB85", "#F8E8A2", "#FAF8C7", "#EBF0AF", 12 | "#CEE2A2", "#ABD3A6", "#82C3A5", "#609EB0", "#4C78B1", 13 | "#5C519B" 14 | ) 15 | 16 | lapply(pkgs, function(x) require(package = x, character.only = TRUE, quietly = TRUE, warn.conflicts = FALSE)) # nolint 17 | source("Dependent_SCENIC.R") 18 | source("Dependent_Monocle.R") 19 | source("Dependent_Escape.R") 20 | 21 | data <- readRDS("final_input1.Rds") 22 | 23 | FIB <- subset(data, ident = c(1, 2, 4, 5, 3, 6, 7, 8)) 24 | pdf("FIB_Markers1.pdf", width = 8, height = 3) 25 | DotPlot(FIB, 26 | features = c( 27 | "ACTA2", "DCN", "CD86", "FCGR1A", 28 | "MRC1", "CD163", "CD68", "CD14" 29 | ), cols = c("#FAFCFA", "#4D9157") 30 | ) + 31 | theme_bw() + 32 | theme( 33 | axis.title = element_blank(), 34 | axis.text.x = element_text(angle = 45, hjust = 1, color = "black"), 35 | axis.text.y = element_text(color = "black"), 36 | panel.grid.major = element_blank() 37 | ) 38 | 39 | dev.off() 40 | 41 | pdf("FIB_Markers_Vln1.pdf", width = 8, height = 3) 42 | VlnPlot(FIB, 43 | features = c("ACTA2", "HLA-DRA", "CD74"), 44 | pt.size = 0, ncol = 3 45 | ) & 46 | scale_fill_manual(values = color1) & 47 | theme( 48 | axis.title.x = element_blank(), 49 | axis.text.x = element_text(angle = 45, hjust = 1) 50 | ) 51 | dev.off() 52 | 53 | pdf("FIB_Markers_Vln1.pdf", width = 8, height = 3) 54 | VlnPlot(FIB, 55 | features = c("ACTA2", "HLA-DRA", "CD74"), 56 | pt.size = 0, ncol = 3 57 | ) & 58 | scale_fill_manual(values = pal_npg()(8)) & 59 | theme( 60 | axis.title.x = element_blank(), 61 | axis.text.x = element_text(angle = 45, hjust = 1) 62 | ) 63 | dev.off() 64 | 65 | pdf("FIB_Markers_Vln2.pdf", width = 8, height = 3) 66 | VlnPlot(FIB, 67 | features = c("MPZ", "S100B", "PLP1", "LGI4"), 68 | pt.size = 0, ncol = 2 69 | ) & 70 | scale_fill_manual(values = pal_npg()(8)) & 71 | theme( 72 | axis.title.x = element_blank(), 73 | axis.text.x = element_text(angle = 45, hjust = 1) 74 | ) 75 | dev.off() 76 | 77 | ## Trajactory analysis of CAFmyo, TAM and CAFapi 78 | subset1 <- subset(data, ident = 8) 79 | 80 | Select_Cells <- c() 81 | for (i in c(20, 1)) { 82 | object_select <- subset(data, ident = i) 83 | set.seed(1) 84 | Select_Cells <- append( 85 | Select_Cells, rownames(object_select@meta.data[ 86 | sample(1:nrow(object_select@meta.data), 500), 87 | ]) 88 | ) 89 | } 90 | 91 | monotj <- subset( 92 | data, 93 | cells = c(Select_Cells, rownames(object_select@meta.data)) 94 | ) 95 | monocds <- RunMonocle(monotj) 96 | monocds <- orderCells(monocds, root_state = 5) 97 | 98 | pdf("CAF_TAM_Trajactory_State.pdf", width = 3.5, height = 4) 99 | plot_cell_trajectory( 100 | monocds, 101 | cell_size = 1, color_by = "State", show_tree = FALSE, 102 | show_branch_points = FALSE 103 | ) + 104 | scale_color_manual(values = pal_aaas(alpha = 0.8)(9)[c(1, 2, 4, 3, 9)]) + 105 | theme( 106 | axis.text = element_blank(), 107 | axis.title = element_blank(), 108 | axis.ticks = element_blank(), 109 | axis.line = element_blank(), 110 | axis.line.x = NULL, 111 | axis.line.y = NULL, 112 | ) 113 | dev.off() 114 | 115 | monocds@phenoData@data$clusters <- paste0("c", monocds@phenoData@data$Clusters) 116 | pdf("CAF_TAM_Trajactory_Cluster.pdf", width = 3.5, height = 3.5) 117 | plot_cell_trajectory( 118 | monocds, 119 | cell_size = 1, color_by = "clusters", show_tree = FALSE, 120 | show_branch_points = FALSE 121 | ) + 122 | scale_color_manual(values = pal_npg()(9)[c(4, 2, 5)]) + 123 | theme( 124 | axis.text = element_blank(), 125 | axis.title = element_blank(), 126 | axis.ticks = element_blank(), 127 | axis.line = element_blank(), 128 | axis.line.x = NULL, 129 | axis.line.y = NULL, 130 | ) 131 | dev.off() 132 | 133 | pdf("CAF_TAM_Trajactory_Pseudotime1.pdf", width = 3.5, height = 3.5) 134 | plot_cell_trajectory( 135 | monocds, 136 | cell_size = 1, color_by = "Pseudotime", 137 | show_tree = FALSE, show_branch_points = FALSE 138 | ) + 139 | theme( 140 | axis.text = element_blank(), 141 | axis.title = element_blank(), 142 | axis.ticks = element_blank(), 143 | axis.line = element_blank(), 144 | axis.line.x = NULL, 145 | axis.line.y = NULL, 146 | ) 147 | dev.off() 148 | 149 | my_pseudotime_de <- differentialGeneTest( 150 | monocds, 151 | fullModelFormulaStr = "~sm.ns(Pseudotime)", cores = 30 152 | ) 153 | sig_gene_names <- row.names(subset(my_pseudotime_de, qval < 10^-20)) 154 | 155 | pdf("CAF_TAM_Trajactory_Heatmap.pdf", width = 6, height = 8) 156 | plot_pseudotime_heatmap( 157 | monocds[sig_gene_names, ], 158 | num_clusters = 4, cores = 20, 159 | use_gene_short_name = TRUE, show_rownames = TRUE 160 | ) 161 | dev.off() 162 | 163 | Gene_label <- plot_pseudotime_heatmap( 164 | monocds[sig_gene_names, ], 165 | num_clusters = 4, cores = 60, 166 | use_gene_short_name = TRUE, show_rownames = TRUE, return_heatmap = TRUE 167 | ) 168 | clusters <- cutree(Gene_label$tree_row, k = 4) 169 | clustering <- data.frame(clusters) 170 | clustering[, 1] <- as.character(clustering[, 1]) 171 | colnames(clustering) <- "Gene_Clusters" 172 | table(clustering) 173 | write.table(clustering, "CAF_TAM_Trajactory_label.txt", quote = F, sep = "\t") 174 | Gene_label <- data.frame(cluster = clustering, gene = rownames(clustering)) 175 | 176 | plotdf <- pData(monocds) 177 | plotdf$clusters <- factor(plotdf$clusters, levels = c("c8", "c20", "c1")) 178 | 179 | p <- ggplot(plotdf, aes(x = Pseudotime, y = clusters, fill = clusters)) + 180 | geom_density_ridges(scale = 1) + 181 | scale_fill_manual(values = pal_npg()(9)[c(5, 2, 4)]) + 182 | geom_vline(xintercept = c(0, 5, 10, 15), linetype = 2) + 183 | scale_y_discrete("") + 184 | theme_minimal() + 185 | theme(panel.grid = element_blank()) 186 | ggsave("CAF_TAM_Trajactory_Density.pdf", width = 4, height = 1.5) 187 | 188 | ## SCENIC analysis 189 | Select_Counts <- as.matrix(monotj@assays$RNA@counts) 190 | RunSCENIC(Select_Counts) 191 | 192 | scenic <- read.table("moreSCENIC.txt", header = T, sep = "\t") 193 | name <- gsub("-", "_", rownames(monotj@meta.data)) 194 | colnames(scenic) <- name 195 | 196 | mat <- data.frame( 197 | cell = name, 198 | celltype = paste0("c", monotj@meta.data[, "Clusters"]), 199 | state = paste0("s", monocds@phenoData@data$State) 200 | ) 201 | 202 | mat$celltype <- factor(mat$celltype, levels = c("c1", "c20", "c8")) 203 | mat$state <- factor(mat$state, levels = paste0("s", c(1, 5, 2, 3, 4))) 204 | mat <- mat[order(mat$celltype, mat$state), ] 205 | rownames(mat) <- mat$cell 206 | mat <- as.data.frame(mat[, c(2, 3)]) 207 | 208 | col1 <- pal_npg()(9)[c(2, 5, 4)] 209 | names(col1) <- levels(mat$celltype) 210 | col2 <- pal_aaas(alpha = 0.8)(9)[c(1, 9, 2, 4, 3)] 211 | names(col2) <- paste0("s", c(1, 5, 2, 3, 4)) 212 | 213 | ann_colors <- list( 214 | celltype = col1, 215 | state = col2 216 | ) 217 | scen <- scenic[ 218 | c( 219 | "MYLK (60g)", 220 | "MAFB_extended (258g)", "SPI1 (1010g)" 221 | ), 222 | ] 223 | bk <- c(seq(-1, -0.1, by = 0.01), seq(0, 1, by = 0.01)) 224 | pdf("CAF_TAM_SCENIC.pdf", width = 8, height = 6) 225 | pheatmap(scen[, rownames(mat)], 226 | show_colnames = FALSE, annotation_col = mat, 227 | annotation_colors = ann_colors, 228 | show_rownames = T, scale = "row", cluster_cols = FALSE, 229 | cluster_rows = T, 230 | color = c( 231 | colorRampPalette( 232 | colors = brewer.pal(11, "RdYlBu")[11:6] 233 | )(length(bk) / 2), 234 | colorRampPalette( 235 | colors = brewer.pal(11, "RdYlBu")[6:1] 236 | )(length(bk) / 2) 237 | ), 238 | breaks = bk, annotation_legend = TRUE, 239 | legend_breaks = c(-1, 1), legend_labels = c("Low", "High"), 240 | fontsize = 12, annotation_names_col = TRUE, border_color = "gray" 241 | ) 242 | dev.off() 243 | 244 | ## Similarity analysis 245 | col1 <- c( 246 | "#8F2A47", "#B83A4D", "#D25C52", "#E27E56", 247 | "#ECA86B", "#F4CB85", "#F8E8A2", "#FAF8C7", "#EBF0AF", 248 | "#CEE2A2", "#ABD3A6", "#82C3A5", "#609EB0", "#4C78B1", 249 | "#5C519B" 250 | ) 251 | simi <- function(x) { 252 | Object_Select <- subset(data, ident = x) 253 | Object_Select <- FindVariableFeatures( 254 | Object_Select, 255 | selection.method = "vst", nfeatures = 5000 256 | ) 257 | Expr_Matrix <- as.data.frame(t( 258 | as.data.frame( 259 | Object_Select@assays$RNA@data[VariableFeatures(Object_Select), ] 260 | ) 261 | )) 262 | Expr_Matrix$cluster <- as.character(Object_Select@active.ident) 263 | Expr_Matrix_Mean <- aggregate( 264 | Expr_Matrix[, 1:(ncol(Expr_Matrix) - 1)], 265 | by = list(Expr_Matrix$Cluster), FUN = mean 266 | ) 267 | rownames(Expr_Matrix_Mean) <- paste0("c", Expr_Matrix_Mean$Group.1) 268 | Expr_Matrix_Mean <- Expr_Matrix_Mean[, 2:ncol(Expr_Matrix_Mean)] 269 | Expr_Matrix_Mean <- as.data.frame(t(Expr_Matrix_Mean)) 270 | Corr_Result <- cor(Expr_Matrix_Mean) 271 | pdf("CAF_TAM_Cor.pdf", width = 7, height = 7) 272 | corrplot(Corr_Result, 273 | method = "color", 274 | col = rev(brewer.pal(11, "RdYlBu")), 275 | type = "upper", 276 | tl.col = "black", 277 | order = "hclust", is.corr = FALSE, addCoef.col = "grey" 278 | ) 279 | dev.off() 280 | } 281 | x <- c(1:9, 19:21, 23) 282 | simi(x) 283 | x <- c(1:8, 25:28) 284 | simi(x) 285 | 286 | ## Proportion analysis 287 | CAF_Select <- subset(data, ident = 6) 288 | Tissue_Origin <- melt( 289 | table( 290 | CAF_Select@meta.data[, c("tissue", "group")] 291 | ) / as.vector(table(CAF_Select$tissue)) 292 | ) 293 | Tissue_Origin$group <- factor( 294 | Tissue_Origin$group, 295 | levels = c("Normal", "Adjacent", "Tumor") 296 | ) 297 | 298 | p <- ggplot(mat, aes(x = name, y = percent, fill = group)) + 299 | geom_bar(stat = "identity", position = "stack") + 300 | scale_fill_manual(values = pal_aaas()(3)[c(1, 3, 2)]) + 301 | theme_bw() + 302 | labs(x = "", y = "Proportion (%)") + 303 | theme( 304 | axis.text.x = element_text(angle = 45, hjust = 1), 305 | legend.title = element_blank() 306 | ) 307 | ggsave("Tissue_Origin_Proportion.pdf", p, width = 5, height = 3) 308 | 309 | ## VlnPlot for ESM1 310 | subsets <- subset(data, ident = c(1:8, 26:29)) 311 | VlnPlot(subsets, features = "ESM1", pt.size = 0) + 312 | labs(x = "Cluster", y = "Expression level") 313 | -------------------------------------------------------------------------------- /Main_Part5.R: -------------------------------------------------------------------------------- 1 | pkgs <- c( 2 | "Seurat", "SeuratWrappers", "ggplot2", "batchelor", "circlize", 3 | "dplyr", "optparse", "reshape2", "data.table", "magrittr", 4 | "patchwork", "scales", "GSVA", "RColorBrewer", "ggridges", 5 | "clusterProfiler", "survminer", "survminer", "monocle", "nichenet", 6 | "psych", "ggrepel", "pheatmap", "escape", "multcomp", "agricolae" 7 | ) 8 | 9 | color_for_use <- c( 10 | "#8F2A47", "#B83A4D", "#D25C52", "#E27E56", 11 | "#ECA86B", "#F4CB85", "#F8E8A2", "#FAF8C7", "#EBF0AF", 12 | "#CEE2A2", "#ABD3A6", "#82C3A5", "#609EB0", "#4C78B1", 13 | "#5C519B" 14 | ) 15 | 16 | lapply(pkgs, function(x) require(package = x, character.only = TRUE, quietly = TRUE, warn.conflicts = FALSE)) # nolint 17 | source("Dependent_SCENIC.R") 18 | source("Dependent_Monocle.R") 19 | source("Dependent_Escape.R") 20 | 21 | data <- readRDS("final_input1.Rds") 22 | 23 | ## FeaturePlot 24 | subset <- subset(data, ident = 6) 25 | pdf("FeaturePlot_Markers.pdf", width = 10, height = 10) 26 | FeaturePlot(subset, 27 | features = 28 | c("RGS5", "ACTA2", "PLVAP", "VWF"), order = T, ncol = 2 29 | ) & 30 | theme( 31 | axis.title = element_blank(), 32 | axis.text.x = element_text(angle = 0, hjust = 0.5) 33 | ) 34 | dev.off() 35 | 36 | pdf("VlnPlot_Markers.pdf", width = 6, height = 6) 37 | VlnPlot(subset, 38 | features = c("RGS5", "PLVAP"), 39 | pt.size = 0, ncol = 2 40 | ) & 41 | scale_fill_manual(values = pal_npg()(10)) & 42 | theme( 43 | axis.title.x = element_blank(), 44 | axis.text.x = element_text(angle = 45, hjust = 1) 45 | ) 46 | dev.off() 47 | 48 | ## TME interaction in normal, adjacent and tumor 49 | subsets <- subset(data, ident = c(1:34)) 50 | inter <- function(x) { 51 | subset_select <- subset( 52 | subsets, 53 | cells = rownames(subsets@meta.data[which(subsets$group == x), ]) 54 | ) 55 | 56 | Select_Cells <- c() 57 | for (i in levels(subset_select)) { 58 | subset <- subset(subset_select, ident = i) 59 | set.seed(1) 60 | if (nrow(subset@meta.data) > 1000) { 61 | Select_Cells <- append( 62 | Select_Cells, 63 | rownames(subset@meta.data[sample(1:nrow(subset@meta.data), 1000), ]) # nolint 64 | ) 65 | } else { 66 | Select_Cells <- append(Select_Cells, rownames(subset@meta.data)) 67 | } 68 | } 69 | 70 | Object_Select <- subset(subset_select, cells = Select_Cells) 71 | Object_Select$seurat_clusters <- Object_Select@active.ident 72 | 73 | write.table( 74 | Object_Select@assays$RNA@counts, 75 | paste0("figure5/1A/", x, "/count.txt"), 76 | quote = F, sep = "\t" 77 | ) 78 | 79 | meta <- data.frame( 80 | name = cellname, 81 | cluster = paste0("c", Object_Select@meta.data[cellname, "Clusters"]) 82 | ) 83 | write.table( 84 | meta, 85 | paste0("figure5/1A/", x, "/meta.txt"), 86 | quote = F, sep = "\t", 87 | row.names = F 88 | ) 89 | } 90 | inter("Tumor") 91 | inter("Adjacent") 92 | inter("Normal") 93 | 94 | Normal <- read.table( 95 | "figure5/1A/Normal/out/count_network.txt", 96 | header = T, sep = "\t" 97 | ) 98 | Adjacent <- read.table( 99 | "figure5/1A/Adjacent/out/count_network.txt", 100 | header = T, sep = "\t" 101 | ) 102 | Tumor <- read.table( 103 | "figure5/1A/Tumor/out/count_network.txt", 104 | header = T, sep = "\t" 105 | ) 106 | 107 | redu <- function(x) { 108 | return(x[which(x$SOURCE == "c6"), ]) 109 | } 110 | 111 | mat <- cbind(redu(nature), redu(normal), redu(tumor)) 112 | mat <- mat[, c(1, 2, 3, 6, 9)] 113 | colnames(mat) <- c("source", "target", "Normal", "Adjacent", "Tumor") 114 | mt <- melt(mat) 115 | 116 | model <- aov(value ~ variable, data = mt) 117 | rht <- glht(model, linfct = mcp(variable = "Dunnett"), alternative = "two.side") 118 | summary(rht) 119 | 120 | p <- ggplot(mt, aes(variable, value)) + 121 | geom_boxplot( 122 | size = 0.8, fill = "white", 123 | outlier.fill = NA, outlier.color = NA, outlier.size = 0 124 | ) + 125 | geom_point(aes(color = variable), size = 6) + 126 | geom_line(aes(group = target), size = 0.6, colour = "#9C9C9C") + 127 | theme_classic() + 128 | scale_color_manual(values = c("#9362cc", "#5199cc", "#fe9929")) + 129 | labs(y = "Interaction counts") + 130 | theme( 131 | axis.title.x = element_blank(), 132 | axis.title.y = element_text(size = 16, color = "black"), 133 | plot.title = element_text(hjust = 0.5), 134 | axis.text.x = element_text( 135 | size = 14, color = "black", 136 | angle = 45, hjust = 1 137 | ), 138 | axis.text.y = element_text(size = 14, color = "black"), 139 | axis.ticks.length = unit(0.4, "lines"), 140 | # legend.position = "none", 141 | legend.title = element_blank(), 142 | legend.position = "none", 143 | legend.text = element_text(size = 14, color = "black"), 144 | panel.grid.major = element_blank(), 145 | panel.grid.minor = element_blank(), 146 | axis.line = element_line(colour = "black") 147 | ) 148 | ggsave("TME_Interaction_Boxplot.pdf", p, width = 3.5, height = 4) 149 | 150 | Tumor <- dcast(Tumor, SOURCE ~ TARGET) 151 | bk <- c(seq(0, 5, by = 0.01)) 152 | pdf("TME_Interaction_Heatmap_Tumor.pdf", width = 8, height = 8) 153 | p <- pheatmap(log1p(Tumor), 154 | show_colnames = TRUE, 155 | annotation_colors = ann_colors, 156 | show_rownames = T, cluster_cols = TRUE, scale = "none", 157 | cluster_rows = T, color = c( 158 | colorRampPalette(colors = col1[15:11])(length(bk) * 2 / 3), 159 | colorRampPalette(colors = col1[11:1])(length(bk) / 3) 160 | ), 161 | breaks = bk, annotation_legend = TRUE, 162 | treeheight_row = 0, treeheight_col = 0, 163 | legend_breaks = c(0, 5), legend_labels = c("Low", "High"), 164 | fontsize = 12, annotation_names_col = FALSE, border_color = "gray", 165 | ) 166 | dev.off() 167 | 168 | Cluster_Order <- rownames(Tumor)[p$tree_row$order] 169 | pdf("TME_Interaction_Heatmap_Adjacent.pdf", width = 8, height = 8) 170 | p <- pheatmap(log1p(Adjacent[Cluster_Order, Cluster_Order]), 171 | show_colnames = TRUE, 172 | annotation_colors = ann_colors, 173 | show_rownames = T, cluster_cols = FALSE, scale = "none", 174 | cluster_rows = FALSE, color = c( 175 | colorRampPalette(colors = col1[15:11])(length(bk) * 2 / 3), 176 | colorRampPalette(colors = col1[11:1])(length(bk) / 3) 177 | ), 178 | breaks = bk, annotation_legend = TRUE, 179 | treeheight_row = 0, treeheight_col = 0, 180 | legend_breaks = c(0, 5), legend_labels = c("Low", "High"), 181 | fontsize = 12, annotation_names_col = FALSE, border_color = "gray", 182 | ) 183 | dev.off() 184 | 185 | pdf("TME_Interaction_Heatmap_Normal.pdf", width = 5.5, height = 5) 186 | p <- pheatmap(log1p(Normal[Cluster_Order, Cluster_Order]), 187 | show_colnames = TRUE, 188 | annotation_colors = ann_colors, 189 | show_rownames = T, cluster_cols = FALSE, scale = "none", 190 | cluster_rows = FALSE, color = c( 191 | colorRampPalette(colors = col1[15:11])(length(bk) * 2 / 3), 192 | colorRampPalette(colors = col1[11:1])(length(bk) / 3) 193 | ), 194 | breaks = bk, annotation_legend = TRUE, 195 | treeheight_row = 0, treeheight_col = 0, 196 | legend_breaks = c(0, 5), legend_labels = c("Low", "High"), 197 | fontsize = 12, annotation_names_col = FALSE, border_color = "gray", 198 | ) 199 | dev.off() 200 | 201 | ## Trajactory analysis 202 | Select_Cells <- c() 203 | for (i in c(1, 26)) { 204 | subsets <- subset(data, ident = i) 205 | set.seed(1) 206 | Select_Cells <- append( 207 | Select_Cells, 208 | rownames(subsets@meta.data[sample(1:nrow(subsets@meta.data), 3000), ]) 209 | ) 210 | } 211 | cluster6 <- subset(data, ident = 6) 212 | cluster6_cells <- rownames(cluster6@meta.data) 213 | monotj <- subset(data, cells = c(Select_Cells, cluster6_cells)) 214 | RunMonocle(monotj) 215 | 216 | monocds <- orderCells(monocds, root_state = 3) 217 | pdf("Trajactory_State.pdf", width = 3.5, height = 3.5) 218 | plot_cell_trajectory( 219 | monocds, 220 | cell_size = 0.2, color_by = "State", 221 | show_tree = FALSE, show_branch_points = FALSE 222 | ) + 223 | scale_color_manual(values = pal_aaas()(9)) + 224 | theme( 225 | axis.text = element_blank(), 226 | axis.title = element_blank(), 227 | axis.ticks = element_blank(), 228 | axis.line = element_blank(), 229 | axis.line.x = NULL, 230 | axis.line.y = NULL, 231 | ) 232 | dev.off() 233 | 234 | pdf("Trajactory_Cluster.pdf", width = 3.5, height = 4) 235 | plot_cell_trajectory(monocds, 236 | cell_size = 0.2, 237 | color_by = "groo", show_tree = FALSE, show_branch_points = FALSE 238 | ) + 239 | scale_color_manual(values = colo[c(1, 2, 3, 4)]) + 240 | theme( 241 | legend.title = element_blank(), 242 | axis.text = element_blank(), 243 | axis.title = element_blank(), 244 | axis.ticks = element_blank(), 245 | axis.line = element_blank(), 246 | axis.line.x = NULL, 247 | axis.line.y = NULL, 248 | ) 249 | dev.off() 250 | 251 | my_pseudotime_de <- differentialGeneTest( 252 | monocds, 253 | fullModelFormulaStr = "~sm.ns(Pseudotime)", 254 | cores = 40 255 | ) 256 | sig_gene_names <- row.names(subset(my_pseudotime_de, qval < 10^-20)) 257 | 258 | pdf("Trajactory_Pheatmap.pdf", width = 6, height = 8) 259 | plot_pseudotime_heatmap( 260 | monocds[sig_gene_names, ], 261 | num_clusters = 3, cores = 40, 262 | use_gene_short_name = TRUE, 263 | show_rownames = FALSE 264 | ) 265 | dev.off() 266 | 267 | cds_subset <- monocds[c("ITGA9", "ITGB1"), ] 268 | cds_subset@phenoData@data$clusters <- paste0("c", cds_subset@phenoData@data$Clusters) # nolint 269 | pdf("Trajactory_Genes.pdf", width = 5, height = 3) 270 | plot_genes_in_pseudotime(cds_subset, color_by = "Clusters") + 271 | scale_color_manual(values = pal_npg()(3)) 272 | dev.off() 273 | 274 | gshallmark <- getGeneSets(library = "H") 275 | 276 | data_set <- list(enriched = gshallmark@.Data[[4]]@geneIds) 277 | result <- gsva( 278 | as.matrix(monotj@assays$RNA@data), data_set, 279 | min.sz = 5, 280 | kcdf = "Poisson", method = "ssgsea", 281 | mx.diff = TRUE, verbose = FALSE, parallel.sz = 30 282 | ) 283 | dat <- data.frame( 284 | group = paste0("s", monocds@phenoData@data$State), value = as.vector(result) 285 | ) 286 | dat$groupp <- ifelse(dat$group %in% c("s1", "s7"), "state1", 287 | ifelse(dat$group %in% c("s4", "s5"), "state2", "state3") 288 | ) 289 | p <- ggplot(dat, aes(x = groupp, y = value)) + 290 | geom_jitter(aes(fill = groupp, color = groupp), 291 | width = 0.2, shape = 21, size = 0.5 292 | ) + 293 | scale_color_npg(alpha = 0.9) + 294 | scale_fill_npg(alpha = 0.9) + 295 | geom_boxplot( 296 | size = 0.6, fill = "white", outlier.fill = NA, 297 | outlier.color = NA, outlier.size = 0 298 | ) + 299 | theme_bw() + 300 | theme( 301 | axis.title = element_blank(), 302 | legend.position = "none" 303 | ) 304 | 305 | ggsave("Trajactory_State_Angiogenesis.pdf", p, width = 2.5, height = 3) 306 | 307 | monocds@phenoData@data$ANGIOGENESIS <- scale(as.vector(result)) 308 | monocds@phenoData@data$ANGIOGENESIS <- ifelse( 309 | monocds@phenoData@data$ANGIOGENESIS > 2, 2, 310 | ifelse(monocds@phenoData@data$ANGIOGENESIS < -2, -2, 311 | monocds@phenoData@data$ANGIOGENESIS 312 | ) 313 | ) 314 | 315 | pdf("Trajactory_Angiogenesis.pdf", width = 3.5, height = 3.5) 316 | plot_cell_trajectory(monocds, 317 | cell_size = 1, 318 | color_by = "ANGIOGENESIS", show_tree = FALSE, 319 | show_branch_points = FALSE 320 | ) + 321 | scale_color_gradientn(colors = rev(col1)) + 322 | theme( 323 | axis.text = element_blank(), 324 | axis.title = element_blank(), 325 | axis.ticks = element_blank(), 326 | axis.line = element_blank(), 327 | axis.line.x = NULL, 328 | axis.line.y = NULL 329 | ) 330 | dev.off() 331 | 332 | ## Nichenet analysis 333 | dd <- subset(data, ident = c(25, 27, 6)) 334 | dd$gro <- ifelse(dd$seurat_clusters == 6, "CAFendomt", "Endothelium") 335 | 336 | dd@active.ident <- factor(dd$gro) 337 | marker <- FindAllMarkers(dd, min.pct = 0.25, only.pos = T) 338 | gg <- marker[which(marker$cluster == "CAFendomt"), ] 339 | colo <- c( 340 | pal_npg(alpha = 0.9)(9), 341 | pal_aaas(alpha = 0.7)(9), pal_lancet(alpha = 0.5)(9) 342 | ) 343 | 344 | gene <- read.table("CAF_Markers.txt", header = T, sep = "\t") 345 | gene <- gg[which(gg$p_val_adj == 0), "gene"] 346 | 347 | 348 | gene <- read.table("CAF_Markers.txt", header = T, sep = "\t") 349 | ligand_target_matrix <- readRDS("/work/xiaxy/learn/7.nechenet/ligand_target_matrix.rds") 350 | lr_network <- readRDS("/work/xiaxy/learn/7.nechenet/lr_network.rds") 351 | weighted_networks <- readRDS("/work/xiaxy/learn/7.nechenet/weighted_networks.rds") 352 | weighted_networks_lr <- weighted_networks$lr_sig %>% 353 | inner_join(lr_network %>% distinct(from, to), by = c("from", "to")) 354 | 355 | receiver <- "6" 356 | receobject <- subset(data, ident = receiver) 357 | expressed_genes_receiver <- get_expressed_genes( 358 | receiver, receobject, 359 | pct = 0.10 360 | ) 361 | background_expressed_genes <- expressed_genes_receiver %>% .[. %in% rownames(ligand_target_matrix)] # nolint 362 | 363 | sender_celltypes <- 19 364 | sendobject <- subset(data, ident = sender_celltypes) 365 | list_expressed_genes_sender <- get_expressed_genes(sender_celltypes, sendobject, pct = 0.10) # nolint 366 | expressed_genes_sender <- list_expressed_genes_sender %>% 367 | unlist() %>% 368 | unique() 369 | 370 | geneset_oi <- gene$gene 371 | geneset_oi <- geneset_oi %>% .[. %in% rownames(ligand_target_matrix)] 372 | 373 | ligands <- lr_network %>% 374 | pull(from) %>% 375 | unique() 376 | receptors <- lr_network %>% 377 | pull(to) %>% 378 | unique() 379 | 380 | expressed_ligands <- intersect(ligands, expressed_genes_sender) 381 | expressed_receptors <- intersect(receptors, expressed_genes_receiver) 382 | 383 | potential_ligands <- lr_network %>% 384 | filter(from %in% expressed_ligands & to %in% expressed_receptors) %>% 385 | pull(from) %>% 386 | unique() 387 | 388 | ligand_activities <- predict_ligand_activities( 389 | geneset = geneset_oi, 390 | background_expressed_genes = background_expressed_genes, 391 | ligand_target_matrix = ligand_target_matrix, 392 | potential_ligands = potential_ligands 393 | ) 394 | ligand_activities <- ligand_activities %>% 395 | arrange(-pearson) %>% 396 | mutate(rank = rank(desc(pearson))) 397 | 398 | best_upstream_ligands <- ligand_activities %>% 399 | top_n(30, pearson) %>% 400 | arrange(-pearson) %>% 401 | pull(test_ligand) %>% 402 | unique() 403 | 404 | pdf("Ligands_Expr.pdf", width = 9, height = 5) 405 | DotPlot(sendobject, 406 | features = best_upstream_ligands %>% rev(), 407 | cols = "RdYlBu" 408 | ) + 409 | RotatedAxis() + coord_flip() + 410 | theme(axis.title = element_blank()) 411 | dev.off() 412 | 413 | active_ligand_target_links_df <- best_upstream_ligands %>% 414 | lapply(get_weighted_ligand_target_links, 415 | geneset = geneset_oi, 416 | ligand_target_matrix = ligand_target_matrix, n = 200 417 | ) %>% 418 | bind_rows() %>% 419 | drop_na() 420 | active_ligand_target_links <- prepare_ligand_target_visualization( 421 | ligand_target_df = active_ligand_target_links_df, 422 | ligand_target_matrix = ligand_target_matrix, cutoff = 0.33 423 | ) 424 | order_ligands <- intersect(best_upstream_ligands, colnames(active_ligand_target_links)) %>% # nolint 425 | rev() %>% 426 | make.names() 427 | order_targets <- active_ligand_target_links_df$target %>% 428 | unique() %>% 429 | intersect(rownames(active_ligand_target_links)) %>% 430 | make.names() 431 | rownames(active_ligand_target_links) <- rownames(active_ligand_target_links) %>% 432 | make.names() # make.names() for heatmap visualization of genes like H2-T23 433 | colnames(active_ligand_target_links) <- colnames(active_ligand_target_links) %>% 434 | make.names() # make.names() for heatmap visualization of genes like H2-T23 435 | 436 | vis_ligand_target <- active_ligand_target_links[order_targets, order_ligands] %>% t() # nolint 437 | 438 | p_ligand_target_network <- vis_ligand_target %>% 439 | make_heatmap_ggplot("Prioritized ligands", "Predicted target genes", 440 | color = "purple", legend_position = "top", 441 | x_axis_position = "top", legend_title = "Regulatory potential" 442 | ) + 443 | theme(axis.text.x = element_text(face = "italic")) + 444 | scale_fill_gradient2( 445 | low = "whitesmoke", 446 | high = "purple", breaks = c(0, 0.0045, 0.0090) 447 | ) 448 | ggsave( 449 | "Ligand_Target_Network.pdf", p_ligand_target_network, 450 | width = 10, height = 5 451 | ) 452 | 453 | vis_ligand_target <- vis_ligand_target[, c( 454 | "CD44", "COL1A1", "TGFBR2", "COL3A1", 455 | "ZEB2", "PALLD", "EMP1", "C1S", "BGN", "MFGE8" 456 | )] 457 | bk <- c(seq(0, 0.012, by = 0.0001)) 458 | colo <- colorRampPalette(c( 459 | "#324C74", "#377D8C", 460 | "#6CB39D", "#B2DDA6", "#F9FEB7" 461 | ))(50) 462 | p2 <- pheatmap(vis_ligand_target, 463 | cluster_cols = FALSE, cluster_rows = FALSE, treeheight_row = 0, 464 | treeheight_col = 0, border_color = "black", 465 | color = rev(c( 466 | colorRampPalette(colors = colo[50:48])(length(bk) / 2), 467 | colorRampPalette(colors = colo[47:1])(length(bk) / 2) 468 | )) 469 | ) 470 | ggsave("Lt-Net.pdf", p2, width = 4.5, height = 4) 471 | gge <- rownames(vis_ligand_target) 472 | gge <- gsub("[.]", "-", gge) 473 | sub <- subset(data, ident = 4) 474 | mat <- sub@assays$RNA@data[gge, ] 475 | mt <- rowMeans(mat) 476 | tt <- as.data.frame(mt) 477 | 478 | bk <- c(seq(0, 3, by = 0.01)) 479 | colo2 <- colorRampPalette(c("white", "#18196A"))(50) 480 | p1 <- pheatmap(tt, 481 | cluster_cols = FALSE, cluster_rows = FALSE, treeheight_row = 0, 482 | treeheight_col = 0, border_color = "black", 483 | color = rev(c( 484 | colorRampPalette(colors = colo2[50:45])(length(bk) / 2), 485 | colorRampPalette(colors = colo2[44:1])(length(bk) / 2) 486 | )) 487 | ) 488 | ggsave("Lt_Expr.pdf", p1, width = 1.5, height = 4) 489 | 490 | aab <- colnames(vis_ligand_target) 491 | aab <- gsub("[.]", "-", aab) 492 | sb <- subset(data, ident = 56) 493 | mat <- sb@assays$RNA@data[aab, ] 494 | mt <- rowMeans(mat) 495 | tt <- as.data.frame(t(mt)) 496 | 497 | bk <- c(seq(0, 1.4, by = 0.01)) 498 | colo2 <- colorRampPalette(c("white", "#F8DB85"))(50) 499 | p1 <- pheatmap(tt, 500 | cluster_cols = FALSE, cluster_rows = FALSE, treeheight_row = 0, 501 | treeheight_col = 0, border_color = "black", 502 | color = rev(c( 503 | colorRampPalette(colors = colo2[50:25])(length(bk) / 2), 504 | colorRampPalette(colors = colo2[25:0])(length(bk) / 2) 505 | )) 506 | ) 507 | ggsave("Lt_Expression.pdf", p1, width = 4, height = 1) 508 | 509 | layout <- "AABBBBBB" 510 | final <- as.ggplot(p1) + as.ggplot(p2) + 511 | plot_layout(design = layout) & 512 | theme(legend.position = "bottom") 513 | ggsave("Nichenet_Merge.pdf", final, width = 6, height = 3.5) 514 | 515 | lr_network_top <- lr_network %>% 516 | filter(from %in% best_upstream_ligands & to %in% expressed_receptors) %>% 517 | distinct(from, to) 518 | best_upstream_receptors <- lr_network_top %>% 519 | pull(to) %>% 520 | unique() 521 | 522 | lr_network_top_df_large <- weighted_networks_lr %>% 523 | filter(from %in% best_upstream_ligands & to %in% best_upstream_receptors) 524 | lr_network_top_df <- lr_network_top_df_large %>% 525 | spread("from", "weight", fill = 0) 526 | lr_network_top_matrix <- lr_network_top_df %>% 527 | select(-to) %>% 528 | as.matrix() %>% 529 | magrittr::set_rownames(lr_network_top_df$to) 530 | 531 | dist_receptors <- dist(lr_network_top_matrix, method = "binary") 532 | hclust_receptors <- hclust(dist_receptors, method = "ward.D2") 533 | order_receptors <- hclust_receptors$labels[hclust_receptors$order] 534 | 535 | dist_ligands <- dist(lr_network_top_matrix %>% t(), method = "binary") 536 | hclust_ligands <- hclust(dist_ligands, method = "ward.D2") 537 | order_ligands_receptor <- hclust_ligands$labels[hclust_ligands$order] 538 | 539 | order_receptors <- order_receptors %>% intersect(rownames(lr_network_top_matrix)) # nolint 540 | order_ligands_receptor <- order_ligands_receptor %>% intersect(colnames(lr_network_top_matrix)) # nolint 541 | 542 | vis_ligand_receptor_network <- lr_network_top_matrix[order_receptors, order_ligands_receptor] # nolint 543 | rownames(vis_ligand_receptor_network) <- order_receptors %>% make.names() 544 | colnames(vis_ligand_receptor_network) <- order_ligands_receptor %>% make.names() 545 | aa <- vis_ligand_receptor_network %>% t() 546 | bk <- c(seq(0, 1.25, by = 0.01)) 547 | colo3 <- colorRampPalette(c("white", "#7E294E"))(50) 548 | p1 <- pheatmap(aa[gge, which(colSums(aa[gge, ]) > 0.1)], 549 | cluster_cols = FALSE, cluster_rows = FALSE, treeheight_row = 0, 550 | treeheight_col = 0, border_color = "black", 551 | color = rev(c( 552 | colorRampPalette(colors = colo3[50:45])(length(bk) / 2), 553 | colorRampPalette(colors = colo3[44:1])(length(bk) / 2) 554 | )) 555 | ) 556 | ggsave("LT_LP.pdf", p1, width = 8, height = 5) 557 | p_ligand_receptor_network <- vis_ligand_receptor_network %>% 558 | t() %>% 559 | make_heatmap_ggplot("Ligands", "Receptors", 560 | color = "#7E294E", 561 | x_axis_position = "top", 562 | legend_title = "Prior interaction potential" 563 | ) 564 | ggsave("Network.pdf", p_ligand_receptor_network, width = 6, height = 5) 565 | 566 | ligand_pearson_matrix <- ligand_activities %>% 567 | select(pearson) %>% 568 | as.matrix() %>% 569 | magrittr::set_rownames(ligand_activities$test_ligand) 570 | 571 | rownames(ligand_pearson_matrix) <- rownames(ligand_pearson_matrix) %>% 572 | make.names() 573 | colnames(ligand_pearson_matrix) <- colnames(ligand_pearson_matrix) %>% 574 | make.names() 575 | 576 | vis_ligand_pearson <- ligand_pearson_matrix[order_ligands, ] %>% 577 | as.matrix(ncol = 1) %>% 578 | magrittr::set_colnames("Pearson") 579 | vis_ligand_pearson <- ligand_pearson_matrix[order_ligands, ] %>% 580 | as.matrix(ncol = 1) %>% 581 | magrittr::set_colnames("Pearson") 582 | 583 | # ligand expression Seurat dotplot 584 | monotj$celltype <- monotj@active.ident 585 | order_ligands_adapted <- gsub("[.]", "-", order_ligands_adapted) 586 | order_ligands_adapted <- order_ligands 587 | order_ligands_adapted[order_ligands_adapted == "H2.M3"] <- "H2-M3" 588 | order_ligands_adapted[order_ligands_adapted == "H2.T23"] <- "H2-T23" 589 | rotated_dotplot <- DotPlot( 590 | monotj %>% subset(celltype %in% sender_celltypes), 591 | features = order_ligands_adapted, cols = "RdYlBu" 592 | ) + 593 | coord_flip() + 594 | theme( 595 | legend.text = element_text(size = 10), 596 | legend.title = element_text(size = 12), 597 | axis.title = element_blank(), 598 | axis.text.x = element_text(angle = 45, hjust = 1) 599 | ) 600 | ggsave("Ligand_Expr", rotated_dotplot) 601 | layout <- "ABBB 602 | CCCC" 603 | final <- p + p_ligand_target_network + p_ligand_receptor_network + 604 | plot_layout(design = layout) & 605 | theme(legend.position = "bottom") 606 | ggsave("Merge.pdf", final, width = 15, height = 13) 607 | 608 | marker <- read.table("new_marker.txt", header = T, sep = "\t", row.names = 1) 609 | 610 | dir <- list.files("TCGA") 611 | setwd("TCGA") 612 | data_set_c6 <- list(enriched = marker[ 613 | which(marker$cluster == 6 & marker$p_val_adj < 0.05), "gene" 614 | ][1:50]) 615 | data_set_c19 <- list(enriched = marker[ 616 | which(marker$cluster == 19 & marker$p_val_adj < 0.05), "gene" 617 | ][1:50]) 618 | 619 | plot_list <- foreach::foreach(gp = 1:length(dir)) %do% { 620 | bulk <- read.table(dir[k], header = T, sep = "\t") 621 | bulk <- bulk[-which(duplicated(bulk$Hybridization.REF)), ] 622 | rownames(bulk) <- bulk$Hybridization.REF 623 | bulk <- bulk[, -1] 624 | result6 <- gsva(as.matrix(bulk), data_set_c6, 625 | min.sz = 5, 626 | kcdf = "Poisson", method = "ssgsea", 627 | mx.diff = TRUE, verbose = FALSE, parallel.sz = 30 628 | ) 629 | result19 <- gsva(as.matrix(bulk), data_set_c19, 630 | min.sz = 5, 631 | kcdf = "Poisson", method = "ssgsea", 632 | mx.diff = TRUE, verbose = FALSE, parallel.sz = 30 633 | ) 634 | 635 | mat <- data.frame( 636 | c6 = as.vector(result6), 637 | c19 = as.vector(result19) 638 | ) 639 | ggplot(mat, aes(x = c6, y = c19)) + 640 | geom_point(size = 3, color = "#B1CF94") + 641 | geom_smooth(method = "lm", se = FALSE, color = "black") + 642 | stat_cor(method = "pearson", label.x = max(mat$c6) * 0.2) + 643 | theme_classic() + 644 | labs(title = sapply(strsplit(dir[k], ".", fixed = T), "[", 1)) + 645 | theme(plot.title = element_text(hjust = 0.5, color = "black")) 646 | } 647 | final <- wrap_plots(plot_list, ncol = 8, guides = "collect") 648 | ggsave("TCGA_COR_RESULT.pdf", final, width = 24, height = 15) 649 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # PanCAF 2 | These are scripts for pan-cancer analysis of cancer associated fibroblasts (CAFs). 3 | -------------------------------------------------------------------------------- /Seurat_Process.R: -------------------------------------------------------------------------------- 1 | pkgs <- c( 2 | "Seurat", "SeuratWrappers", "ggplot2", "batchelor", 3 | "dplyr", "optparse", "reshape2", "data.table", "magrittr" 4 | ) 5 | 6 | lapply(pkgs, function(x) require(package = x, character.only = TRUE, quietly = TRUE, warn.conflicts = FALSE)) #nolint 7 | 8 | data_combined <- readRDS("deal.Rds") 9 | 10 | ## calculate the percentage of MT 11 | data_combined[["percent.mt"]] <- PercentageFeatureSet( 12 | data_combined, 13 | pattern = "^MT-" 14 | ) 15 | 16 | ## Remove low quality cells, normalization and select top 2,000 variably expressed genes #nolint 17 | data_combined %<>% subset(subset = nFeature_RNA > 200 & nFeature_RNA < 6000 & percent.mt < 20) %>% #nolint 18 | NormalizeData(normalization.method = "LogNormalize") %>% 19 | FindVariableFeatures(selection.method = "vst") 20 | 21 | ## Scale the data 22 | all.genes <- rownames(data_combined) 23 | data_combined %<>% ScaleData(features = all.genes) %>% 24 | ScaleData(vars.to.regress = "percent.mt") 25 | 26 | ## RunPCA for reducing the dimensionality 27 | data_combined %<>% RunPCA(object = ., features = VariableFeatures(object = .)) %>% #nolint 28 | RunFastMNN(object = ., object.list = SplitObject(., split.by = "SampleID")) 29 | 30 | ## batch effect correction and findclusters 31 | data_combined %<>% FindNeighbors(reduction = "mnn", dims = 1:30) %>% 32 | FindClusters(resolution = 1.4) 33 | 34 | data_combined %<>% RunTSNE(reduction = "mnn", dims = 1:30) %>% 35 | RunUMAP(reduction = "mnn", dims = 1:30) 36 | 37 | ## save RDS file for subsequent analysis 38 | saveRDS(data_combined, "final_input.Rds") 39 | 40 | pdf("umap.pdf", width = 9, height = 9) 41 | DimPlot(data_combined, reduction = "umap", label = TRUE) + NoLegend() 42 | dev.off() 43 | 44 | pdf("tsne.pdf", width = 9, height = 9) 45 | DimPlot(data_combined, reduction = "tsne", label = TRUE) + NoLegend() 46 | dev.off() 47 | 48 | ## Calculate the markers for each cluster 49 | markers <- FindAllMarkers(data_combined, only.pos = TRUE, min.pct = 0.25) 50 | write.table(markers, "Umap_All_Marker.txt", quote = F, sep = "\t") 51 | -------------------------------------------------------------------------------- /Seurat_Read.R: -------------------------------------------------------------------------------- 1 | # %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2 | # Functions 3 | # %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 4 | #' Read files for Seurat 5 | #' 6 | #' This function will read in the expression file and integrate 7 | #' the seurat object. In addition, it can optionally detect 8 | #' and reject doublet using the appropriate software. 9 | #' @param inputdir A path containing the cellranger output files or matrix files 10 | #' @param outputdir Output path of the merged RDS file 11 | #' @param type Data format type (cellranger output files or matrix files) 12 | #' @param mincells Include features detected in at least this many cells. 13 | #' @param deledoublet Whether to test and reject doublet 14 | #' @param doubletpercent Percentage of excluded doublet 15 | #' @param doubletpc Number of PC quadrants included 16 | #' @param doubletresolution resoluttion value for doublet 17 | #' @param wid width of picture 18 | #' @param hei height of picture 19 | #' 20 | 21 | read_data <- function(inputdir, 22 | outputdir, 23 | type, 24 | mincells = 3, 25 | deledoublet = TRUE, 26 | doubletpercent = 0.075, 27 | doubletpc = seq(30), 28 | doubletresolution = 1, 29 | wid = 6, 30 | hei = 6) { 31 | if (is.null(inputdir)) stop("inputdir is null") 32 | setwd(inputdir) 33 | files <- list.files() 34 | info <- data.table(filepath = files, sampleid = files) 35 | samplelist <- list() 36 | 37 | mat <- matrix(NA, nrow = nrow(info), ncol = 3) 38 | 39 | # read files 40 | for (i in seq(nrow(info))) { 41 | dir_of_10x <- info$filepath[i] 42 | sampleid <- info$sampleid[i] 43 | 44 | print(paste("Starting processing", sampleid, "at", Sys.time())) 45 | 46 | if (type == "cellranger") { 47 | sc_mat <- Read10X(dir_of_10x) 48 | sc_tumor <- CreateSeuratObject( 49 | counts = sc_mat, project = sampleid, min.cells = mincells 50 | ) 51 | } else { 52 | sc_mat <- read.table( 53 | info$filepath[i], 54 | header = T, sep = "\t", row.names = 1 55 | ) 56 | sc_mat <- data.frame(sc_mat) 57 | sc_mat <- as(as.matrix(sc_mat), "dgCMatrix") 58 | sc_tumor <- CreateSeuratObject( 59 | counts = sc_mat, project = sampleid, min.cells = mincells 60 | ) 61 | } 62 | 63 | mat[i, 1] <- sampleid 64 | mat[i, 2] <- nrow(sc_tumor@meta.data) 65 | 66 | # rename cellnames 67 | sc_tumor <- RenameCells(sc_tumor, add.cell.id = sampleid) 68 | sc_tumor <- RenameCells( 69 | sc_tumor, 70 | new.names = gsub("-", "_", rownames(sc_tumor@meta.data)) 71 | ) 72 | 73 | if (deledoublet) { 74 | sc_tumor <- NormalizeData( 75 | sc_tumor, 76 | normalization.method = "LogNormalize", 77 | scale.factor = 10000 78 | ) 79 | sc_tumor <- FindVariableFeatures(sc_tumor, 80 | selection.method = "vst", nfeatures = 2000 81 | ) 82 | sc_tumor <- ScaleData(sc_tumor) 83 | sc_tumor <- RunPCA(sc_tumor) 84 | sc_tumor <- FindNeighbors(sc_tumor, dims = doubletpc) 85 | sc_tumor <- FindClusters(sc_tumor, resolution = doubletresolution) 86 | sc_tumor$seurat_clusters <- sc_tumor@active.ident 87 | 88 | sweep.res <- paramSweep_v3(sc_tumor, PCs = doubletpc, sct = T) 89 | sweep.stats <- summarizeSweep(sweep.res, GT = FALSE) 90 | bcmvn <- find.pK(sweep.stats) 91 | mpk <- as.numeric(as.vector(bcmvn$pK[which.max(bcmvn$BCmetric)])) 92 | 93 | annotations <- sc_tumor@meta.data$seurat_clusters 94 | homotypic <- modelHomotypic(annotations) 95 | nexp_poi <- round(doubletpercent * ncol(sc_tumor@assays$RNA@data)) 96 | nexp_poiadj <- round(nexp_poi * (1 - homotypic)) 97 | 98 | filterdouble <- doubletFinder_v3( 99 | sc_tumor, 100 | PCs = doubletpc, 101 | pN = 0.25, pK = mpk, nExp = nexp_poi, 102 | reuse.pANN = FALSE, sct = T 103 | ) 104 | print(table(filterdouble@meta.data[, 7])) 105 | 106 | sc_tumor <- subset( 107 | sc_tumor, 108 | cells = rownames(filterdouble@meta.data[ 109 | which(filterdouble@meta.data[, 7] == "Singlet"), 110 | ]) 111 | ) 112 | } 113 | mat[i, 3] <- nrow(sc_tumor@meta.data) 114 | sc_tumor$sampleid <- sampleid 115 | samplelist <- append(samplelist, sc_tumor) 116 | print(paste("Finishing processing", sampleid, "at", Sys.time())) 117 | } 118 | 119 | combined <- Reduce(function(x, y) merge(x, y, merge.data = TRUE), samplelist) # nolint 120 | 121 | saveRDS(combined, paste0(outputdir, "/read.Rds")) 122 | mat <- as.data.frame(mat) 123 | colnames(mat) <- c("sampleid", "raw", "doublet") 124 | write.table( 125 | mat, 126 | paste0(outputdir, "/cellnumber.txt"), 127 | quote = F, sep = "\t" 128 | ) 129 | p1 <- ggplot(mat, aes(x = sampleid, y = raw)) + 130 | geom_bar(stat = "identity") + 131 | theme_bw() + 132 | labs(y = "Cell number") + 133 | geom_text( 134 | aes(label = raw, vjust = 0.8, hjust = 0.5) 135 | ) + 136 | theme( 137 | axis.text.x = element_text(angle = 45, hjust = 1, color = "black"), 138 | axis.title.x = element_blank(), 139 | legend.position = "none" 140 | ) 141 | p2 <- ggplot(mat, aes(x = sampleid, y = doublet)) + 142 | geom_bar(stat = "identity") + 143 | theme_bw() + 144 | labs(y = "Cell number") + 145 | geom_text( 146 | aes(label = raw, vjust = 0.8, hjust = 0.5) 147 | ) + 148 | theme( 149 | axis.text.x = element_text(angle = 45, hjust = 1, color = "black"), 150 | axis.title.x = element_blank(), 151 | legend.position = "none" 152 | ) 153 | final <- p1 + p2 + plot_layout(ncol = 1) 154 | ggsave( 155 | paste0(outputdir, "/raw_doublet.pdf"), 156 | final, 157 | width = wid, height = hei 158 | ) 159 | saveRDS(final, paste0(outputdir, "/p1.Rds")) 160 | return(combined) 161 | } 162 | --------------------------------------------------------------------------------