├── 01.1_Count_matrix_trans.R ├── 01.2_QC_each_matrix.R ├── 01.3_Merge_matrix.R ├── 01.3_Scrublet.py ├── 02_All_cell_clustering.R ├── 03.1_Tumor_copykat_analysis.R ├── 03.2_Cancer_NK_CellphoneDB.R ├── 03_Tumor_cell_analysis_new.R ├── 05.1_T_scvelo.py ├── 05_T_analysis_new.R ├── 06.1_PMo_Cancer_CellphoneDB.R ├── 06.2_DC_Cancer_CellphoneDB.R ├── 06_MF_analysis_new.R ├── 07.1_B_Nichenet.R ├── 07.2_B4_Tfh_CD8_CellphoneDB.R ├── 07_B_analysis_new.R ├── 08.1_N_Nichenet.R ├── 08.2_Neutrophil_SCENIC.R ├── 08.3_Neu_CCL3_Macro_SPP1_CellphoneDB.R ├── 08_Neutrophil_analysis_new.R ├── Cal_fraction.R ├── Cal_fraction_patients.R ├── GSVA.R ├── Heat_Dot_data.R ├── Monocle_plot_gene.R ├── README.md └── my_plot_pseudotime_heatmap.R /01.1_Count_matrix_trans.R: -------------------------------------------------------------------------------- 1 | # Load libraries 2 | library(data.table) 3 | library(future) 4 | plan("multiprocess", workers = 8) 5 | options(future.globals.maxSize = 10*1024^3) 6 | 7 | # Set the full path to the github directory 8 | rm(list=ls()) 9 | dir <- "./" 10 | 11 | # Load raw count matrix from BD Rhapsody, transpose the matrix and save it 12 | counts_list <- list.files(path=paste0(dir,"count_matrix_raw/"),pattern="_RSEC_MolsPerCell.csv") 13 | sample_num <- length(counts_list) 14 | sample_id <- gsub("_RSEC_MolsPerCell.csv","",counts_list) 15 | for(i in 1:sample_num){ 16 | data <- fread(paste0(dir,"count_matrix_raw/",counts_list[i]),sep=",",header= F,stringsAsFactors=F) 17 | dim(data) 18 | head(data[,1:5]) 19 | data <- t(data) 20 | dim(data) 21 | data[1,2:ncol(data)] <- paste(sample_id[i],data[1,2:ncol(data)],sep = "_") 22 | head(data[,1:5]) 23 | fwrite(data,file=paste0(dir,"count_matrix_trans/",sample_id[i],".txt"),row.names=F,col.names=F,quote=F,sep="\t") 24 | } 25 | -------------------------------------------------------------------------------- /01.2_QC_each_matrix.R: -------------------------------------------------------------------------------- 1 | # Load libraries 2 | library(data.table) 3 | library(Seurat) 4 | library(future) 5 | plan("multiprocess", workers = 8) 6 | options(future.globals.maxSize = 10*1024^3) 7 | 8 | # Set the full path to the github directory 9 | rm(list=ls()) 10 | dir <- "./" 11 | 12 | # read in each matrix 13 | txt_list <- list.files(path=paste0(dir,"count_matrix_trans/"),pattern=".txt") 14 | txt_num <- length(txt_list) 15 | txt_id <- gsub(".txt","",txt_list) 16 | for(i in 1:txt_num){ 17 | data <- read.table(paste0(dir,"count_matrix_trans/",txt_list[i]),sep="\t",header=T,stringsAsFactors=F,row.names=1) 18 | assign(txt_id[i],data) 19 | } 20 | 21 | ###### QC for each sample one by one 22 | sample_name <- BD_immune01 23 | ## create Seurat object 24 | RNA <- CreateSeuratObject(sample_name) 25 | ## remove low quality cells 26 | # Find mitochondrial genes, compute the mitochondrial rate 27 | mito.genes <- grep("^MT-", rownames(sample_name), value = TRUE) 28 | percent.mito <- Matrix::colSums(sample_name[mito.genes, ])/Matrix::colSums(sample_name) 29 | RNA <- AddMetaData(object = RNA, metadata = percent.mito, col.name = "percent.mito") 30 | # Find ribosomal genes, compute the mitochondrial rate 31 | ribo.genes <- grep(pattern = "^RP[SL][[:digit:]]", x = rownames(x = sample_name), value = TRUE) 32 | percent.ribo <- Matrix::colSums(sample_name[ribo.genes, ])/Matrix::colSums(sample_name) 33 | RNA <- AddMetaData(object = RNA, metadata = percent.ribo, col.name = "percent.ribo") 34 | # Calculate housekeeping gene score(UMI sum) 35 | housekeeking_marker <- c("ACTB","GAPDH","MALAT1") 36 | hw_data <- sample_name[housekeeking_marker,] 37 | housekeeping_UMI <- colSums(hw_data) 38 | RNA <- AddMetaData(object = RNA, metadata = housekeeping_UMI, col.name = "housekeeping_score") 39 | # summary 40 | dim(RNA);median(RNA$nFeature_RNA);median(RNA$nCount_RNA);median(RNA@meta.data$percent.mito) 41 | table(RNA$nFeature_RNA < 500);table(RNA@meta.data$percent.mito > 0.2);table(RNA@meta.data$percent.ribo > 0.5);table(RNA@meta.data$housekeeping_score < 1) 42 | # filter 43 | RNA <- subset(RNA, nFeature_RNA >= 500) 44 | RNA <- subset(RNA, percent.mito <= 0.2) 45 | RNA <- subset(RNA, percent.ribo <= 0.5) 46 | RNA <- subset(RNA, housekeeping_score >= 1) 47 | dim(RNA) 48 | 49 | ## save filtered reslts 50 | write.table(RNA@assays$RNA@counts,paste0(dir,"count_matrix_filter/","BD_immune01","_filter.txt"),quote=F,sep="\t") 51 | -------------------------------------------------------------------------------- /01.3_Merge_matrix.R: -------------------------------------------------------------------------------- 1 | # Load libraries 2 | library(data.table) 3 | library(future) 4 | plan("multiprocess", workers = 8) 5 | options(future.globals.maxSize = 10*1024^3) 6 | 7 | # Set the full path to the github directory 8 | rm(list=ls()) 9 | dir <- "./" 10 | 11 | # Merge all count matrix and save it 12 | txt_list <- list.files(path=paste0(dir,"count_matrix_scrublet/"),pattern=".csv") 13 | txt_num <- length(txt_list) 14 | txt_id <- gsub(".csv","",txt_list) 15 | for(i in 1:txt_num){ 16 | data <- read.csv(paste0(dir,"count_matrix_scrublet/",txt_list[i]),header=T,stringsAsFactors=F,row.names=1) 17 | assign(txt_id[i],data) 18 | } 19 | ls() 20 | 21 | count_all <- merge(get(txt_id[1]),get(txt_id[2]),by=0) 22 | rownames(count_all) <- count_all[,1] 23 | count_all <- count_all[,-1] 24 | for(i in 3:txt_num){ 25 | count_all <- merge(count_all,get(txt_id[i]),by=0) 26 | rownames(count_all) <- count_all[,1] 27 | count_all <- count_all[,-1] 28 | } 29 | dim(count_all) 30 | write.table(count_all,file=paste0(dir,"count_all_scrublet.txt"),quote=F,sep="\t") 31 | 32 | # prepare metadata and save it 33 | clin_info <- read.csv("clin_info.csv",header=T,stringsAsFactors=F) 34 | metadata <- data.frame(Cell = colnames(count_all), 35 | Sample_ID = gsub("_[0-9]{1,}","",colnames(count_all))) 36 | metadata <- merge(metadata,clin_info,by="Sample_ID") 37 | metadata <- metadata[,c(2,1,3:ncol(metadata))] 38 | write.csv(metadata,paste0(dir,"metadata_scrublet.csv"),row.names=F,quote=F) 39 | 40 | 41 | -------------------------------------------------------------------------------- /01.3_Scrublet.py: -------------------------------------------------------------------------------- 1 | ### scrublet 2 | import scrublet as scr 3 | import pandas as pd 4 | import numpy as np 5 | import os 6 | import matplotlib.pyplot as plt 7 | 8 | txt_name = [] 9 | sample_name = [] 10 | ### read data 11 | for file in os.listdir("./count_matrix_filter/"): 12 | file_name = file.replace("_filter.txt","") 13 | txt_name.append(file_name) 14 | sample_name.append(file_name) 15 | 16 | i=0 17 | for file in os.listdir("./count_matrix_filter/"): 18 | txt_name[i] = pd.read_table(file,sep="\t",index_col=0,header=0).T 19 | i +=1 20 | # restore predicted doublets 21 | doublet_cell = [] 22 | 23 | ### run scrublet one by one 24 | count_matrix = txt_name[12] 25 | scrub = scr.Scrublet(count_matrix, expected_doublet_rate=0.025) 26 | doublet_scores, predicted_doublets = scrub.scrub_doublets() 27 | pd.value_counts(predicted_doublets) 28 | scrub.plot_histogram() 29 | plt.savefig("./tmp/his.png") 30 | # adjust threshold 31 | predicted_doublets = scrub.call_doublets(threshold=0.22) 32 | pd.value_counts(predicted_doublets) 33 | scrub.plot_histogram() 34 | plt.savefig("./tmp/his.png") 35 | 36 | data_tmp = count_matrix[predicted_doublets] 37 | 38 | # all doublets collect 39 | doublet_cell.extend(data_tmp.index.tolist()) 40 | 41 | # save singlets 42 | predicted_singlets = list(np.array(1)-predicted_doublets) 43 | keep = [bool(i) for i in predicted_singlets] 44 | 45 | data_keep = count_matrix[keep] 46 | data_keep = data_keep.T 47 | data_keep.to_csv("./count_matrix_scrublet/"+sample_name[12]+".csv") 48 | 49 | ###### save 50 | doublet_cell = pd.DataFrame(doublet_cell,columns="Cell") 51 | 52 | doublet_cell.to_csv("./data_out/scrublet_doublets.csv") 53 | 54 | 55 | -------------------------------------------------------------------------------- /02_All_cell_clustering.R: -------------------------------------------------------------------------------- 1 | # load libraries 2 | library(Seurat) 3 | library(ggplot2) 4 | library(future) 5 | library(tidyverse) 6 | library(gridExtra) 7 | library(ggridges) 8 | library(ggplot2) 9 | library(ggExtra) 10 | plan("multiprocess", workers = 8) 11 | options(future.globals.maxSize = 10*1024^3) 12 | 13 | # set work directory 14 | rm(list=ls()) 15 | dir <- "./" 16 | 17 | ### read raw count matrix 18 | raw.data <- read.table(paste0(dir,"count_all_scrublet.txt"),header=T,row.names=1,stringsAsFactors=F) 19 | 20 | ### read metadata 21 | metadata <- read.csv("metadata_scrublet.csv", row.names=1, header=T,stringsAsFactors=F) 22 | 23 | # Create the Seurat object with all the data (filtered) 24 | RNA <- CreateSeuratObject(counts = raw.data) 25 | # add metadata to Seurat object 26 | RNA <- AddMetaData(object = RNA, metadata = metadata) 27 | # Head to check 28 | head(RNA@meta.data) 29 | 30 | # Save Seurat object 31 | saveRDS(RNA, file=paste0(dir,"all_cell.rds")) 32 | 33 | ## check gene and count number distribution 34 | RNA <- readRDS(file=paste0(dir,"all_cell.rds")) 35 | library(ggplot2) 36 | library(cowplot) 37 | p <- ggplot(data=RNA@meta.data,aes(x=nFeature_RNA))+geom_histogram(bins=50,fill="#219ebc",color="black")+labs(x="Genes",y="Cell counts",title="")+theme_cowplot()+ 38 | scale_x_continuous(limits=c(400,8500),breaks=seq(500,8500,1000))+ 39 | theme(axis.text.x=element_text(size=15,angle = 45, hjust=1, vjust=1),axis.text.y=element_text(size = 15),axis.title.y=element_text(size = 18),axis.title.x=element_text(size = 18),axis.ticks.length = unit(0.3,"cm")) 40 | ggsave(paste0(dir,"/plot_out/all_cell_gene_his.pdf"),p,width=8,heigh=6) 41 | 42 | p <- ggplot(data=RNA@meta.data,aes(x=nCount_RNA))+geom_histogram(bins=50,fill="#219ebc",color="black")+labs(x="UMIs",y="Cell counts",title="")+theme_cowplot()+ 43 | scale_x_continuous(limits=c(500,12500),breaks=seq(500,12500,1500))+ 44 | theme(axis.text.x=element_text(size=15,angle = 45, hjust=1, vjust=1),axis.text.y=element_text(size = 15),axis.title.y=element_text(size = 18),axis.title.x=element_text(size = 18),axis.ticks.length = unit(0.3,"cm")) 45 | ggsave(paste0(dir,"/plot_out/all_cell_count_his.pdf"),p,width=8,heigh=6) 46 | 47 | ### first cluster 48 | RNA <- NormalizeData(object = RNA) 49 | RNA <- FindVariableFeatures(object = RNA) 50 | RNA <- ScaleData(object = RNA) 51 | RNA <- RunPCA(object = RNA, do.print = FALSE) 52 | ElbowPlot(RNA) 53 | RNA <- FindNeighbors(object = RNA, verbose = T, dims = 1:20) 54 | RNA <- FindClusters(object = RNA, verbose = T, resolution = 0.6) 55 | RNA <- RunUMAP(RNA, dims = 1:20) 56 | # Visualize UMAP colored by cluster 57 | p=DimPlot(RNA, reduction = "umap", label = T) 58 | ggsave(paste0(dir,"plot_out/all_cell_UMAP.pdf"),p,width=6.5, height=6) 59 | # Check batch 60 | pdf(paste(dir,"plot_out/all_cell_meta.pdf", sep=""),7,6) 61 | DimPlot(RNA, reduction = "umap", label = F, group.by = "Patient_ID") 62 | DimPlot(RNA, reduction = "umap", label = F, group.by = "Group") 63 | DimPlot(RNA, reduction = "umap", label = F, group.by = "PD1_name") 64 | dev.off() 65 | ## there were probabaly batch effects on Patients 66 | 67 | ### Remove batch effect by CCA 68 | data.list <- SplitObject(RNA, split.by = "Sample_ID") 69 | for (i in 1:length(data.list)) { 70 | data.list[[i]] <- NormalizeData(data.list[[i]], verbose = FALSE) 71 | data.list[[i]] <- FindVariableFeatures(data.list[[i]], 72 | selection.method = "vst", nfeatures = 3000, 73 | verbose = FALSE) 74 | } 75 | anchors <- FindIntegrationAnchors(object.list = data.list, 76 | dims = 1:20, anchor.features = 3000) 77 | RNA.integrated <- IntegrateData(anchorset = anchors, dims = 1:20) 78 | RNA.integrated@project.name <- paste0(RNA@project.name, "_CCA") 79 | 80 | ### cluster 81 | RNA.integrated <- ScaleData(object = RNA.integrated) 82 | RNA.integrated <- RunPCA(object = RNA.integrated, do.print = FALSE) 83 | p <- ElbowPlot(RNA.integrated) 84 | ggsave(paste0(dir,"/plot_out/all_cell_elbow_CCA.png"),p,width=5,heigh=5) 85 | 86 | RNA.integrated <- FindNeighbors(object = RNA.integrated, verbose = T, dims = 1:20) 87 | RNA.integrated <- FindClusters(object = RNA.integrated, verbose = T, resolution = 0.6) 88 | RNA.integrated <- RunUMAP(RNA.integrated, dims = 1:20) 89 | # plot on UMAP 90 | p=DimPlot(RNA.integrated, reduction = "umap", label = T) 91 | ggsave(paste0(dir,"plot_out/all_cell_UMAP_CCA.pdf"),p,width=7, height=6) 92 | # recheck batch 93 | pdf(paste(dir,"plot_out/all_cell_meta_umap_CCA.pdf", sep=""),7,6) 94 | DimPlot(RNA.integrated, reduction = "umap", label = F, group.by = "Patient_ID") 95 | DimPlot(RNA.integrated, reduction = "umap", label = F, group.by = "Group") 96 | DimPlot(RNA.integrated, reduction = "umap", label = F, group.by = "PD1_name") 97 | dev.off() 98 | 99 | #### integrate CCA cluster res into pre-CCA seurat object 100 | RNA[["umap"]] <- RNA.integrated[["umap"]] 101 | RNA[["tsne"]] <- RNA.integrated[["tsne"]] 102 | Idents(RNA) <- Idents(RNA.integrated) 103 | RNA@meta.data$integrated_snn_res.0.6 <- RNA.integrated@meta.data$integrated_snn_res.0.6 104 | # plot on UMAP 105 | p=DimPlot(RNA, reduction = "umap", label = T) 106 | ggsave(paste0(dir,"plot_out/all_cell_UMAP.pdf"),p,width=7, height=6) 107 | ## find marker for each cluster 108 | markers <- FindAllMarkers(object = RNA, only.pos = TRUE, min.pct = 0.25, thresh.use = 0.25) 109 | write.csv(markers, file=paste0(dir,"data_out/all_cell_clusters.csv"),quote=F) 110 | 111 | # Visualize nFeature and nCount on UMAP 112 | data <- Embeddings(object = RNA[["umap"]])[, c(1,2)] 113 | data <- as.data.frame(data) 114 | data$nFeature <- RNA$nFeature_RNA 115 | data$nCount <- RNA$nCount_RNA 116 | library(cowplot) 117 | # plot nFeature 118 | p <- ggplot(data = data,aes(x=data[,1],y=data[,2]))+ 119 | geom_point(aes_string(color=data$nFeature))+ 120 | theme(axis.title.x = element_blank(),axis.title.y = element_blank())+theme_cowplot()+ 121 | scale_color_gradient(low = "yellow", high = "#DE2D26")+ 122 | guides(color = guide_colorbar(title = "Genes"))+ 123 | labs(x="UMAP_1",y="UMAP_2") 124 | ggsave(paste0(dir,"plot_out/all_cell_nFeature_CCA.pdf"),p,width =7,height =6) 125 | # plot nCount 126 | p <- ggplot(data = data,aes(x=data[,1],y=data[,2]))+ 127 | geom_point(aes_string(color=data$nCount))+ 128 | theme(axis.title.x = element_blank(),axis.title.y = element_blank())+theme_cowplot()+ 129 | scale_color_gradient(low = "lightblue", high = "blue")+ 130 | guides(color = guide_colorbar(title = "UMIs"))+ 131 | labs(x="UMAP_1",y="UMAP_2") 132 | ggsave(paste0(dir,"plot_out/all_cell_nCount_CCA.pdf"),p,width =7,height =6) 133 | # plot PD1_name 134 | data$PD1_name <- factor(RNA$PD1_name,levels=c("Toripalimab","Sintilimab","Camrelizumab")) 135 | p <- ggplot(data = data,aes(x=data[,1],y=data[,2]))+ 136 | geom_point(aes_string(color=data$PD1_name),size=0.3)+ 137 | theme(axis.title.x = element_blank(),axis.title.y = element_blank())+theme_cowplot()+ 138 | scale_color_manual(name = "",values = c("Toripalimab"="#619cff","Sintilimab"="#00ba38","Camrelizumab"="#f8766d"))+ 139 | labs(x="UMAP_1",y="UMAP_2") 140 | ggsave(paste0(dir,"plot_out/all_cell_PD1.pdf"),p,width =7,height =6) 141 | 142 | # Barplot of clusters per patient 143 | library(cowplot) 144 | tab1 <- cbind(as.data.frame(RNA@meta.data$Patient_ID),as.data.frame(RNA@meta.data$integrated_snn_res.0.6)) 145 | colnames(tab1) <- c("Patient", "Clusters") 146 | pdf(paste0(dir,"plot_out/all_cell_proportion_per_patient.pdf"),width=12,height=8) 147 | ggplot(data=tab1,aes(x = Patient, fill = factor(Clusters))) + theme_bw()+theme_cowplot()+ 148 | geom_bar(position = "fill",width=0.6) + theme(axis.text.x = element_text(size = 15,hjust = 1, vjust = 1,angle = 45),axis.text.y = element_text(size = 15),axis.ticks.length = unit(0.3,"cm"))+ 149 | labs(x="",y="Cellular fraction",fill="Cluster")+theme(axis.title.y=element_text(size = 16),legend.title = element_text(size =15)) 150 | dev.off() 151 | # Barplot of patients per cluster 152 | pdf(paste(dir,"plot_out/all_cell_proportion_per_cluster.pdf", sep=""),width=10,height=15) 153 | ggplot(tab1) + 154 | aes(x = factor(Clusters,levels=c(0:25)), fill = Patient) + theme_bw()+theme_cowplot()+ 155 | geom_bar(position = "fill",width=0.6) + labs(x="Clusters",y="")+ 156 | theme(axis.text.y = element_text(size=15),axis.text.x = element_text(size=15),legend.title=element_blank(),axis.ticks.length = unit(0.3,"cm")) 157 | dev.off() 158 | 159 | # Manually ananotate immmune markers to identify major cell clusters 160 | cell_marker=c("PTPRC","CD3E","LYZ","CD79A","MS4A1","IGHG1","CSF3R","FGFBP2","KIT","LILRA4","VWF","COL1A1","EPCAM","MKI67") 161 | library(ggExtra) 162 | marker_plot=function(SeuratObj,marker){ 163 | pn=length(marker) 164 | pp=list() 165 | for(i in 1:pn){ 166 | pg=FeaturePlot(object = SeuratObj, features = marker[i], cols = c("grey", "red"), reduction = "umap")+NoLegend()+labs(x="",y="")+theme(plot.title = element_text(hjust = 0.5)) 167 | pp[[marker[i]]]=pg 168 | } 169 | return(pp) 170 | } 171 | p=marker_plot(RNA,cell_marker) 172 | for(i in 1:14){ 173 | ggsave(paste0(dir,"plot_out/all_cell_",cell_marker[i],".png"),p[[cell_marker[i]]],width =6,height =6) 174 | } 175 | 176 | ###### Manually pick and ananotate each cluster to immmune, stromal and epithelial cells 177 | immune_cluster <- c(0,1,2,3,5,6,7,8,9,10,11,12,14,15,18,19,21,23,24,25) 178 | stromal_cluster <- c(20) 179 | epi_cluster <- c(4,13,16,17,22) 180 | RNA@meta.data$major_cluster_annotation <- ifelse(RNA@meta.data$integrated_snn_res.0.6 %in% immune_cluster, "Immune cell",ifelse(RNA@meta.data$integrated_snn_res.0.6 %in% stromal_cluster,"Stromal cell","Epithelium")) 181 | # plot tsne 182 | pdf(paste(dir,"plot_out/major_cluster_annotation.pdf", sep=""),width = 7,height = 6) 183 | DimPlot(RNA, reduction = "tsne", label = T, group.by = 'major_cluster_annotation') 184 | dev.off() 185 | # plot umap 186 | pdf(paste(dir,"plot_out/major_cluster_annotation_umap.pdf", sep=""),width = 7,height = 6) 187 | DimPlot(RNA, reduction = "umap", label = T, group.by = 'major_cluster_annotation') 188 | dev.off() 189 | 190 | # Manually ananotate cell markers 191 | # stash current cluster IDs 192 | RNA[["all.cluster"]] <- Idents(object = RNA) 193 | # enumerate current cluster IDs and the labels for them 194 | cluster.ids <- 0:(length(unique(RNA@meta.data$all.cluster))-1) 195 | # Annotate each of the clusters 196 | free_annotation <- c("T cell","B cell","T cell","Neutrophil","Epithelium","T cell","T cell","Myeloid cell","Myeloid cell","Myeloid cell", 197 | "Neutrophil","Plasma cell","T cell","Epithelium","T cell","Cycling immune cell","Epithelium","Epithelium","T cell","NK cell","Fibroblast/Endothelium", 198 | "Mast cell","Epithelium","pDC","Plasma cell","Myeloid cell") 199 | # Map free annotation to cluster numbers and store as all_subtype_annotation 200 | RNA@meta.data[,'all_cluster_annotation'] <- plyr::mapvalues(x = RNA@meta.data$all.cluster, from = cluster.ids, to = free_annotation) 201 | # plot umap 202 | pdf(paste(dir,"plot_out/all_cluster_annotation_umap.pdf", sep=""),width = 8,height = 6) 203 | DimPlot(RNA, reduction = "umap", label = F, group.by = 'all_cluster_annotation') 204 | dev.off() 205 | 206 | ### save annotation 207 | saveRDS(RNA,paste0(dir,"all_cell.rds")) 208 | 209 | RNA <- readRDS(paste0(dir,"all_cell.rds")) 210 | ### UMAP plot in TN, MPR and NMPR, respectively 211 | for(i in c("TN","MPR","NMPR")){ 212 | RNA_sub <- subset(RNA,Group==i) 213 | pdf(paste0(dir,"plot_out/all_cluster_",i,"_umap.pdf"),width = 8,height = 6) 214 | DimPlot(RNA_sub, reduction = "umap", label = F, group.by = 'all_cluster_annotation') 215 | dev.off() 216 | } 217 | 218 | ###Calculate cell fractions in different response groups 219 | source(paste0(dir,"code/Cal_fraction.R")) 220 | tab.1 <- cal_fraction(RNA,"all_cluster_annotation") 221 | # plot 222 | p1<- ggplot(tab.1, aes(x=Group, y=Estimate)) + 223 | geom_bar(stat = "identity", aes(fill=cell)) + facet_grid(cols = vars(cell)) + 224 | theme_bw() + 225 | theme(axis.text.x = element_text(size=13,angle = 45, hjust=1, vjust=1), axis.text.y = element_text(size=13),axis.ticks.length = unit(0.3,"cm"),legend.position= "none") + 226 | xlab("") + ylab("Cellular fraction (%)") + 227 | theme(axis.title.y=element_text(size=16),strip.text = element_text(size = 13))+ 228 | geom_errorbar(aes(ymin=lower, ymax=upper), width=.2,position=position_dodge(0.05)) 229 | # Save plot 230 | ggsave(p1, filename = paste(dir,"plot_out/all_cell_across_treatment.pdf", sep=""),width = 15, height = 5) 231 | 232 | ##take out the immune cell 233 | RNA_immune <- subset(RNA, integrated_snn_res.0.6 %in% immune_cluster) 234 | saveRDS(RNA_immune, paste0(dir,"immune.rds")) 235 | ##take out the non-immune cell 236 | RNA_non_immune <- subset(RNA, integrated_snn_res.0.6 %in% c(stromal_cluster,epi_cluster)) 237 | saveRDS(RNA_non_immune, paste0(dir,"non_immune.rds")) 238 | ##take out the stromal cell 239 | RNA_stromal <- subset(RNA, integrated_snn_res.0.6 %in% stromal_cluster) 240 | saveRDS(RNA_stromal, paste0(dir, "stromal.rds")) 241 | ##take out the epithelium 242 | RNA_epi <- subset(RNA, integrated_snn_res.0.6 %in% epi_cluster) 243 | saveRDS(RNA_epi, paste0(dir, "epithelium.rds")) 244 | 245 | 246 | ################### 247 | ################### new plot 248 | ###Calculate cell fractions in different response groups 249 | 250 | source(paste0(dir,"code/Cal_fraction_patients.R")) 251 | tab.2 <- cal_fraction_patients(RNA,"all_cluster_annotation") 252 | colnames(tab.2)[4] <- "Patient_ID" 253 | 254 | clin_info <- read.csv("clin_info.csv",header=T,stringsAsFactors=F) 255 | sample_info <- clin_info[,c("Patient_ID","Group")] 256 | table.plot <- merge(tab.2,sample_info,by="Patient_ID") 257 | table.plot$Group <- factor(table.plot$Group,levels=c("TN","MPR","NMPR")) 258 | 259 | Group_color_panel <- c("TN"="#228B22","MPR"="#FF4500","NMPR"="#757bc8") 260 | 261 | p1<- ggplot(tab.1, aes(x=Group, y=Estimate)) + 262 | geom_bar(stat = "identity", aes(fill=Group)) + 263 | scale_fill_manual(name = "Group", values = Group_color_panel) + facet_grid(~ cell) + 264 | theme_bw() + 265 | theme(axis.text.x = element_text(size=13,angle = 45, hjust=1, vjust=1), axis.text.y = element_text(size=13),axis.ticks.length = unit(0.2,"cm")) + 266 | xlab("") + ylab("Cellular fraction (%) of all cells") + 267 | theme(axis.title.y=element_text(size=13),strip.text = element_text(size = 13))+ 268 | geom_errorbar(aes(ymin=lower, ymax=upper), width=.2,position=position_dodge(0.05)) 269 | 270 | pdf(paste(dir,"plot_out/all_cell_across_treatment3.pdf", sep=""),width = 16,height = 5) 271 | p1+geom_point(data=table.plot,aes(x=Group, y=Estimate,color=Patient_ID),size = 1.5) 272 | dev.off() 273 | 274 | ggplot(table.plot, aes(x=cell, y=Estimate,fill = Group)) + 275 | stat_summary(fun.y = mean, fun.ymin = mean, fun.ymax = mean, 276 | geom = 'bar', width = 0.3, size = 0.3,fill = 'transparents') + 277 | stat_summary(fun.data = function(x) median_hilow(x, 0.5), 278 | geom = 'errorbar', width = 0.25, size = 0.2) + 279 | geom_jitter(size = 1.5, width = 0.2,stat = "identity") + 280 | scale_fill_manual(name = "Group", values = Group_color_panel) + facet_grid(~ cell) + 281 | theme_bw() + 282 | theme(axis.text.x = element_text(size=13,angle = 45, hjust=1, vjust=1), axis.text.y = element_text(size=13),axis.ticks.length = unit(0.2,"cm")) + 283 | xlab("") + ylab("Cellular fraction (%) of all cells") + 284 | theme(axis.title.y=element_text(size=13),strip.text = element_text(size = 13)) 285 | 286 | # plot 287 | p2<- ggplot(table.plot) + 288 | geom_boxplot(aes(x=cell, y=Estimate,color=Group,outlier.colour = NA),width = 0.6,position=position_dodge(0.75))+ 289 | geom_jitter(aes(x=cell, y=Estimate,color=Group),size = 1.5, position = position_jitterdodge())+ 290 | scale_color_manual(name="Group",values = Group_color_panel)+ 291 | theme_bw() + 292 | theme(axis.text.x = element_text(size=13), axis.text.y = element_text(size=13),axis.ticks.length = unit(0.3,"cm")) + 293 | xlab("") + ylab("Cellular fraction (%) of all cells") + 294 | theme(axis.title.y=element_text(size=15),strip.text = element_text(size = 13)) 295 | # Save plot 296 | ggsave(p2, filename = paste(dir,"plot_out/all_cell_across_treatment2.pdf", sep=""),width = 20, height = 6) 297 | 298 | 299 | library(ggsignif) 300 | compaired <- list(c("TN","MPR"),c("TN","NMPR"),c("MPR","NMPR")) 301 | ps <- list() 302 | for(i in unique(table.plot$cell)){ 303 | ps[[i]]<- ggplot(subset(table.plot,cell==i),aes(x=Group, y=Estimate,color=Group)) + 304 | geom_boxplot(width = 0.5,position=position_dodge(0.75),outlier.colour = NA)+ 305 | geom_jitter(size = 1.5, position = position_jitterdodge())+ 306 | scale_color_manual(name="Group",values = Group_color_panel)+ 307 | theme_bw() + 308 | theme(axis.text.x = element_text(size=13,angle = 45, hjust=1, vjust=1), axis.text.y = element_text(size=13),axis.ticks.length = unit(0.3,"cm")) + 309 | labs(x="",y="Cellular fraction (%) of all cells",title=i) + 310 | theme(axis.title.y=element_text(size=15),strip.text = element_text(size = 13))+ 311 | geom_signif(comparisons = compaired,step_increase = 0.1,map_signif_level = F,test = wilcox.test) 312 | } 313 | 314 | pdf(paste0(dir,"plot_out/all_cell_fraction_each_cell.pdf"),height=5,width=4) 315 | for(i in unique(table.plot$cell)){print(ps[[i]])} 316 | dev.off() 317 | 318 | 319 | # plot 320 | p3<- ggplot(table.plot) + 321 | geom_boxplot(aes(x=cell, y=Estimate,color=Group,outlier.colour = NA),width = 0.6,position=position_dodge(0.75))+ 322 | geom_jitter(aes(x=cell, y=Estimate,color=Group),size = 1.5, position = position_jitterdodge())+ 323 | scale_color_manual(name="Group",values = Group_color_panel)+ 324 | theme_bw() + 325 | theme(axis.text.x = element_text(size=13), axis.text.y = element_text(size=13),axis.ticks.length = unit(0.3,"cm")) + 326 | xlab("") + ylab("Cellular fraction (%) of all cells") + 327 | theme(axis.title.y=element_text(size=15),strip.text = element_text(size = 13)) 328 | # Save plot 329 | ggsave(p3, filename = paste(dir,"plot_out/all_cell_across_treatment2.pdf", sep=""),width = 14, height = 6) 330 | 331 | # split plot 332 | RNA@meta.data$Group <- factor(RNA@meta.data$Group,levels=c("TN","MPR","NMPR")) 333 | p <- DimPlot(RNA, reduction = "umap", label = F, group.by = "all_cluster_annotation",split.by="Group") + NoLegend() 334 | ggsave("plot_out/all_cell_group_split.png",p,width=9,height=4) 335 | 336 | 337 | -------------------------------------------------------------------------------- /03.1_Tumor_copykat_analysis.R: -------------------------------------------------------------------------------- 1 | library(Seurat) 2 | library(ggplot2) 3 | library(copykat) 4 | library(future) 5 | plan("multiprocess", workers = 8) 6 | options(future.globals.maxSize = 10*1024^3) 7 | 8 | dir <- "./" 9 | 10 | ## read count matrix 11 | RNA_epi <- readRDS("epithelium.rds") 12 | count_epi <- as.matrix(RNA_epi@assays$RNA@counts) 13 | 14 | ## read stromal count matrix as reference 15 | RNA_str <- readRDS("stromal.rds") 16 | count_ref <- as.matrix(RNA_str@assays$RNA@counts) 17 | ref_name <- rownames(RNA_str@meta.data) 18 | 19 | ## merge 20 | exp.rawdata <- cbind(count_epi,count_ref) 21 | 22 | ## run copykat 23 | copykat.test <- copykat(rawmat=exp.rawdata, id.type="S", 24 | ngene.chr=5, win.size=25, KS.cut=0.1, sam.name="test", 25 | distance="euclidean", norm.cell.names=ref_name, n.cores=20) 26 | 27 | pred.test <- data.frame(copykat.test$prediction) 28 | CNA.test <- data.frame(copykat.test$CNAmat) 29 | 30 | saveRDS(copykat.test,"data_out/copykat_res.rds") 31 | 32 | ## plot 33 | copykat.test <- readRDS(paste0(dir,"data_out/copykat_res.rds")) 34 | my_palette <- colorRampPalette(rev(RColorBrewer::brewer.pal(n = 3, name = "RdBu")))(n = 999) 35 | 36 | chr <- as.numeric(CNA.test$chrom) %% 2+1 37 | rbPal1 <- colorRampPalette(c('black','grey')) 38 | CHR <- rbPal1(2)[as.numeric(chr)] 39 | chr1 <- cbind(CHR,CHR) 40 | 41 | rbPal5 <- colorRampPalette(RColorBrewer::brewer.pal(n = 8, name = "Dark2")[2:1]) 42 | com.preN <- pred.test$copykat.pred 43 | pred <- rbPal5(2)[as.numeric(factor(com.preN))] 44 | 45 | cells <- rbind(pred,pred) 46 | col_breaks = c(seq(-1,-0.4,length=50),seq(-0.4,-0.2,length=150),seq(-0.2,0.2,length=600),seq(0.2,0.4,length=150),seq(0.4, 1,length=50)) 47 | 48 | jpeg(paste0(dir,"plot_out/TC_copykat_heatmap.jpeg"),width=50,height=37.5,units = "in",res=300) 49 | heatmap.3(t(CNA.test[,4:ncol(CNA.test)]),dendrogram="r", distfun = function(x) parallelDist::parDist(x,threads =4, method = "euclidean"), hclustfun = function(x) hclust(x, method="ward.D2"), 50 | ColSideColors=chr1,RowSideColors=cells,Colv=NA, Rowv=TRUE, 51 | notecol="black",col=my_palette,breaks=col_breaks, key=TRUE, 52 | keysize=1, density.info="none", trace="none", 53 | cexRow=0.1,cexCol=0.1,cex.main=1,cex.lab=0.1, 54 | symm=F,symkey=F,symbreaks=T,cex=1, cex.main=4, margins=c(10,10)) 55 | 56 | legend("topright", paste("pred.",names(table(com.preN)),sep=""), pch=15,col=RColorBrewer::brewer.pal(n = 8, name = "Dark2")[2:1], cex=0.6, bty="n") 57 | dev.off() 58 | ## define subpopulations of aneuploid tumor cells 59 | tumor.cells <- pred.test$cell.names[which(pred.test$copykat.pred=="aneuploid")] 60 | tumor.mat <- CNA.test[, which(colnames(CNA.test) %in% tumor.cells)] 61 | hcc <- hclust(parallelDist::parDist(t(tumor.mat),threads =4, method = "euclidean"), method = "ward.D2") 62 | hc.umap <- cutree(hcc,2) 63 | 64 | rbPal6 <- colorRampPalette(RColorBrewer::brewer.pal(n = 8, name = "Dark2")[3:4]) 65 | subpop <- rbPal6(2)[as.numeric(factor(hc.umap))] 66 | cells <- rbind(subpop,subpop) 67 | 68 | heatmap.3(t(tumor.mat),dendrogram="r", distfun = function(x) parallelDist::parDist(x,threads =4, method = "euclidean"), hclustfun = function(x) hclust(x, method="ward.D2"), 69 | ColSideColors=chr1,RowSideColors=cells,Colv=NA, Rowv=TRUE, 70 | notecol="black",col=my_palette,breaks=col_breaks, key=TRUE, 71 | keysize=1, density.info="none", trace="none", 72 | cexRow=0.1,cexCol=0.1,cex.main=1,cex.lab=0.1, 73 | symm=F,symkey=F,symbreaks=T,cex=1, cex.main=4, margins=c(10,10)) 74 | 75 | legend("topright", c("c1","c2"), pch=15,col=RColorBrewer::brewer.pal(n = 8, name = "Dark2")[3:4], cex=0.9, bty='n') 76 | 77 | 78 | 79 | 80 | 81 | 82 | 83 | 84 | 85 | -------------------------------------------------------------------------------- /03.2_Cancer_NK_CellphoneDB.R: -------------------------------------------------------------------------------- 1 | library(Seurat) 2 | 3 | dir <- "./" 4 | 5 | ## take Cancer cell 6 | RNA_mag <- readRDS("Epi_mag.rds") 7 | Cancer <- subset(RNA_mag,Group=="MPR") 8 | Cancer_count <- as.matrix(Cancer@assays$RNA@data) 9 | Cancer_meta <- data.frame(Cell=rownames(Cancer@meta.data), celltype = "Cancer") 10 | 11 | ## take NK_FCGR3A cell 12 | RNA <- readRDS("Tcell.rds") 13 | NK <- subset(RNA,idents=6) 14 | NK_MPR <- subset(NK,Group=="MPR") 15 | NK_count <- as.matrix(NK_MPR@assays$RNA@data) 16 | NK_meta <- data.frame(Cell=rownames(NK_MPR@meta.data), celltype = "NK_FCGR3A") 17 | 18 | count <- cbind(NK_count,Cancer_count) 19 | meta_data <- rbind(Cancer_meta,NK_meta) 20 | 21 | write.table(count, 'cellphonedb/Cancer_NK/Cancer_NK_count.txt', sep='\t', quote=F, row.names=T) 22 | write.table(meta_data, 'cellphonedb/Cancer_NK/Cancer_NK_meta.txt', sep='\t', quote=F, row.names=F) 23 | 24 | ################# cmd code ##################### 25 | cellphonedb method statistical_analysis --counts-data=gene_name --threads=20 --output-path=cellphonedb/Cancer_NK/ --pvalue 0.01 cellphonedb/Cancer_NK/Cancer_NK_meta.txt cellphonedb/Cancer_NK/Cancer_NK_count.txt 26 | cd cellphonedb/Cancer_NK/ 27 | cellphonedb plot dot_plot --means-path ./means.txt --pvalues-path ./pvalues.txt --output-path ./ 28 | cellphonedb plot heatmap_plot Cancer_NK_meta.txt --pvalues-path ./pvalues.txt --output-path ./ 29 | 30 | ## pick some L-R pair to plot 31 | library(dplyr) 32 | library(ggplot2) 33 | plot_dir <- paste0(dir,"cellphonedb/Cancer_NK/") 34 | mypvals <- read.delim(paste0(plot_dir,"pvalues.txt"), check.names = FALSE) 35 | mymeans <- read.delim(paste0(plot_dir,"significant_means.txt"), check.names = FALSE) 36 | # select cell pair 37 | keep <- c(which(mypvals$`NK_FCGR3A|Cancer` < 0.01),which(mypvals$`Cancer|NK_FCGR3A` < 0.01)) 38 | keep <- unique(keep) 39 | mypvals_keep <- mypvals[keep,] 40 | mypair <- intersect(mypvals_keep$interacting_pair,mymeans$interacting_pair) 41 | # pick out chemokines and so on 42 | chemokines <- grep("^CXC|CCL|CCR|CX3|XCL|XCR|^IL[0-9]", mypair,value = T) 43 | write.table(as.data.frame(chemokines),paste0(plot_dir,"Cancer_NK_chemokines.txt"),col.names=F,quote=F,row.names=F) 44 | costimulatory <- grep("CD86|CD80|CD48|LILRB2|LILRB4|TNF|CD2|ICAM|SLAM|LT[AB]|NECTIN2|CD40|CD70|CD27|CD28|CD58|TSLP|PVR|CD44|CD55|CD[1-9]", 45 | mypair,value = T) 46 | write.table(as.data.frame(costimulatory),paste0(plot_dir,"Cancer_NK_costimulatory.txt"),col.names=F,quote=F,row.names=F) 47 | coinhibitory <- grep("SIRP|CD47|ICOS|TIGIT|CTLA4|PDCD1|CD274|LAG3|HAVCR|VSIR|ENTPD1", 48 | mypair,value = T) 49 | write.table(as.data.frame(coinhibitory),paste0(plot_dir,"Cancer_NK_coinhibitory.txt"),col.names=F,quote=F,row.names=F) 50 | All_LR <- c(chemokines,costimulatory,coinhibitory) 51 | write.table(as.data.frame(All_LR),paste0(plot_dir,"Cancer_NK_All_LR.txt"),col.names=F,quote=F,row.names=F) 52 | 53 | #### plot the selected L-R 54 | cd cellphonedb/Cancer_NK/ 55 | cellphonedb plot dot_plot --means-path ./means.txt --pvalues-path ./pvalues.txt --output-path ./ --rows Cancer_NK_chemokines.txt --columns pair_plot.txt --output-name Cancer_NK_chemokines.pdf 56 | cellphonedb plot dot_plot --means-path ./means.txt --pvalues-path ./pvalues.txt --output-path ./ --rows Cancer_NK_costimulatory.txt --columns pair_plot.txt --output-name Cancer_NK_costimulatory.pdf 57 | cellphonedb plot dot_plot --means-path ./means.txt --pvalues-path ./pvalues.txt --output-path ./ --rows Cancer_NK_coinhibitory.txt --columns pair_plot.txt --output-name Cancer_NK_coinhibitory.pdf 58 | cellphonedb plot dot_plot --means-path ./means.txt --pvalues-path ./pvalues.txt --output-path ./ --rows Cancer_NK_All_LR.txt --columns pair_plot.txt --output-name Cancer_NK_All_LR.pdf 59 | cellphonedb plot dot_plot --means-path ./means.txt --pvalues-path ./pvalues.txt --output-path ./ --rows Cancer_NK_plot.txt --columns pair_plot.txt --output-name Cancer_NK_plot.pdf 60 | -------------------------------------------------------------------------------- /03_Tumor_cell_analysis_new.R: -------------------------------------------------------------------------------- 1 | library(Seurat) 2 | library(ggplot2) 3 | library(tidyverse) 4 | dir <- "./" 5 | 6 | RNA <- readRDS("epithelium.rds") 7 | 8 | ### CNV from copyKAT 9 | copykat.test <- readRDS(paste0(dir,"data_out/copykat_res.rds")) 10 | pred.test <- data.frame(copykat.test$prediction) 11 | 12 | # some cells were removed when running copykat 13 | RNA@meta.data$cell.names <- rownames(RNA@meta.data) 14 | RNA_sub <- subset(RNA,cell.names %in% pred.test$cell.names) 15 | keep <- which(pred.test$cell.names %in% RNA_sub$cell.names) 16 | pred.test <- pred.test[keep,] 17 | RNA_sub@meta.data$copykat <- pred.test$copykat.pred 18 | # plot 19 | p=DimPlot(RNA_sub, reduction = "umap", label = T, group.by = "copykat") 20 | ggsave(paste0(dir,"plot_out/TC_copykat_umap.pdf"),p,width=6.5, height=6) 21 | 22 | ## pick out E1-KRT17 to tell normal and tumor cell apart 23 | RNA_E1 <- subset(RNA_sub,idents=1) 24 | # plot 25 | p=DimPlot(RNA_E1, reduction = "umap", label = F, group.by = "copykat") 26 | ggsave(paste0(dir,"plot_out/TC_E1_umap.pdf"),p,width=4, height=4) 27 | # annotate E1-KRT17 normal and malignant cells 28 | cell_mag <- subset(RNA_E1@meta.data,copykat=="aneuploid") 29 | cell_norm <- subset(RNA_E1@meta.data,copykat=="diploid") 30 | keep1 <- RNA_sub@meta.data$cell.names %in% cell_mag$cell.names 31 | E1_mag <- which(keep1==T) 32 | keep2 <- RNA_sub@meta.data$cell.names %in% cell_norm$cell.names 33 | E1_norm <- which(keep2==T) 34 | RNA_sub$TC_cluster_annotation <- as.vector(RNA_sub$TC_cluster_annotation) 35 | RNA_sub$TC_cluster_annotation[E1_mag] <- "E1-KRT17-malig" 36 | RNA_sub$TC_cluster_annotation[E1_norm] <- "E1-KRT17-norm" 37 | # plot umap 38 | pdf(paste(dir,"plot_out/TC_cluster_annotation_E1sub.pdf", sep=""),width = 7,height = 6) 39 | DimPlot(RNA_sub, reduction = "umap", label = F, group.by = 'TC_cluster_annotation') 40 | dev.off() 41 | 42 | saveRDS(RNA_sub,"Epithelium_sub.rds") 43 | 44 | RNA_sub <- readRDS("Epithelium_sub.rds") 45 | ###Calculate cell fractions in different response groups 46 | source(paste0(dir,"code/Cal_fraction.R")) 47 | RNA_sub$TC_cluster_annotation <- factor(RNA_sub$TC_cluster_annotation) 48 | tab.1 <- cal_fraction(RNA_sub,"TC_cluster_annotation") 49 | tab.1$cell <- gsub("\\.[0-9]{1,}$","",rownames(tab.1)) 50 | tab.1$cell <- gsub("\\.","_",tab.1$cell) 51 | tab.1$cell <- factor(tab.1$cell,levels=c("E1_KRT17_norm","E2_S100P","E5_SFTPA2","E6_SPARCL1","E8_SCGB3A1","E9_TPPP3", 52 | "E0_DST","E1_KRT17_malig","E3_PCNA","E4_TOP2A","E7_SERPINB9")) 53 | Group_color_panel <- c("TN"="#228B22","MPR"="#FF4500","NMPR"="#757bc8") 54 | # plot 55 | p1<- ggplot(tab.1, aes(x=Group, y=Estimate)) + 56 | geom_bar(stat = "identity", aes(fill=Group)) + 57 | scale_fill_manual(name = "Group", values = Group_color_panel) + facet_grid(~ cell) + 58 | theme_bw() + 59 | theme(axis.text.x = element_text(size=13,angle = 45, hjust=1, vjust=1), axis.text.y = element_text(size=13),axis.ticks.length = unit(0.2,"cm"),legend.position= "bottom") + 60 | xlab("") + ylab("Cellular fraction (%) of epithelial cells") +theme(axis.title.y=element_text(size=15),strip.text = element_text(size = 11))+ 61 | geom_errorbar(aes(ymin=lower, ymax=upper), width=.2,position=position_dodge(0.05)) 62 | # Save plot 63 | ggsave(p1, filename = paste0(dir,"plot_out/TC_across_treatment.pdf"),width = 14.8, height = 5.6) 64 | 65 | source(paste0(dir,"code_clean/Cal_fraction_patients.R")) 66 | tab.2 <- cal_fraction_patients(RNA_sub,"TC_cluster_annotation") 67 | tab.2$cell <- gsub("\\.[0-9]{1,}$","",rownames(tab.2)) 68 | tab.2$cell <- gsub("\\.","_",tab.2$cell) 69 | tab.2$cell <- factor(tab.2$cell, levels=c("E1_KRT17_norm","E2_S100P","E5_SFTPA2","E6_SPARCL1","E8_SCGB3A1","E9_TPPP3", 70 | "E0_DST","E1_KRT17_malig","E3_PCNA","E4_TOP2A","E7_SERPINB9")) 71 | #colnames(tab.2)[4] <- "Patient_ID" 72 | clin_info <- read.csv("clin_info.csv",header=T,stringsAsFactors=F) 73 | sample_info <- clin_info[,c("Patient_ID","Group")] 74 | table.plot <- merge(tab.2,sample_info,by="Patient_ID") 75 | table.plot$Group <- factor(table.plot$Group,levels=c("TN","MPR","NMPR")) 76 | 77 | pdf(paste0(dir,"plot_out/TC_across_treatment3.pdf"),width = 14.8,height = 6.3) 78 | p1+geom_point(data=table.plot,aes(x=Group, y=Estimate,color=Patient_ID),size = 1.5) 79 | dev.off() 80 | 81 | # boxplot 82 | p2<- ggplot(table.plot) + 83 | geom_boxplot(aes(x=cell, y=Estimate,color=Group,outlier.colour = NA),width = 0.6,position=position_dodge(0.75))+ 84 | geom_jitter(aes(x=cell, y=Estimate,color=Group),size = 1.5, position = position_jitterdodge())+ 85 | scale_color_manual(name="Group",values = Group_color_panel)+ 86 | theme_bw() + 87 | theme(axis.text.x = element_text(size=13,angle = 45, hjust=1, vjust=1), axis.text.y = element_text(size=13),axis.ticks.length = unit(0.2,"cm"),legend.position= "bottom") + 88 | xlab("") + ylab("Cellular fraction (%) of epithelial cells") + 89 | theme(axis.title.y=element_text(size=15),strip.text = element_text(size = 13)) 90 | # Save plot 91 | ggsave(p2, filename = paste(dir,"plot_out/TC_across_treatment2.pdf", sep=""),width = 14.8, height = 6.3) 92 | 93 | library(ggsignif) 94 | compaired <- list(c("TN","MPR"),c("TN","NMPR"),c("MPR","NMPR")) 95 | ps <- list() 96 | for(i in unique(table.plot$cell)){ 97 | ps[[i]]<- ggplot(subset(table.plot,cell==i),aes(x=Group, y=Estimate,color=Group)) + 98 | geom_boxplot(width = 0.5,position=position_dodge(0.75),outlier.colour = NA)+ 99 | geom_jitter(size = 1.5, position = position_jitterdodge())+ 100 | scale_color_manual(name="Group",values = Group_color_panel)+ 101 | theme_bw() + 102 | theme(axis.text.x = element_text(size=13,angle = 45, hjust=1, vjust=1), axis.text.y = element_text(size=13),axis.ticks.length = unit(0.2,"cm")) + 103 | labs(x="",y="Cellular fraction (%) of epithelial cells",title=i) + 104 | theme(axis.title.y=element_text(size=15),strip.text = element_text(size = 13))+ 105 | geom_signif(comparisons = compaired,step_increase = 0.1,map_signif_level = F,test = wilcox.test) 106 | } 107 | 108 | pdf(paste0(dir,"plot_out/TC_fraction_each_cell.pdf"),height=5,width=4) 109 | for(i in unique(table.plot$cell)){print(ps[[i]])} 110 | dev.off() 111 | 112 | 113 | RNA_mag <- readRDS("Epi_mag.rds") 114 | 115 | #### MPR genes check 116 | RNA_mag$Group <- factor(RNA_mag$Group,levels=c("TN","MPR","NMPR")) 117 | p <- VlnPlot(RNA_mag,features=c("AKR1B1","AKR1B10","AKR1C1","AKR1C2","AKR1C3"),cols=c("#228B22","#FF4500","#757bc8"),pt.size = 0,group.by="Group",ncol=3) 118 | ggsave(paste0(dir,"plot_out/TC_NMPR_marker.pdf"),p,width =7,height =6) 119 | 120 | # NMPR genes check 121 | p <- VlnPlot(RNA_mag,features=c("SPARCL1","CX3CL1","CD74","HLA-DRA","HLA-DPA1","HLA-DQA1","SERPINB9","HLA-DRB1","HLA-DPB1"),cols=c("#228B22","#FF4500","#757bc8"),pt.size = 0,group.by="Group",ncol=3) 122 | ggsave(paste0(dir,"plot_out/TC_MPR_marker.pdf"),p,width =7,height =9) 123 | 124 | # gene expr distribution 125 | gene.plot <- c("AKR1B1","AKR1B10","AKR1C1","AKR1C2","AKR1C3", 126 | "SPARCL1","CX3CL1","CD74","HLA-DRA","HLA-DPA1","HLA-DQA1","SERPINB9","HLA-DRB1","HLA-DPB1") 127 | data.exp <- FetchData(object = RNA_mag, vars = gene.plot) 128 | library(cowplot) 129 | library(ggsignif) 130 | library(gridExtra) 131 | data.exp$Group <- RNA_mag$Group 132 | compaired <- list(c("TN","MPR"),c("TN","NMPR"),c("MPR","NMPR")) 133 | # plot 134 | pdf(paste0(dir,"plot_out/TC_marker_compare.pdf"),width =3,height = 4) 135 | for(i in 1:length(gene.plot)){ 136 | pg <- ggplot(data=data.exp,aes(x=factor(Group,levels=c("TN","MPR","NMPR")),y=data.exp[,i],fill=Group)) + 137 | geom_violin(color="white")+ theme_cowplot()+ 138 | scale_fill_manual(name="Group",values = Group_color_panel)+ 139 | NoLegend()+labs(x="",y="Expression level",title=gene.plot[i])+theme(plot.title = element_text(hjust = 0.5))+ 140 | geom_signif(comparisons = compaired,step_increase = 0.1,map_signif_level = F,test = wilcox.test) 141 | print(pg) 142 | } 143 | dev.off() 144 | 145 | #### DEG 146 | ## TN vs MPR 147 | RNA1 <- subset(RNA_mag,Group != "NMPR") 148 | Idents(RNA1) <- RNA1@meta.data$Group 149 | DEG<- FindAllMarkers(object = RNA1, only.pos = T, logfc.threshold = 0.25,min.pct = 0.25) 150 | write.csv(DEG, file=paste0(dir,"data_out/TC_TN-MPR.csv"),quote=F) 151 | 152 | ## TN vs NMPR 153 | RNA2 <- subset(RNA_mag,Group != "MPR") 154 | Idents(RNA2) <- RNA2@meta.data$Group 155 | DEG<- FindAllMarkers(object = RNA2, only.pos = T, logfc.threshold = 0.25,min.pct = 0.25) 156 | write.csv(DEG, file=paste0(dir,"data_out/TC_TN-NMPR.csv"),quote=F) 157 | 158 | ## MPR vs NMPR 159 | RNA3 <- subset(RNA_mag,Group != "TN") 160 | Idents(RNA3) <- RNA3@meta.data$Group 161 | DEG<- FindAllMarkers(object = RNA3, only.pos = T, logfc.threshold = 0.25,min.pct = 0.25) 162 | write.csv(DEG, file=paste0(dir,"data_out/TC_MPR-NMPR.csv"),quote=F) 163 | 164 | 165 | ## GSVA TN vs MPR 166 | source(paste0(dir,"code/GSVA.R")) 167 | RNA1 <- subset(RNA_mag,Group != "NMPR") 168 | hallmark <- "/media/inspur/AS2150G2/HJJ/scrna/h.all.v7.2.symbols.gmt" 169 | kegg <- "/media/inspur/AS2150G2/HJJ/scrna/c2.cp.kegg.v7.2.symbols.gmt" 170 | reactome <- "/media/inspur/AS2150G2/HJJ/scrna/c2.cp.reactome.v7.2.symbols.gmt" 171 | res <- GSVA_run(SeuratObj=RNA1,cluster_name="Group",cluster1="TN",cluster2="MPR", 172 | gmtFile=hallmark,kcdf="Gaussian") 173 | res$pathway <- gsub("HALLMARK_","",rownames(res)) 174 | write.csv(res,paste0(dir,"data_out/TC_TN-MPR_gsva.csv"),row.names=F,quote=F) 175 | res_plot <- res %>% dplyr::arrange(t) %>% group_by(cluster) %>% top_n(10,abs(t)) 176 | res_plot$pathway <- factor(res_plot$pathway,levels = res_plot$pathway) 177 | # plot 178 | p <- ggplot(res_plot,aes(x=pathway,y=t,fill=cluster))+geom_bar(stat ='identity')+ 179 | geom_hline(yintercept = 0)+theme_bw() + theme(panel.grid =element_blank())+ 180 | scale_fill_manual(name = "", values = c("C1"="#0077b6", "C2"="#f08080"))+ 181 | labs(x="",y="t value")+ 182 | theme(axis.text.x = element_text(size = 14),axis.title.x = element_text(size = 15),axis.text.y = element_text(size = 14),axis.ticks.length.y = unit(0,"mm"),panel.border = element_blank())+ 183 | coord_flip() 184 | ggsave(paste0(dir,"plot_out/TC_TN-MPR_gsva.pdf"),p,width =8,height =6) 185 | 186 | ## GSVA TN vs NMPR 187 | source(paste0(dir,"code/GSVA.R")) 188 | RNA2 <- subset(RNA_mag,Group != "MPR") 189 | hallmark <- "/media/inspur/AS2150G2/HJJ/scrna/h.all.v7.2.symbols.gmt" 190 | kegg <- "/media/inspur/AS2150G2/HJJ/scrna/c2.cp.kegg.v7.2.symbols.gmt" 191 | reactome <- "/media/inspur/AS2150G2/HJJ/scrna/c2.cp.reactome.v7.2.symbols.gmt" 192 | res <- GSVA_run(SeuratObj=RNA2,cluster_name="Group",cluster1="TN",cluster2="NMPR", 193 | gmtFile=hallmark,kcdf="Gaussian") 194 | res$pathway <- gsub("HALLMARK_","",rownames(res)) 195 | write.csv(res,paste0(dir,"data_out/TC_TN-NMPR_gsva.csv"),row.names=F,quote=F) 196 | res_plot <- res %>% dplyr::arrange(t) %>% group_by(cluster) %>% top_n(10,abs(t)) 197 | res_plot$pathway <- factor(res_plot$pathway,levels = res_plot$pathway) 198 | # plot 199 | p <- ggplot(res_plot,aes(x=pathway,y=t,fill=cluster))+geom_bar(stat ='identity')+ 200 | geom_hline(yintercept = 0)+theme_bw() + theme(panel.grid =element_blank())+ 201 | scale_fill_manual(name = "", values = c("C1"="#0077b6", "C2"="#7b2cbf"))+ 202 | labs(x="",y="t value")+ 203 | theme(axis.text.x = element_text(size = 14),axis.title.x = element_text(size = 15),axis.text.y = element_text(size = 14),axis.ticks.length.y = unit(0,"mm"),panel.border = element_blank())+ 204 | coord_flip() 205 | ggsave(paste0(dir,"plot_out/TC_TN-NMPR_gsva.pdf"),p,width =8,height =6) 206 | 207 | ## GSVA MPR vs NMPR 208 | source(paste0(dir,"code/GSVA.R")) 209 | RNA3 <- subset(RNA_mag,Group != "TN") 210 | hallmark <- "/media/inspur/AS2150G2/HJJ/scrna/h.all.v7.2.symbols.gmt" 211 | kegg <- "/media/inspur/AS2150G2/HJJ/scrna/c2.cp.kegg.v7.2.symbols.gmt" 212 | reactome <- "/media/inspur/AS2150G2/HJJ/scrna/c2.cp.reactome.v7.2.symbols.gmt" 213 | res <- GSVA_run(SeuratObj=RNA3,cluster_name="Group",cluster1="MPR",cluster2="NMPR", 214 | gmtFile=hallmark,kcdf="Gaussian") 215 | res$pathway <- gsub("HALLMARK_","",rownames(res)) 216 | write.csv(res,paste0(dir,"data_out/TC_MPR-NMPR_gsva.csv"),row.names=F,quote=F) 217 | res_plot <- res %>% dplyr::arrange(t) %>% group_by(cluster) %>% top_n(10,abs(t)) 218 | res_plot$pathway <- factor(res_plot$pathway,levels = res_plot$pathway) 219 | # plot 220 | p <- ggplot(res_plot,aes(x=pathway,y=t,fill=cluster))+geom_bar(stat ='identity')+ 221 | geom_hline(yintercept = 0)+theme_bw() + theme(panel.grid =element_blank())+ 222 | scale_fill_manual(name = "", values = c("C1"="#f08080", "C2"="#7b2cbf"))+ 223 | labs(x="",y="t value")+ 224 | theme(axis.text.x = element_text(size = 14),axis.title.x = element_text(size = 15),axis.text.y = element_text(size = 14),axis.ticks.length.y = unit(0,"mm"),panel.border = element_blank())+ 225 | coord_flip() 226 | ggsave(paste0(dir,"plot_out/TC_MPR-NMPR_gsva.pdf"),p,width =8,height =6) 227 | -------------------------------------------------------------------------------- /05.1_T_scvelo.py: -------------------------------------------------------------------------------- 1 | import anndata 2 | import scanpy 3 | import scvelo as scv 4 | import pandas as pd 5 | import numpy as np 6 | import matplotlib.pyplot as plt 7 | 8 | # read loom file 9 | sample_all = anndata.read_loom("sample_all.loom") 10 | #sample_all = scanpy.read_loom("sample_all.loom") 11 | # read seurat information 12 | sample_obs = pd.read_csv("T8_cellID_obs.csv") 13 | umap = pd.read_csv("T8_cell_embeddings.csv",index_col=0) 14 | cell_clusters = pd.read_csv("T8_clusters.csv") 15 | custer_color = pd.read_csv("T8_color.csv") 16 | 17 | # extracted Cell IDs from Seurat 18 | sample_all.obs.index = sample_all.obs.obs_names 19 | sample_use = sample_all[sample_obs["x"]] 20 | 21 | # view cell ID order 22 | sample_use.obs.index 23 | 24 | # add the UMAP coordinates 25 | sample_use.obsm['X_umap'] = umap.values 26 | 27 | # add cluster info 28 | sample_use.obs['cell_clusters']=cell_clusters.values 29 | 30 | ## run scvelo 31 | # Basic preprocessing 32 | scv.pp.filter_and_normalize(sample_use) 33 | scv.pp.moments(sample_use) 34 | # Velocity Tools 35 | scv.tl.velocity(sample_use, mode = "deterministic") 36 | #scv.tl.velocity(sample_use, mode = "stochastic") 37 | scv.tl.velocity_graph(sample_use) 38 | # Visualization 39 | plot_color = list(custer_color["color"]) 40 | scv.pl.velocity_embedding_stream(sample_use, basis='umap',color="cell_clusters",palette=plot_color, 41 | legend_loc="none",title="",figsize=(6,6),dpi=300,save="T8_scvelo_steady2.png") 42 | 43 | 44 | 45 | 46 | -------------------------------------------------------------------------------- /05_T_analysis_new.R: -------------------------------------------------------------------------------- 1 | library(Seurat) 2 | library(ggplot2) 3 | library(future) 4 | library(tidyverse) 5 | plan("multiprocess", workers = 8) 6 | options(future.globals.maxSize = 10*1024^3) 7 | 8 | dir <- "./" 9 | 10 | RNA <- readRDS("Tcell.rds") 11 | 12 | # Manually ananotate immmune markers to identify major cell clusters 13 | T_marker=c("CD8A","CD4","FCGR3A","CTLA4","PDCD1","TIGIT","HAVCR2","GZMA","GZMB","GZMK","NKG7","SELL","TCF7","FOXP3","ZNF683","ITGAE") 14 | marker_plot=function(SeuratObj,marker){ 15 | pn=length(marker) 16 | pp=list() 17 | for(i in 1:pn){ 18 | pg=FeaturePlot(object = SeuratObj, features = marker[i], cols = c("grey", "red"), reduction = "umap")+NoLegend()+labs(x="",y="")+theme(plot.title = element_text(hjust = 0.5)) 19 | pp[[marker[i]]]=pg 20 | } 21 | return(pp) 22 | } 23 | p=marker_plot(RNA,T_marker) 24 | for(i in 1:16){ 25 | ggsave(paste0(dir,"plot_out/T_",T_marker[i],".png"),p[[T_marker[i]]],width =6,height =6) 26 | } 27 | 28 | # Manually ananotate T markers 29 | # stash current cluster IDs 30 | RNA[["T.cluster"]] <- Idents(object = RNA) 31 | # enumerate current cluster IDs and the labels for them 32 | cluster.ids <- 0:(length(unique(RNA@meta.data$T.cluster))-1) 33 | # Annotate each of the clusters 34 | free_annotation <- c("CD8_GZMK","CD8_GZMB", "T_IL7R", "Treg_SELL","CD4_CCR7","CD4_MAF" ,"NK_FCGR3A", "CD8_HAVCR2", "CD4_CXCL13", "NK_KLRD1","T_MKI67","CD8_STMN1","Treg_CTLA4") 35 | # Map free annotation to cluster numbers and store as all_subtype_annotation 36 | RNA@meta.data[,'T_cluster_annotation'] <- plyr::mapvalues(x = RNA@meta.data$T.cluster, from = cluster.ids, to = free_annotation) 37 | # plot umap 38 | pdf(paste(dir,"plot_out/T_cluster_annotation_umap.pdf", sep=""),width = 7.4,height = 6) 39 | DimPlot(RNA, reduction = "umap", label = F, group.by = 'T_cluster_annotation') 40 | dev.off() 41 | 42 | ### read Tmem 43 | Tmem <- readRDS("Tmem.rds") 44 | meta <- Tmem@meta.data 45 | CD8Tmem <- subset(meta,Tmem_cluster == "CD8_IL7R") 46 | CD4Tmem <- subset(meta,Tmem_cluster == "CD4_IL7R") 47 | CD8_ord <- which(rownames(RNA@meta.data) %in% rownames(CD8Tmem)) 48 | CD4_ord <- which(rownames(RNA@meta.data) %in% rownames(CD4Tmem)) 49 | head(CD8_ord);head(CD4_ord) 50 | RNA$T_cluster_annotation <- as.character(RNA$T_cluster_annotation) 51 | RNA$T_cluster_annotation[CD8_ord] <- "CD8_IL7R" 52 | RNA$T_cluster_annotation[CD4_ord] <- "CD4_IL7R" 53 | # plot umap 54 | RNA$T_cluster_annotation <- factor(RNA$T_cluster_annotation, 55 | levels=c("CD8_GZMK","CD8_GZMB", "CD4_IL7R", "Treg_SELL","CD4_CCR7","CD4_MAF","CD8_IL7R","NK_FCGR3A","CD8_HAVCR2", "CD4_CXCL13", "NK_KLRD1","T_MKI67","CD8_STMN1","Treg_CTLA4")) 56 | pdf(paste(dir,"plot_out/T_cluster_annotation_umap2.pdf", sep=""),width = 7.4,height = 6) 57 | DimPlot(RNA, reduction = "umap", label = F, group.by = 'T_cluster_annotation') 58 | dev.off() 59 | 60 | saveRDS(RNA,"Tcell.rds") 61 | 62 | ###### Heatmap plot 63 | features=c("CD8A","CD8B","CD4","FCGR3A","KLRD1","FOXP3","IL2RA","IKZF2","TCF7","SELL","LEF1","CCR7","LAG3","TIGIT","PDCD1","HAVCR2","CTLA4","LAYN","ENTPD1","GZMA","GZMB","GZMK","GNLY","IFNG","PRF1","NKG7", 64 | "CD28","ICOS","CD40LG","TNFRSF4","TNFRSF9","TNFRSF18","ZNF683","ITGAE","CCL3","CCL5","CXCL13","IL21","EOMES","MAF","TOX2","ID2","TBX21","HOPX","MKI67","STMN1") 65 | row_split = c(rep("CD8/CD4",3),rep("NK",2),rep("Treg",3),rep("Naive",4),rep("Exhausted",7),rep("Cytotoxic",7),rep("Co-stimulatory",6),rep("TRM",2),rep("Chemokines",4),rep("TFs",6),rep("Proliferating",2)) 66 | row_split = factor(row_split,levels = c("CD8/CD4","NK","Treg","Naive","Exhausted","Cytotoxic","Co-stimulatory","TRM","Chemokines","TFs","Proliferating")) 67 | ### plot heatmap 68 | source(paste0(dir,"code_clean/Heat_Dot_data.R")) 69 | ### set colnames order 70 | plot_ord <- c("NK_FCGR3A","NK_KLRD1","CD8_IL7R","CD8_GZMK","CD8_GZMB","CD8_HAVCR2","CD8_STMN1","T_MKI67","CD4_IL7R","CD4_CCR7","CD4_MAF", "CD4_CXCL13","Treg_SELL","Treg_CTLA4") 71 | 72 | data.plot <- Heat_Dot_data(object=RNA,features=features,group.by="T_cluster_annotation") 73 | exp.mat <- data.plot %>% select(features.plot,id,avg.exp.scaled) %>% spread(id,avg.exp.scaled) 74 | rownames(exp.mat) <- exp.mat$features.plot 75 | exp.mat$features.plot <- NULL 76 | exp.mat <- exp.mat[,plot_ord] 77 | per.mat <- data.plot %>% select(features.plot,id,pct.exp) %>% spread(id,pct.exp) 78 | rownames(per.mat) <- per.mat$features.plot 79 | per.mat$features.plot <- NULL 80 | per.mat <- per.mat[,plot_ord]/100 81 | 82 | ### plot heatmap 83 | library(ComplexHeatmap) 84 | library(circlize) ## color 85 | # set color gradient 86 | col_fun <- colorRamp2(c(-1.5, 0, 2.5), c("#118ab2", "#fdffb6", "#e63946")) 87 | # split heatmap 88 | col_split = c(rep("NK",2),rep("CD8 T",5),"Prol",rep("CD4 Tconv",4),rep("CD4 Treg",2)) 89 | col_split =factor(col_split,levels = c("NK","CD8 T","Prol","CD4 Tconv","CD4 Treg")) 90 | # left annotation 91 | annot = c("CD8/CD4","NK","Treg","Naive","Exhausted","Cytotoxic","Co-stimulatory","TRM","Chemokines","TFs","Proliferating") 92 | row_color=c("#e76f51","#ffafcc","#0077b6","#ddbea9","#00b4d8","#dc2f02","#2a9d8f","#57cc99","#b5838d","#8a5a44","#023047") 93 | 94 | ha = HeatmapAnnotation(df = data.frame(Marker=row_split),which = "row", 95 | col = list(Marker = c("CD8/CD4" = "#e76f51", "NK" = "#ffafcc","Treg"="#0077b6","Naive"="#ddbea9", 96 | "Exhausted"="#00b4d8","Cytotoxic"="#dc2f02","Co-stimulatory"="#fca311","TRM"="#57cc99","Chemokines"="#b5838d","TFs"="#8a5a44","Proliferating"="#023047"))) 97 | pdf(paste0(dir,"plot_out/T_maker_heat_new.pdf"),width = 9,height = 13) 98 | Heatmap(exp.mat, col = col_fun,cluster_columns = F,cluster_rows = F, 99 | show_column_names = T,show_row_names = T,rect_gp=gpar(col="grey"), 100 | column_names_side = "top",row_names_side = "right", 101 | row_split = row_split,column_split = col_split, 102 | row_gap = unit(3, "mm"),column_gap =unit(3, "mm"), 103 | left_annotation = ha, 104 | heatmap_legend_param=list(title = "Expression",legend_height=unit(3, "cm"))) 105 | dev.off() 106 | 107 | pdf(paste0(dir,"plot_out/T_maker_heat_new2.pdf"),width = 7,height = 15) 108 | Heatmap(exp.mat, col = col_fun,cluster_columns = F,cluster_rows = F, 109 | show_column_names = T,show_row_names = T,rect_gp=gpar(type = "none"), 110 | cell_fun = function(j, i, x, y, width, height, fill){ 111 | grid.rect(x = x, y = y, width = width, height = height,gp = gpar(col = "grey", fill = NA)) 112 | grid.circle(x = x, y = y,r=per.mat[i,j]/2 * max(unit.c(width, height)),gp = gpar(fill = col_fun(exp.mat[i, j]), col = NA))}, 113 | column_names_side = "top",row_names_side = "right", 114 | row_split = row_split,column_split = col_split, 115 | row_gap = unit(3, "mm"),column_gap =unit(3, "mm"), 116 | left_annotation = ha, 117 | heatmap_legend_param=list(title = "Expression",legend_height=unit(3, "cm"))) 118 | dev.off() 119 | 120 | ###### heatmap cluster each group 121 | source(paste0(dir,"code_clean/Heat_Dot_split_group.R")) 122 | plot_ord2 <- c() 123 | for(i in plot_ord){ 124 | for(j in c("TN","MPR","NMPR")){ 125 | plot_ord2 <- c(plot_ord2,paste(i,j,sep="_")) 126 | } 127 | } 128 | data.plot2 <- Heat_Dot_split_group(object=RNA,features=features,group.by="T_cluster_annotation",split.by="Group") 129 | exp.mat2 <- data.plot2 %>% select(features.plot,id,avg.exp.scaled) %>% spread(id,avg.exp.scaled) 130 | rownames(exp.mat2) <- exp.mat2$features.plot 131 | exp.mat2$features.plot <- NULL 132 | exp.mat2 <- exp.mat2[,plot_ord2] 133 | per.mat2 <- data.plot2 %>% select(features.plot,id,pct.exp) %>% spread(id,pct.exp) 134 | rownames(per.mat2) <- per.mat2$features.plot 135 | per.mat2$features.plot <- NULL 136 | per.mat2 <- per.mat2[,plot_ord2]/100 137 | 138 | library(ComplexHeatmap) 139 | library(circlize) ## color 140 | # set color gradient 141 | col_fun <- colorRamp2(c(-1.5, 0, 2.5), c("#118ab2", "#fdffb6", "#e63946")) 142 | # left annotation 143 | annot = c("CD8/CD4","NK","Treg","Naive","Exhausted","Cytotoxic","Co-stimulatory","TRM","Chemokines","TFs","Proliferating") 144 | row_color=c("#e76f51","#ffafcc","#0077b6","#ddbea9","#00b4d8","#dc2f02","#2a9d8f","#57cc99","#b5838d","#8a5a44","#023047") 145 | 146 | ha = HeatmapAnnotation(df = data.frame(Marker=row_split),which = "row", 147 | col = list(Marker = c("CD8/CD4" = "#e76f51", "NK" = "#ffafcc","Treg"="#0077b6","Naive"="#ddbea9", 148 | "Exhausted"="#00b4d8","Cytotoxic"="#dc2f02","Co-stimulatory"="#fca311","TRM"="#57cc99","Chemokines"="#b5838d","TFs"="#8a5a44","Proliferating"="#023047"))) 149 | # top annotation 150 | ha_top = HeatmapAnnotation(df = data.frame(Group = rep(c("TN","MPR","NMPR"),length(unique(RNA$T_cluster_annotation)))), 151 | which = "column", 152 | col = list(Group=c("TN"="#228B22","MPR"="#FF4500","NMPR"="#757bc8"))) 153 | pdf(paste0(dir,"plot_out/T_maker_heat_group.pdf"),width = 16,height = 15) 154 | Heatmap(exp.mat2, col = col_fun,cluster_columns = F,cluster_rows = F, 155 | show_column_names = T,show_row_names = T,rect_gp=gpar(col="grey"), 156 | column_names_side = "top",row_names_side = "right", 157 | row_split = row_split, 158 | row_gap = unit(3, "mm"), 159 | left_annotation = ha,top_annotation =ha_top, 160 | heatmap_legend_param=list(title = "Expression",legend_height=unit(3, "cm"))) 161 | dev.off() 162 | 163 | pdf(paste0(dir,"plot_out/T_maker_heat2_group.pdf"),width = 16,height = 15) 164 | Heatmap(exp.mat2, col = col_fun,cluster_columns = F,cluster_rows = F, 165 | show_column_names = T,show_row_names = T,rect_gp=gpar(type = "none"), 166 | cell_fun = function(j, i, x, y, width, height, fil){ 167 | grid.rect(x = x, y = y, width = width, height = height,gp = gpar(col = "grey", fill = NA)) 168 | grid.circle(x = x, y = y,r=per.mat2[i,j]/2 * max(unit.c(width, height)),gp = gpar(fill = col_fun(exp.mat2[i, j]), col = NA))}, 169 | column_names_side = "top",row_names_side = "right", 170 | row_split = row_split, 171 | row_gap = unit(3, "mm"), 172 | left_annotation = ha,top_annotation =ha_top, 173 | heatmap_legend_param=list(title = "Expression",legend_height=unit(3, "cm"))) 174 | dev.off() 175 | 176 | ###Calculate cell fractions in different response groups 177 | source(paste0(dir,"code_clean/Cal_fraction.R")) 178 | tab.1 <- cal_fraction(RNA,"T_cluster_annotation") 179 | tab.1$cell <- factor(tab.1$cell, levels =c("NK_FCGR3A","NK_KLRD1","CD8_IL7R","CD8_GZMK","CD8_GZMB","CD8_HAVCR2","CD8_STMN1","T_MKI67","CD4_IL7R","CD4_CCR7","CD4_MAF", "CD4_CXCL13","Treg_SELL","Treg_CTLA4")) 180 | Group_color_panel <- c("TN"="#228B22","MPR"="#FF4500","NMPR"="#757bc8") 181 | # plot 182 | p1<- ggplot(tab.1, aes(x=Group, y=Estimate)) + 183 | geom_bar(stat = "identity", aes(fill=Group)) + 184 | scale_fill_manual(name = "Group", values = Group_color_panel) + facet_grid(~ cell) + 185 | theme_bw() + 186 | theme(axis.text.x = element_text(size=15,angle = 45, hjust=1, vjust=1), axis.text.y = element_text(size=15),axis.ticks.length = unit(0.2,"cm"),legend.position= "bottom") + 187 | xlab("") + ylab("Cellular fraction (%) of all T/NK cell") + 188 | theme(axis.title.y=element_text(size=16),strip.text = element_text(size = 13))+ 189 | geom_errorbar(aes(ymin=lower, ymax=upper), width=.2,position=position_dodge(0.05)) 190 | # Save plot 191 | ggsave(p1, filename = paste0(dir,"plot_out/T_across_treatment.pdf"),width = 18, height = 6) 192 | 193 | source(paste0(dir,"code_clean/Cal_fraction_patients.R")) 194 | tab.2 <- cal_fraction_patients(RNA,"T_cluster_annotation") 195 | tab.2$cell <- gsub("\\.[0-9]{1,}","",rownames(tab.2)) 196 | tab.2$cell <- factor(tab.2$cell, levels =c("NK_FCGR3A","NK_KLRD1","CD8_IL7R","CD8_GZMK","CD8_GZMB","CD8_HAVCR2","CD8_STMN1","T_MKI67","CD4_IL7R","CD4_CCR7","CD4_MAF","CD4_CXCL13","Treg_SELL","Treg_CTLA4")) 197 | #colnames(tab.2)[4] <- "Patient_ID" 198 | clin_info <- read.csv("clin_info.csv",header=T,stringsAsFactors=F) 199 | sample_info <- clin_info[,c("Patient_ID","Group")] 200 | table.plot <- merge(tab.2,sample_info,by="Patient_ID") 201 | table.plot$Group <- factor(table.plot$Group,levels=c("TN","MPR","NMPR")) 202 | 203 | pdf(paste0(dir,"plot_out/T_across_treatment3.pdf"),width = 18,height = 7) 204 | p1+geom_point(data=table.plot,aes(x=Group, y=Estimate,color=Patient_ID),size = 1.5) 205 | dev.off() 206 | 207 | # boxplot 208 | p2<- ggplot(table.plot) + 209 | geom_boxplot(aes(x=cell, y=Estimate,color=Group,outlier.colour = NA),width = 0.6,position=position_dodge(0.75))+ 210 | geom_jitter(aes(x=cell, y=Estimate,color=Group),size = 1.5, position = position_jitterdodge())+ 211 | scale_color_manual(name="Group",values = Group_color_panel)+ 212 | theme_bw() + 213 | theme(axis.text.x = element_text(size=13,angle = 45, hjust=1, vjust=1), axis.text.y = element_text(size=13),axis.ticks.length = unit(0.2,"cm"),legend.position= "bottom") + 214 | xlab("") + ylab("Cellular fraction (%) of T/NK cells") + 215 | theme(axis.title.y=element_text(size=15),strip.text = element_text(size = 13)) 216 | # Save plot 217 | ggsave(p2, filename = paste(dir,"plot_out/T_across_treatment2.pdf", sep=""),width = 18, height = 6) 218 | 219 | library(ggsignif) 220 | compaired <- list(c("TN","MPR"),c("TN","NMPR"),c("MPR","NMPR")) 221 | ps <- list() 222 | for(i in unique(table.plot$cell)){ 223 | ps[[i]]<- ggplot(subset(table.plot,cell==i),aes(x=Group, y=Estimate,color=Group)) + 224 | geom_boxplot(width = 0.5,position=position_dodge(0.75),outlier.colour = NA)+ 225 | geom_jitter(size = 1.5, position = position_jitterdodge())+ 226 | scale_color_manual(name="Group",values = Group_color_panel)+ 227 | theme_bw() + 228 | theme(axis.text.x = element_text(size=13,angle = 45, hjust=1, vjust=1), axis.text.y = element_text(size=13),axis.ticks.length = unit(0.2,"cm")) + 229 | labs(x="",y="Cellular fraction (%) of all cells",title=i) + 230 | theme(axis.title.y=element_text(size=15),strip.text = element_text(size = 13))+ 231 | geom_signif(comparisons = compaired,step_increase = 0.1,map_signif_level = F,test = wilcox.test) 232 | } 233 | 234 | pdf(paste0(dir,"plot_out/T_fraction_each_cell.pdf"),height=5,width=4) 235 | for(i in unique(table.plot$cell)){print(ps[[i]])} 236 | dev.off() 237 | 238 | 239 | saveRDS(RNA,"Tcell.rds") 240 | 241 | ####### CD8 T trajactory analysis ###### 242 | library(monocle) 243 | # select CD8 T 244 | CD8_tj<-subset(RNA, T_cluster_annotation %in% c("CD8_IL7R","CD8_GZMK","CD8_GZMB","CD8_HAVCR2")) 245 | # Extract data, phenotype data, and feature data from the SeuratObject 246 | data <- as(as.matrix(CD8_tj@assays$RNA@counts), 'sparseMatrix') 247 | pd <- new('AnnotatedDataFrame', data = CD8_tj@meta.data) 248 | fData <- data.frame(gene_short_name = row.names(data), row.names = row.names(data)) 249 | fd <- new('AnnotatedDataFrame', data = fData) 250 | # Construct monocle cds 251 | monocle_cds <- newCellDataSet(data, 252 | phenoData = pd, 253 | featureData = fd, 254 | lowerDetectionLimit = 0.5, 255 | expressionFamily = negbinomial.size()) 256 | 257 | monocle_cds <- estimateSizeFactors(monocle_cds) 258 | monocle_cds <- estimateDispersions(monocle_cds) 259 | ## 260 | clustering_DEG_genes <- differentialGeneTest(monocle_cds, fullModelFormulaStr = '~T_cluster_annotation', cores = 20) 261 | write.csv(clustering_DEG_genes,"data_out/T8_monocle_DEG.csv",quote=F) 262 | ordering_genes <- row.names (subset(clustering_DEG_genes, qval < 0.01)) 263 | gene_id <- row.names(clustering_DEG_genes)[order(clustering_DEG_genes$qval)][1:1000] 264 | ## 265 | monocle_cds <- setOrderingFilter(monocle_cds, gene_id) 266 | monocle_cds <- reduceDimension( 267 | monocle_cds, 268 | max_components = 2, 269 | method = 'DDRTree') 270 | monocle_cds <- orderCells(monocle_cds) 271 | ClusterName_color_panel <- c("CD8_GZMK" = "#f28482", "CD8_GZMB" = "#06d6a0", 272 | "CD8_IL7R" = "#84a59d","CD8_HAVCR2"="#118ab2") 273 | library(cowplot) 274 | pdf(paste0(dir,"plot_out/T8_Pseudotime2.pdf"),width = 8,height = 5) 275 | plot_cell_trajectory(monocle_cds, color_by = "Pseudotime",show_branch_points=F)+theme_cowplot() 276 | plot_cell_trajectory(monocle_cds, color_by = "T_cluster_annotation",cell_size = 1,show_branch_points=F)+theme_cowplot()+ 277 | scale_color_manual(name = "", values = ClusterName_color_panel)+guides(color = guide_legend(override.aes = list(size=5)))+ 278 | theme(axis.text.y = element_text(size=15),axis.text.x = element_text(size=15),axis.title.y = element_text(size=18),axis.title.x = element_text(size=18),axis.ticks.length = unit(0.2,"cm")) 279 | dev.off() 280 | 281 | saveRDS(monocle_cds,"./data_out/T8_monocle2.rds") 282 | 283 | ######## CD8 Activating_Exhausted plot 284 | # select CD8 T 285 | CD8_T <-subset(RNA, T_cluster_annotation %in% c("CD8_IL7R","CD8_GZMK","CD8_GZMB","CD8_HAVCR2","CD8_STMN1")) 286 | # define feature 287 | act_features <- list(c("GZMA","GZMB","GZMK","GNLY","IFNG","PRF1","NKG7")) 288 | exh_features <- list(c("LAG3","TIGIT","PDCD1","HAVCR2","CTLA4","LAYN","ENTPD1")) 289 | # calculate score 290 | CD8_T <- AddModuleScore(object=CD8_T,features=act_features,name="Cytotoxic_score") 291 | CD8_T <- AddModuleScore(object=CD8_T,features=exh_features,name="Exhausted_score") 292 | # plot 293 | data.plot <- CD8_T@meta.data[,c("Group","T_cluster_annotation","Cytotoxic_score1","Exhausted_score1")] 294 | library(ggsignif) 295 | library(cowplot) 296 | Group_color_panel <- c("TN"="#228B22","MPR"="#FF4500","NMPR"="#757bc8") 297 | compaired <- list(c("TN","MPR"),c("TN","NMPR"),c("MPR","NMPR")) 298 | p <- ggplot(data = data.plot,aes(x=factor(Group,levels=c("TN","MPR","NMPR")),y=Cytotoxic_score1,fill=Group))+ 299 | geom_violin(color="white")+ 300 | geom_boxplot(width=0.1,position=position_dodge(0.9),fill="white")+theme_cowplot()+ 301 | scale_fill_manual(name="Group",values = Group_color_panel)+ 302 | theme(axis.text.x = element_text(size=10,angle = 45, hjust=1, vjust=1), axis.text.y = element_text(size=10),axis.ticks.length = unit(0.2,"cm"))+ 303 | NoLegend()+labs(x="",y="Cytotoxic score")+geom_signif(comparisons = compaired,step_increase = 0.1,map_signif_level = F,test = wilcox.test) 304 | ggsave(paste0(dir,"plot_out/T8_cyto_across_treatment.pdf"),p,width =3,height =5) 305 | p <- ggplot(data = data.plot,aes(x=factor(Group,levels=c("TN","MPR","NMPR")),y=Exhausted_score1,fill=Group))+ 306 | geom_violin(color="white")+ 307 | geom_boxplot(width=0.1,position=position_dodge(0.9),fill="white")+theme_cowplot()+ 308 | scale_fill_manual(name="Group",values = Group_color_panel)+ 309 | theme(axis.text.x = element_text(size=10,angle = 45, hjust=1, vjust=1), axis.text.y = element_text(size=10),axis.ticks.length = unit(0.2,"cm"))+ 310 | NoLegend()+labs(x="",y="Exhausted score")+geom_signif(comparisons = compaired,step_increase = 0.1,map_signif_level = F,test = wilcox.test) 311 | ggsave(paste0(dir,"plot_out/T8_exhau_across_treatment.pdf"),p,width =3,height =5) 312 | #### each cluster 313 | pc <- ggplot(data = data.plot,aes(x=factor(Group,levels=c("TN","MPR","NMPR")),y=Cytotoxic_score1,fill=Group))+ 314 | geom_violin(color="white")+ 315 | geom_boxplot(width=0.1,position=position_dodge(0.9),fill="white")+facet_grid(~T_cluster_annotation) +theme_bw()+ 316 | scale_fill_manual(name="Group",values = Group_color_panel)+ 317 | theme(axis.text.x = element_text(size=10,angle = 45, hjust=1, vjust=1), axis.text.y = element_text(size=10),axis.ticks.length = unit(0.2,"cm"),legend.position="bottom")+ 318 | labs(x="",y="Cytotoxic score")+geom_signif(comparisons = compaired,step_increase = 0.1,map_signif_level = F,test = wilcox.test) 319 | ggsave(paste0(dir,"plot_out/T8_cyto_cluster_across_treatment.pdf"),pc,width =10,height =5) 320 | pe <- ggplot(data = data.plot,aes(x=factor(Group,levels=c("TN","MPR","NMPR")),y=Exhausted_score1,fill=Group))+ 321 | geom_violin(color="white")+ 322 | geom_boxplot(width=0.1,position=position_dodge(0.9),fill="white")+facet_grid(~T_cluster_annotation) +theme_bw()+ 323 | scale_fill_manual(name="Group",values = Group_color_panel)+ 324 | theme(axis.text.x = element_text(size=10,angle = 45, hjust=1, vjust=1), axis.text.y = element_text(size=10),axis.ticks.length = unit(0.2,"cm"),legend.position="bottom")+ 325 | labs(x="",y="Exhausted score")+geom_signif(comparisons = compaired,step_increase = 0.1,map_signif_level = F,test = wilcox.test) 326 | ggsave(paste0(dir,"plot_out/T8_exhau_cluster_across_treatment.pdf"),pe,width =10,height =5) 327 | 328 | ######## NK Activating_Exhausted plot 329 | # select NK T 330 | NK_T <-subset(RNA, idents = c(6,9)) 331 | # calculate score 332 | NK_T <- AddModuleScore(object=NK_T,features=act_features,name="Cytotoxic_score") 333 | NK_T <- AddModuleScore(object=NK_T,features=exh_features,name="Exhausted_score") 334 | # plot 335 | data.plot <- NK_T@meta.data[,c("Group","T_cluster_annotation","Cytotoxic_score1","Exhausted_score1")] 336 | library(ggsignif) 337 | compaired <- list(c("TN","MPR"),c("TN","NMPR"),c("MPR","NMPR")) 338 | p <- ggplot(data = data.plot,aes(x=factor(Group,levels=c("TN","MPR","NMPR")),y=Cytotoxic_score1,fill=Group))+ 339 | geom_violin(color="white")+ 340 | geom_boxplot(width=0.1,position=position_dodge(0.9),fill="white")+theme_cowplot()+ 341 | scale_fill_manual(name="Group",values = Group_color_panel)+ 342 | theme(axis.text.x = element_text(size=10,angle = 45, hjust=1, vjust=1), axis.text.y = element_text(size=10),axis.ticks.length = unit(0.2,"cm"))+ 343 | NoLegend()+labs(x="",y="Cytotoxic score")+geom_signif(comparisons = compaired,step_increase = 0.1,map_signif_level = F,test = wilcox.test) 344 | ggsave(paste0(dir,"plot_out/NK_cyto_across_treatment.pdf"),p,width =3,height =5) 345 | p <- ggplot(data = data.plot,aes(x=factor(Group,levels=c("TN","MPR","NMPR")),y=Exhausted_score1,fill=Group))+ 346 | geom_violin(color="white")+ 347 | geom_boxplot(width=0.1,position=position_dodge(0.9),fill="white")+theme_cowplot()+ 348 | scale_fill_manual(name="Group",values = Group_color_panel)+ 349 | theme(axis.text.x = element_text(size=10,angle = 45, hjust=1, vjust=1), axis.text.y = element_text(size=10),axis.ticks.length = unit(0.2,"cm"))+ 350 | NoLegend()+labs(x="",y="Exhausted score")+geom_signif(comparisons = compaired,step_increase = 0.1,map_signif_level = F,test = wilcox.test) 351 | ggsave(paste0(dir,"plot_out/NK_exhau_across_treatment.pdf"),p,width =3,height =5) 352 | #### each cluster 353 | pc <- ggplot(data = data.plot,aes(x=factor(Group,levels=c("TN","MPR","NMPR")),y=Cytotoxic_score1,fill=Group))+ 354 | geom_violin(color="white")+ 355 | geom_boxplot(width=0.1,position=position_dodge(0.9),fill="white")+facet_grid(~T_cluster_annotation) +theme_bw()+ 356 | scale_fill_manual(name="Group",values = Group_color_panel)+ 357 | theme(axis.text.x = element_text(size=10,angle = 45, hjust=1, vjust=1), axis.text.y = element_text(size=10),axis.ticks.length = unit(0.2,"cm"),legend.position="bottom")+ 358 | labs(x="",y="Cytotoxic score")+geom_signif(comparisons = compaired,step_increase = 0.1,map_signif_level = F,test = wilcox.test) 359 | ggsave(paste0(dir,"plot_out/NK_cyto_cluster_across_treatment.pdf"),pc,width =4.34,height =5) 360 | pe <- ggplot(data = data.plot,aes(x=factor(Group,levels=c("TN","MPR","NMPR")),y=Exhausted_score1,fill=Group))+ 361 | geom_violin(color="white")+ 362 | geom_boxplot(width=0.1,position=position_dodge(0.9),fill="white")+facet_grid(~T_cluster_annotation) +theme_bw()+ 363 | scale_fill_manual(name="Group",values = Group_color_panel)+ 364 | theme(axis.text.x = element_text(size=10,angle = 45, hjust=1, vjust=1), axis.text.y = element_text(size=10),axis.ticks.length = unit(0.2,"cm"),legend.position="bottom")+ 365 | labs(x="",y="Exhausted score")+geom_signif(comparisons = compaired,step_increase = 0.1,map_signif_level = F,test = wilcox.test) 366 | ggsave(paste0(dir,"plot_out/NK_exhau_cluster_across_treatment.pdf"),pe,width =4.34,height =5) 367 | 368 | #### memory T analysis 369 | Tm <- subset(RNA,T_cluster_annotation=="CD8_IL7R") 370 | ## DEG after therapy 371 | Idents(Tm) <- Tm@meta.data$Group 372 | DEG<- FindAllMarkers(object = Tm, only.pos = F, logfc.threshold = 0,min.pct = 0.25) 373 | DEG <- subset(DEG,cluster=="TN") 374 | write.csv(DEG, file=paste0(dir,"data_out/T8_mem_DEG.csv"),quote=F) 375 | #vocano plot 376 | library(cowplot) 377 | library(ggrepel) 378 | label_gene <- c("NR4A1","NR4A2","NR4A3","TENT5C","CD8A","CCL5","GZMK","GZMA","CD74","HLA-DRA") 379 | DEG$avg_logFC <- 0-DEG$avg_logFC 380 | DEG$group <- ifelse(abs(DEG$avg_logFC) >= 0.3 & DEG$p_val_adj < 0.05,ifelse(DEG$avg_logFC >= 0.3,"Up","Down"),"Not") 381 | DEG$label=NA 382 | ord=match(label_gene,DEG$gene) 383 | for(i in 1:length(ord)){DEG$label[ord[i]]=label_gene[i]} 384 | gp <- ggplot(DEG) + 385 | geom_point(aes(x = avg_logFC, y = -log10(p_val_adj),color = factor(group)), size = 1, alpha = 0.8, na.rm = TRUE) + # add gene points 386 | xlab(expression(log[2]("FC"))) + # x-axis label 387 | ylab(expression(-log[10]("FDR"))) + # y-axis label 388 | scale_color_manual(name = "", values = c("red", "blue", "grey"), limits = c("Up", "Down", "Not"))+ 389 | geom_text_repel(aes(x = avg_logFC, y = -log10(p_val_adj),label=label), 390 | arrow = arrow(length=unit(0.01, "npc")), 391 | box.padding=unit(0.5, "lines"), point.padding=unit(0.5, "lines"), 392 | segment.color = "black",show.legend = FALSE)+ 393 | theme_cowplot() + 394 | NoLegend() 395 | ggsave(paste0(dir,"plot_out/T8_mem_DEG_vocano.pdf"),gp,width =5,height =6) 396 | 397 | ### Exhausted score in Treg 398 | # select T3, T12 399 | RNA_Treg <-subset(RNA, idents = c(3,12)) 400 | # calculate score 401 | RNA_Treg <- AddModuleScore(object=RNA_Treg,features=act_features,name="Cytotoxic_score") 402 | RNA_Treg <- AddModuleScore(object=RNA_Treg,features=exh_features,name="Exhausted_score") 403 | # plot 404 | data.plot <- RNA_Treg@meta.data[,c("Group","T_cluster_annotation","Cytotoxic_score1","Exhausted_score1")] 405 | library(ggsignif) 406 | compaired <- list(c("TN","MPR"),c("TN","NMPR"),c("MPR","NMPR")) 407 | p <- ggplot(data = data.plot,aes(x=factor(Group,levels=c("TN","MPR","NMPR")),y=Exhausted_score1,fill=Group))+ 408 | geom_violin(color="white")+ 409 | geom_boxplot(width=0.1,position=position_dodge(0.9),fill="white")+theme_cowplot()+ 410 | scale_fill_manual(name="Group",values = Group_color_panel)+ 411 | theme(axis.text.x = element_text(size=10,angle = 45, hjust=1, vjust=1), axis.text.y = element_text(size=10),axis.ticks.length = unit(0.2,"cm"))+ 412 | NoLegend()+labs(x="",y="Exhausted score")+geom_signif(comparisons = compaired,step_increase = 0.1,map_signif_level = F,test = wilcox.test) 413 | ggsave(paste0(dir,"plot_out/Treg_exhau_across_treatment.pdf"),p,width =3,height =5) 414 | pe <- ggplot(data = data.plot,aes(x=factor(Group,levels=c("TN","MPR","NMPR")),y=Exhausted_score1,fill=Group))+ 415 | geom_violin(color="white")+ 416 | geom_boxplot(width=0.1,position=position_dodge(0.9),fill="white")+facet_grid(~T_cluster_annotation) +theme_bw()+ 417 | scale_fill_manual(name="Group",values = Group_color_panel)+ 418 | theme(axis.text.x = element_text(size=10,angle = 45, hjust=1, vjust=1), axis.text.y = element_text(size=10),axis.ticks.length = unit(0.2,"cm"),legend.position="bottom")+ 419 | labs(x="",y="Exhausted score")+geom_signif(comparisons = compaired,step_increase = 0.1,map_signif_level = F,test = wilcox.test) 420 | ggsave(paste0(dir,"plot_out/Treg_exhau_cluster_across_treatment.pdf"),pe,width =4.34,height =5) 421 | 422 | #### CD8_HAVCR2 analysis 423 | T7 <- subset(RNA,idents=7) 424 | p <- VlnPlot(T7,features=c("HAVCR2","TIGIT","GZMA","GZMB","NKG7","GNLY"), pt.size = 0,group.by="Group") 425 | ggsave(paste0(dir,"plot_out/Tm_across_treatment.pdf"),p,width =5,height =3) 426 | ## DEG after therapy 427 | Idents(T7) <- T7@meta.data$Group 428 | DEG<- FindAllMarkers(object = T7, only.pos = F, logfc.threshold = 0,min.pct = 0.25) 429 | DEG <- subset(DEG,cluster=="TN") 430 | write.csv(DEG, file=paste0(dir,"data_out/T7_DEG.csv"),quote=F) 431 | #vocano plot 432 | library(cowplot) 433 | library(ggrepel) 434 | label_gene <- c("TNF","NR4A2","NR4A3","IL7R","LAG3","TIGIT","GZMA","GZMB","NKG7","GNLY","CXCL13","GZMH","PRF1") 435 | DEG$avg_logFC <- 0-DEG$avg_logFC 436 | DEG$group <- ifelse(abs(DEG$avg_logFC) >= 0.3 & DEG$p_val_adj < 0.05,ifelse(DEG$avg_logFC >= 0.3,"Up","Down"),"Not") 437 | DEG$label=NA 438 | ord=match(label_gene,DEG$gene) 439 | for(i in 1:length(ord)){DEG$label[ord[i]]=label_gene[i]} 440 | gp <- ggplot(DEG) + 441 | geom_point(aes(x = avg_logFC, y = -log10(p_val_adj),color = factor(group)), size = 1, alpha = 0.8, na.rm = TRUE) + # add gene points 442 | xlab(expression(log[2]("FC"))) + # x-axis label 443 | ylab(expression(-log[10]("FDR"))) + # y-axis label 444 | scale_color_manual(name = "", values = c("red", "blue", "grey"), limits = c("Up", "Down", "Not"))+ 445 | geom_text_repel(aes(x = avg_logFC, y = -log10(p_val_adj),label=label), 446 | arrow = arrow(length=unit(0.01, "npc")), 447 | box.padding=unit(0.5, "lines"), point.padding=unit(0.5, "lines"), 448 | segment.color = "black",show.legend = FALSE)+ 449 | theme_cowplot() + 450 | NoLegend() 451 | ggsave(paste0(dir,"plot_out/T7_DEG_vocano.pdf"),gp,width =5,height =6) 452 | 453 | ### CD8_IL7R density 454 | T8_cds <- readRDS("./data_out/T8_monocle2.rds") 455 | T8mem <- subset(RNA,T_cluster_annotation=="CD8_IL7R") 456 | dense_cds <- T8_cds[,colnames(T8mem)] 457 | plotdf=pData(dense_cds) 458 | plotdf$Pseudotime <- 15 - plotdf$Pseudotime 459 | plotdf$Pseudotime[plotdf$Pseudotime > 10] <- 8 460 | plotdf$Group <- factor(plotdf$Group,levels=c("NMPR","MPR","TN")) 461 | library(ggridges) 462 | ggplot(plotdf, aes(x=Pseudotime,y=Group,fill=Group))+ 463 | geom_density_ridges(scale=1) + 464 | geom_vline(xintercept = c(3.2,6),linetype=2)+ 465 | scale_y_discrete("")+ 466 | theme_minimal()+ 467 | theme( 468 | panel.grid = element_blank() 469 | ) 470 | ggsave("plot_out/T8mem_pseudo_dense.pdf",width = 8,height = 3) 471 | ## fraction 472 | plotdf$phase <- ifelse(plotdf$Pseudotime > 3.2, 473 | ifelse(plotdf$Pseudotime > 6,"phase1","phase2"),"phase0") 474 | table(plotdf$phase,plotdf$Group) 475 | 476 | ### heatmap 477 | plotdf$DEG <- ifelse(plotdf$Pseudotime > 3.2,"trans","naive") 478 | T8mem@meta.data$DEG <- plotdf$DEG 479 | Idents(T8mem) <- T8mem@meta.data$DEG 480 | markers <- FindAllMarkers(object = T8mem, only.pos = TRUE, min.pct = 0.25, thresh.use = 0.25) 481 | write.csv(markers, file=paste0(dir,"data_out/T8mem_pseudo_DEG.csv"),quote=F) 482 | 483 | plot_gene <- c("NR4A1","NR4A2","NR4A3","FOSB","JUND","TENT5C","CCL5","GZMA","NKG7","GNLY","CD74","HLA-DRA","HLA-DPB1") 484 | heat_cds <- dense_cds[plot_gene,] 485 | plot_pseudotime_heatmap(heat_cds, 486 | num_clusters = 2, 487 | cores = 1, 488 | show_rownames = T) 489 | 490 | 491 | -------------------------------------------------------------------------------- /06.1_PMo_Cancer_CellphoneDB.R: -------------------------------------------------------------------------------- 1 | 2 | library(Seurat) 3 | library(future) 4 | plan("multiprocess", workers = 8) 5 | options(future.globals.maxSize = 10*1024^3) 6 | 7 | dir <- "./" 8 | 9 | ## take PMo 10 | RNA <- readRDS("MF.rds") 11 | PMo <- subset(RNA,idents=7) 12 | PMo_MPR <- subset(RNA,Group=="MPR") 13 | PMo_count <- as.matrix(PMo_MPR@assays$RNA@data) 14 | PMo_meta <- data.frame(Cell=rownames(PMo_MPR@meta.data), celltype = "PMo") 15 | 16 | ## take Cancerthelium cell 17 | RNA <- readRDS("epithelium.rds") 18 | RNA_mag <- subset(RNA,TC.cluster %in% c(0,1,3,4,7)) 19 | Cancer <- subset(RNA_mag,Group=="MPR") 20 | Cancer_count <- as.matrix(Cancer@assays$RNA@data) 21 | Cancer_meta <- data.frame(Cell=rownames(Cancer@meta.data), celltype = "Cancer") 22 | 23 | count <- merge(PMo_count,Cancer_count,by=0) 24 | meta_data <- rbind(PMo_meta,Cancer_meta) 25 | 26 | write.table(count, 'cellphonedb/PMo_Cancer/PMo_Cancer_count.txt', sep='\t', quote=F, row.names=F) 27 | write.table(meta_data, 'cellphonedb/PMo_Cancer/PMo_Cancer_meta.txt', sep='\t', quote=F, row.names=F) 28 | 29 | ################# cmd code ##################### 30 | cellphonedb method statistical_analysis --counts-data=gene_name --threads=20 --output-path=cellphonedb/PMo_Cancer/ --pvalue 0.01 cellphonedb/PMo_Cancer/PMo_Cancer_meta.txt cellphonedb/PMo_Cancer/PMo_Cancer_count.txt 31 | cd cellphonedb/PMo_Cancer/ 32 | cellphonedb plot dot_plot --means-path ./means.txt --pvalues-path ./pvalues.txt --output-path ./ 33 | cellphonedb plot heatmap_plot PMo_Cancer_meta.txt --pvalues-path ./pvalues.txt --output-path ./ 34 | 35 | ## pick some L-R pair to plot 36 | library(dplyr) 37 | library(ggplot2) 38 | plot_dir <- paste0(dir,"cellphonedb/PMo_Cancer/") 39 | mypvals <- read.delim(paste0(plot_dir,"pvalues.txt"), check.names = FALSE) 40 | mymeans <- read.delim(paste0(plot_dir,"significant_means.txt"), check.names = FALSE) 41 | # select cell pair 42 | keep <- c(which(mypvals$`PMo|Cancer` < 0.01),which(mypvals$`Cancer|PMo` < 0.01)) 43 | mypvals_keep <- mypvals[keep,] 44 | mypair <- intersect(mypvals_keep$interacting_pair,mymeans$interacting_pair) 45 | # pick out chemokines and so on 46 | chemokines <- grep("^CXC|CCL|CCR|CX3|XCL|XCR", mypair,value = T) 47 | write.table(as.data.frame(chemokines),paste0(plot_dir,"PMo_Cancer_chemokines.txt"),col.names=F,quote=F,row.names=F) 48 | costimulatory <- grep("CD86|CD80|CD48|LILRB2|LILRB4|TNF|CD2|ICAM|SLAM|LT[AB]|NECTIN2|CD40|CD70|CD27|CD28|CD58|TSLP|PVR|CD44|CD55|CD[1-9]", 49 | mypair,value = T) 50 | write.table(as.data.frame(costimulatory),paste0(plot_dir,"PMo_Cancer_costimulatory.txt"),col.names=F,quote=F,row.names=F) 51 | coinhibitory <- grep("SIRP|CD47|ICOS|TIGIT|CTLA4|PDCD1|CD274|LAG3|HAVCR|VSIR|ENTPD1", 52 | mypair,value = T) 53 | write.table(as.data.frame(coinhibitory),paste0(plot_dir,"PMo_Cancer_coinhibitory.txt"),col.names=F,quote=F,row.names=F) 54 | All_LR <- c(chemokines,costimulatory,coinhibitory) 55 | write.table(as.data.frame(All_LR),paste0(plot_dir,"PMo_Cancer_All_LR.txt"),col.names=F,quote=F,row.names=F) 56 | 57 | #### plot the selected L-R 58 | cd cellphonedb/PMo_Cancer/ 59 | cellphonedb plot dot_plot --means-path ./means.txt --pvalues-path ./pvalues.txt --output-path ./ --rows PMo_Cancer_chemokines.txt --columns pair_plot.txt --output-name PMo_Cancer_chemokines.pdf 60 | cellphonedb plot dot_plot --means-path ./means.txt --pvalues-path ./pvalues.txt --output-path ./ --rows PMo_Cancer_costimulatory.txt --columns pair_plot.txt --output-name PMo_Cancer_costimulatory.pdf 61 | cellphonedb plot dot_plot --means-path ./means.txt --pvalues-path ./pvalues.txt --output-path ./ --rows PMo_Cancer_coinhibitory.txt --columns pair_plot.txt --output-name PMo_Cancer_coinhibitory.pdf 62 | cellphonedb plot dot_plot --means-path ./means.txt --pvalues-path ./pvalues.txt --output-path ./ --rows PMo_Cancer_All_LR.txt --columns pair_plot.txt --output-name PMo_Cancer_All_LR.pdf 63 | 64 | 65 | # plot 66 | pldf %>% filter(means >1) %>% 67 | ggplot(aes(CC.x,interacting_pair.x) )+ 68 | geom_point(aes(color=means,size=-log10(pvals)) ) + 69 | scale_size_continuous(range = c(1,3))+ 70 | scale_color_gradient2(high="red",mid = "yellow",low ="darkblue",midpoint = 2)+ theme_bw()+ 71 | theme(axis.text.x = element_text(angle = -45,hjust = -0.1,vjust = 0.8)) 72 | -------------------------------------------------------------------------------- /06.2_DC_Cancer_CellphoneDB.R: -------------------------------------------------------------------------------- 1 | 2 | library(Seurat) 3 | 4 | dir <- "./" 5 | 6 | ## take cDC2 cell 7 | MF <- readRDS("MF.rds") 8 | DC <- subset(MF,idents=c(5)) 9 | DC_count <- as.matrix(DC@assays$RNA@data) 10 | DC_meta <- data.frame(Cell=rownames(DC@meta.data), celltype = "cDC2") 11 | 12 | ## take Cancerthelium cell 13 | RNA_mag <- readRDS("Epi_mag.rds") 14 | Cancer <- subset(RNA_mag,Group=="MPR") 15 | Cancer_count <- as.matrix(Cancer@assays$RNA@data) 16 | Cancer_meta <- data.frame(Cell=rownames(Cancer@meta.data), celltype = "Tumor") 17 | 18 | count <- merge(DC_count,Cancer_count,by=0) 19 | meta_data <- rbind(DC_meta,Cancer_meta) 20 | 21 | write.table(count, 'cellphonedb/DC_Cancer/DC_Cancer_count.txt', sep='\t', quote=F, row.names=F) 22 | write.table(meta_data, 'cellphonedb/DC_Cancer/DC_Cancer_meta.txt', sep='\t', quote=F, row.names=F) 23 | 24 | ################# cmd code ##################### 25 | cellphonedb method statistical_analysis --counts-data=gene_name --threads=20 --output-path=cellphonedb/DC_Cancer/ --pvalue 0.01 cellphonedb/DC_Cancer/DC_Cancer_meta.txt cellphonedb/DC_Cancer/DC_Cancer_count.txt 26 | cd cellphonedb/DC_Cancer/ 27 | cellphonedb plot dot_plot --means-path ./means.txt --pvalues-path ./pvalues.txt --output-path ./ 28 | cellphonedb plot heatmap_plot DC_Cancer_meta.txt --pvalues-path ./pvalues.txt --output-path ./ 29 | 30 | ## pick some L-R pair to plot 31 | library(dplyr) 32 | library(ggplot2) 33 | plot_dir <- paste0(dir,"cellphonedb/DC_Cancer/") 34 | mypvals <- read.delim(paste0(plot_dir,"pvalues.txt"), check.names = FALSE) 35 | mymeans <- read.delim(paste0(plot_dir,"significant_means.txt"), check.names = FALSE) 36 | # select cell pair 37 | keep <- c(which(mypvals$`cDC2|Tumor` < 0.01),which(mypvals$`Tumor|cDC2` < 0.01)) 38 | mypvals_keep <- mypvals[keep,] 39 | mypair <- intersect(mypvals_keep$interacting_pair,mymeans$interacting_pair) 40 | # pick out chemokines and so on 41 | chemokines <- grep("^CXC|CCL|CCR|CX3|XCL|XCR", mypair,value = T) 42 | write.table(as.data.frame(chemokines),paste0(plot_dir,"DC_Cancer_chemokines.txt"),col.names=F,quote=F,row.names=F) 43 | costimulatory <- grep("CD86|CD80|CD48|LILRB2|LILRB4|TNF|CD2|ICAM|SLAM|LT[AB]|NECTIN2|CD40|CD70|CD27|CD28|CD58|TSLP|PVR|CD44|CD55|CD[1-9]", 44 | mypair,value = T) 45 | write.table(as.data.frame(costimulatory),paste0(plot_dir,"DC_Cancer_costimulatory.txt"),col.names=F,quote=F,row.names=F) 46 | coinhibitory <- grep("SIRP|CD47|ICOS|TIGIT|CTLA4|PDCD1|CD274|LAG3|HAVCR|VSIR|ENTPD1", 47 | mypair,value = T) 48 | write.table(as.data.frame(coinhibitory),paste0(plot_dir,"DC_Cancer_coinhibitory.txt"),col.names=F,quote=F,row.names=F) 49 | All_LR <- c(chemokines,costimulatory,coinhibitory) 50 | write.table(as.data.frame(All_LR),paste0(plot_dir,"DC_Cancer_All_LR.txt"),col.names=F,quote=F,row.names=F) 51 | 52 | #### plot the selected L-R 53 | cd cellphonedb/DC_Cancer/ 54 | cellphonedb plot dot_plot --means-path ./means.txt --pvalues-path ./pvalues.txt --output-path ./ --rows DC_Cancer_chemokines.txt --columns pair_plot.txt --output-name DC_Cancer_chemokines.pdf 55 | cellphonedb plot dot_plot --means-path ./means.txt --pvalues-path ./pvalues.txt --output-path ./ --rows DC_Cancer_costimulatory.txt --columns pair_plot.txt --output-name DC_Cancer_costimulatory.pdf 56 | cellphonedb plot dot_plot --means-path ./means.txt --pvalues-path ./pvalues.txt --output-path ./ --rows DC_Cancer_coinhibitory.txt --columns pair_plot.txt --output-name DC_Cancer_coinhibitory.pdf 57 | cellphonedb plot dot_plot --means-path ./means.txt --pvalues-path ./pvalues.txt --output-path ./ --rows DC_Cancer_All_LR.txt --columns pair_plot.txt --output-name DC_Cancer_All_LR.pdf 58 | cellphonedb plot dot_plot --means-path ./means.txt --pvalues-path ./pvalues.txt --output-path ./ --rows DC_Cancer_plot.txt --columns pair_plot.txt --output-name DC_Cancer_plot.pdf 59 | 60 | -------------------------------------------------------------------------------- /06_MF_analysis_new.R: -------------------------------------------------------------------------------- 1 | library(Seurat) 2 | library(ggplot2) 3 | library(tidyverse) 4 | 5 | dir <- "./" 6 | 7 | RNA <- readRDS("MF.rds") 8 | 9 | ###### Heatmap plot 10 | ## select MF 11 | MF <-subset(RNA, idents = c(0:4,6:8)) 12 | features=c("VCAN","FCN1","S100A8","S100A9","FABP4","MCEMP1","MARCO","C1QA","C1QB","GPNMB","APOE","SPP1","SELENOP","MRC1","TGFB1","CD163","CCL18","MSR1","VEGFA","TNF","CXCL9","CXCL10","CXCL11","HLA-DRA","HLA-DQA1","HLA-DPA1","CD74","MKI67","TOP2A") 13 | row_split = c(rep("Monocyte",4),rep("Alveolar macrophage",3),rep("Immunosuppressive",4),rep("M2 signature",8),rep("M1 signature",4),rep("MHC II",4),rep("Proliferating",2)) 14 | row_split = factor(row_split,levels = c("Monocyte","Alveolar macrophage","Immunosuppressive","M2 signature","M1 signature","MHC II","Proliferating")) 15 | ### plot heatmap 16 | source(paste0(dir,"code_clean/Heat_Dot_data.R")) 17 | ### set colnames order 18 | plot_ord <- c("Mono_CX3CR1","Mono_VEGFA","Macro_FABP4","Macro_SPP1", "Macro_CXCL9","Macro_SELENOP","Macro_MKI67","Macro_C1QA") 19 | 20 | data.plot <- Heat_Dot_data(object=MF,features=features,group.by="MF_cluster_annotation") 21 | exp.mat <- data.plot %>% select(features.plot,id,avg.exp.scaled) %>% spread(id,avg.exp.scaled) 22 | rownames(exp.mat) <- exp.mat$features.plot 23 | exp.mat$features.plot <- NULL 24 | exp.mat <- exp.mat[,plot_ord] 25 | per.mat <- data.plot %>% select(features.plot,id,pct.exp) %>% spread(id,pct.exp) 26 | rownames(per.mat) <- per.mat$features.plot 27 | per.mat$features.plot <- NULL 28 | per.mat <- per.mat[,plot_ord]/100 29 | 30 | ### plot heatmap 31 | library(ComplexHeatmap) 32 | library(circlize) ## color 33 | # set color gradient 34 | col_fun <- colorRamp2(c(-1.5, 0, 2.5), c("#118ab2", "#fdffb6", "#e63946")) 35 | # split heatmap 36 | col_split = c(rep("Monocyte",2),rep("Macrophage",6)) 37 | col_split =factor(col_split,levels = c("Monocyte","Macrophage")) 38 | # left annotation 39 | annot = c("Monocyte","Alveolar macrophage","Immunosuppressive","M2 signature","M1 signature","MHC II","Proliferating") 40 | 41 | ha = HeatmapAnnotation(df = data.frame(Marker=row_split),which = "row", 42 | col = list(Marker = c("Monocyte" = "#e76f51", "Alveolar macrophage"="#57cc99","Immunosuppressive"="#0077b6","M2 signature"="#ddbea9", 43 | "M1 signature"="#00b4d8","MHC II"="#dc2f02","Proliferating"="#8a5a44"))) 44 | pdf(paste0(dir,"plot_out/MF_maker_heat_new.pdf"),width = 6,height = 8) 45 | Heatmap(exp.mat, col = col_fun,cluster_columns = F,cluster_rows = F, 46 | show_column_names = T,show_row_names = T,rect_gp=gpar(col="grey"), 47 | column_names_side = "top",row_names_side = "right", 48 | row_split = row_split,column_split = col_split, 49 | row_gap = unit(3, "mm"),column_gap =unit(3, "mm"), 50 | left_annotation = ha, 51 | heatmap_legend_param=list(title = "Expression",legend_height=unit(3, "cm"))) 52 | dev.off() 53 | 54 | pdf(paste0(dir,"plot_out/MF_maker_heat_new2.pdf"),width = 6,height = 13) 55 | Heatmap(exp.mat, col = col_fun,cluster_columns = F,cluster_rows = F, 56 | show_column_names = T,show_row_names = T,rect_gp=gpar(type = "none"), 57 | cell_fun = function(j, i, x, y, width, height, fill){ 58 | grid.rect(x = x, y = y, width = width, height = height,gp = gpar(col = "grey", fill = NA)) 59 | grid.circle(x = x, y = y,r=per.mat[i,j]/2 * max(unit.c(width, height)),gp = gpar(fill = col_fun(exp.mat[i, j]), col = NA))}, 60 | column_names_side = "top",row_names_side = "right", 61 | row_split = row_split,column_split = col_split, 62 | row_gap = unit(3, "mm"),column_gap =unit(3, "mm"), 63 | left_annotation = ha, 64 | heatmap_legend_param=list(title = "Expression",legend_height=unit(3, "cm"))) 65 | dev.off() 66 | 67 | ###### Heatmap plot of Mono 68 | ## select Mono 69 | Mono <-subset(RNA, idents = c(0,7)) 70 | Mono_features=c("CD14","FCGR3A","CX3CR1","NR4A1","CD81","VEGFA","OLR1","FPR3","GPNMB","MRC1","CD163","MSR1","FN1","FCGR2B", 71 | "SELL","VNN2","S100A8","S100A9","S100A12","RIPOR2","POU2F2","CFP","MEGF9","MNDA") 72 | # data.features 73 | data.features <- FetchData(object = Mono, vars = Mono_features) 74 | data.features$id <- Mono$MF_cluster_annotation 75 | if (!is.factor(x = data.features$id)) { 76 | data.features$id <- factor(x = data.features$id) 77 | } 78 | id.levels <- levels(x = data.features$id) 79 | data.features$id <- as.vector(x = data.features$id) 80 | ## prepare data.plot 81 | data.exp <- NULL 82 | data.plot <- sapply(X = unique(x = data.features$id), FUN = function(ident) { 83 | data.use <- data.features[data.features$id == ident, 84 | 1:(ncol(x = data.features) - 1), drop = FALSE] 85 | avg.exp <- apply(X = data.use, MARGIN = 2, FUN = function(x) { 86 | return(mean(x = expm1(x = x))) 87 | }) 88 | if(!is.null(data.exp)){ 89 | data.exp <- cbind(data.exp,avg.exp) 90 | }else{data.exp <- avg.exp} 91 | return(data.exp) 92 | }) 93 | min(data.plot);max(data.plot) 94 | ## log 95 | data.plot <- log2(data.plot+1) 96 | min(data.plot);max(data.plot) 97 | 98 | ## per.exp 99 | source(paste0(dir,"code_clean/Heat_Dot_data.R")) 100 | exp.plot <- Heat_Dot_data(object=Mono,features=Mono_features,group.by="MF_cluster_annotation") 101 | exp.mat <- exp.plot %>% select(features.plot,id,avg.exp.scaled) %>% spread(id,avg.exp.scaled) 102 | rownames(exp.mat) <- exp.mat$features.plot 103 | exp.mat$features.plot <- NULL 104 | per.mat <- exp.plot %>% select(features.plot,id,pct.exp) %>% spread(id,pct.exp) 105 | rownames(per.mat) <- per.mat$features.plot 106 | per.mat$features.plot <- NULL 107 | per.mat <- per.mat/100 108 | 109 | exp.mat <- data.plot 110 | 111 | ### plot heatmap 112 | library(ComplexHeatmap) 113 | library(circlize) ## color 114 | # set color gradient 115 | col_fun2 <- colorRamp2(c(0, 2, 4), c("#118ab2", "#fdffb6", "#e63946")) 116 | pdf(paste0(dir,"plot_out/Mono_maker_heat.pdf"),width = 2.5,height = 5) 117 | Heatmap(data.plot, col = col_fun2,cluster_columns = F,cluster_rows = F, 118 | show_column_names = T,show_row_names = T,rect_gp=gpar(col="grey"), 119 | column_names_side = "top",row_names_side = "right", 120 | heatmap_legend_param=list(title = "Expression",legend_height=unit(3, "cm"))) 121 | dev.off() 122 | 123 | pdf(paste0(dir,"plot_out/Mono_maker_heat2.pdf"),width = 2.5,height = 9.5) 124 | Heatmap(exp.mat, col = col_fun2,cluster_columns = F,cluster_rows = F, 125 | show_column_names = T,show_row_names = T,rect_gp=gpar(type = "none"), 126 | cell_fun = function(j, i, x, y, width, height, fill){ 127 | grid.rect(x = x, y = y, width = width, height = height,gp = gpar(col = "grey", fill = NA)) 128 | grid.circle(x = x, y = y,r=per.mat[i,j]/2 * max(unit.c(width, height)),gp = gpar(fill = col_fun(exp.mat[i, j]), col = NA))}, 129 | column_names_side = "top",row_names_side = "right", 130 | heatmap_legend_param=list(title = "Expression",legend_height=unit(3, "cm"))) 131 | dev.off() 132 | 133 | 134 | ###### MF Trajectory 135 | library(monocle) 136 | # select MF 137 | MF_tj <- subset(RNA, idents = c(0:3,7:8)) 138 | # Extract data, phenotype data, and feature data from the SeuratObject 139 | data <- as(as.matrix(MF_tj@assays$RNA@counts), 'sparseMatrix') 140 | pd <- new('AnnotatedDataFrame', data = MF_tj@meta.data[,c("MF.cluster","MF_cluster_annotation")]) 141 | fData <- data.frame(gene_short_name = row.names(data), row.names = row.names(data)) 142 | fd <- new('AnnotatedDataFrame', data = fData) 143 | # Construct monocle cds 144 | monocle_cds <- newCellDataSet(data, 145 | phenoData = pd, 146 | featureData = fd, 147 | lowerDetectionLimit = 0.5, 148 | expressionFamily = negbinomial.size()) 149 | 150 | monocle_cds <- estimateSizeFactors(monocle_cds) 151 | monocle_cds <- estimateDispersions(monocle_cds) 152 | ## 153 | MF_DEG_genes <- differentialGeneTest(monocle_cds, fullModelFormulaStr = '~MF_cluster_annotation', cores = 20) 154 | ordering_genes <- row.names (subset(MF_DEG_genes, qval < 0.001)) 155 | gene_check <- row.names(MF_DEG_genes)[order(MF_DEG_genes$qval)][1:1000] 156 | write.csv(MF_DEG_genes,"data_out/MF_monocle_DEG.csv",quote=F) 157 | ## 158 | monocle_cds <- setOrderingFilter(monocle_cds,gene_check) 159 | monocle_cds <- reduceDimension( 160 | monocle_cds, 161 | max_components = 2, 162 | method = 'DDRTree') 163 | monocle_cds <- orderCells(monocle_cds) 164 | ClusterName_color_panel <- c("Mono_VEGFA" = "#F8766D", "Macro_SPP1" = "#DB8E00","Macro_CXCL9" = "#AEA200","Macro_SELENOP"="#64B200","Mono_CX3CR1"="#00A6FF","Macro_C1QA"="#B385FF") 165 | library(cowplot) 166 | pdf(paste0(dir,"plot_out/MF_Pseudotime_new.pdf"),width = 8,height = 5) 167 | plot_cell_trajectory(monocle_cds, color_by = "Pseudotime",show_branch_points=F)+theme_cowplot() 168 | plot_cell_trajectory(monocle_cds, color_by = "MF_cluster_annotation",cell_size = 1,show_branch_points=F)+theme_cowplot()+ 169 | scale_color_manual(name = "", values = ClusterName_color_panel)+guides(color = guide_legend(override.aes = list(size=5)))+ 170 | theme(axis.text.y = element_text(size=13),axis.text.x = element_text(size=13),axis.title.y = element_text(size=16),axis.title.x = element_text(size=15),axis.ticks.length = unit(0.2,"cm")) 171 | dev.off() 172 | 173 | saveRDS(monocle_cds,"data_out/MF_monocle_new.rds") 174 | 175 | ## CFP in PMo across treatment 176 | PMo <- subset(RNA, idents = 7) 177 | data.pmo <- FetchData(object = PMo, vars = c("CFP","CX3CR1")) 178 | data.pmo$Group <- PMo$Group 179 | library(ggsignif) 180 | compaired <- list(c("TN","MPR"),c("TN","NMPR"),c("MPR","NMPR")) 181 | Group_color_panel <- c("TN"="#228B22","MPR"="#FF4500","NMPR"="#757bc8") 182 | # CFP 183 | p <- ggplot(data=data.pmo,aes(x=factor(Group,levels=c("TN","MPR","NMPR")),y=CFP,fill=Group)) + 184 | geom_violin(color="white")+ 185 | geom_boxplot(width=0.1,position=position_dodge(0.9),fill="white") + theme_cowplot()+ 186 | scale_fill_manual(name = "Group", values = Group_color_panel)+ 187 | theme(axis.text.x = element_text(size=10,angle = 45, hjust=1, vjust=1), axis.text.y = element_text(size=10),axis.ticks.length = unit(0.2,"cm"))+ 188 | NoLegend()+labs(x="")+geom_signif(comparisons = compaired,step_increase = 0.1,map_signif_level = F,test = wilcox.test) 189 | ggsave(paste0(dir,"plot_out/PMo_CFP_treatment.pdf"),p,width =3,height =4) 190 | 191 | ## VEGFA in Mono_VEGFA across treatment 192 | Mono <- subset(RNA, idents = 0) 193 | data.mono <- FetchData(object = Mono, vars = c("VEGFA")) 194 | data.mono$Group <- Mono$Group 195 | library(ggsignif) 196 | compaired <- list(c("TN","MPR"),c("TN","NMPR"),c("MPR","NMPR")) 197 | Group_color_panel <- c("TN"="#228B22","MPR"="#FF4500","NMPR"="#757bc8") 198 | # CFP 199 | p <- ggplot(data=data.mono,aes(x=factor(Group,levels=c("TN","MPR","NMPR")),y=VEGFA,fill=Group)) + 200 | geom_violin(color="white")+ 201 | geom_boxplot(width=0.1,position=position_dodge(0.9),fill="white") + theme_cowplot()+ 202 | scale_fill_manual(name = "Group", values = Group_color_panel)+ 203 | theme(axis.text.x = element_text(size=10,angle = 45, hjust=1, vjust=1), axis.text.y = element_text(size=10),axis.ticks.length = unit(0.2,"cm"))+ 204 | NoLegend()+labs(x="")+geom_signif(comparisons = compaired,step_increase = 0.1,map_signif_level = F,test = wilcox.test) 205 | ggsave(paste0(dir,"plot_out/Mono_VEGFA_treatment.pdf"),p,width =3,height =4) 206 | 207 | ###Calculate cell fractions in different response groups 208 | source(paste0(dir,"code/Cal_fraction.R")) 209 | tab.1 <- cal_fraction(RNA,"MF_cluster_annotation") 210 | tab.1$cell <- factor(tab.1$cell, levels=c("Mono_CX3CR1","Mono_VEGFA","Macro_CXCL9","Macro_SPP1","Macro_SELENOP","Macro_C1QA","Macro_FABP4","Macro_MKI67","DC_CD1C","DC_LAMP3","DC_XCR1")) 211 | Group_color_panel <- c("TN"="#228B22","MPR"="#FF4500","NMPR"="#757bc8") 212 | # plot 213 | p1<- ggplot(tab.1, aes(x=Group, y=Estimate)) + 214 | geom_bar(stat = "identity", aes(fill=Group)) + 215 | scale_fill_manual(name = "Group", values = Group_color_panel) + facet_grid(~ cell) + 216 | theme_bw() + 217 | theme(axis.text.x = element_text(size=15,angle = 45, hjust=1, vjust=1), axis.text.y = element_text(size=15),axis.ticks.length = unit(0.2,"cm"),legend.position= "right") + 218 | xlab("") + ylab("Cellular fraction (%) of myeloid cell") + 219 | theme(axis.title.y=element_text(size=16),strip.text = element_text(size = 13))+ 220 | geom_errorbar(aes(ymin=lower, ymax=upper), width=.2,position=position_dodge(0.05)) 221 | ## theme(strip.background = element_rect(fill="white")) 222 | # Save plot 223 | ggsave(p1, filename = paste0(dir,"plot_out/MF_across_treatment.pdf"),width = 16, height = 5) 224 | 225 | source(paste0(dir,"code_clean/Cal_fraction_patients.R")) 226 | tab.2 <- cal_fraction_patients(RNA,"MF_cluster_annotation") 227 | tab.2$cell <- gsub("\\.[0-9]{1,}","",rownames(tab.2)) 228 | tab.2$cell <- gsub("\\."," ",tab.2$cell) 229 | tab.2$cell <- factor(tab.2$cell, levels=c("Mono_CX3CR1","Mono_VEGFA","Macro_CXCL9","Macro_SPP1","Macro_SELENOP","Macro_C1QA","Macro_FABP4","Macro_MKI67","DC_CD1C","DC_LAMP3","DC_XCR1")) 230 | #colnames(tab.2)[4] <- "Patient_ID" 231 | clin_info <- read.csv("clin_info.csv",header=T,stringsAsFactors=F) 232 | sample_info <- clin_info[,c("Patient_ID","Group")] 233 | table.plot <- merge(tab.2,sample_info,by="Patient_ID") 234 | table.plot$Group <- factor(table.plot$Group,levels=c("TN","MPR","NMPR")) 235 | 236 | pdf(paste0(dir,"plot_out/MF_across_treatment3.pdf"),width = 16,height = 5) 237 | p1+geom_point(data=table.plot,aes(x=Group, y=Estimate,color=Patient_ID),size = 1.5) 238 | dev.off() 239 | 240 | # boxplot 241 | p2<- ggplot(table.plot) + 242 | geom_boxplot(aes(x=cell, y=Estimate,color=Group,outlier.colour = NA),width = 0.6,position=position_dodge(0.75))+ 243 | geom_jitter(aes(x=cell, y=Estimate,color=Group),size = 1.5, position = position_jitterdodge())+ 244 | scale_color_manual(name="Group",values = Group_color_panel)+ 245 | theme_bw() + 246 | theme(axis.text.x = element_text(size=13,angle = 45, hjust=1, vjust=1), axis.text.y = element_text(size=13),axis.ticks.length = unit(0.2,"cm"),legend.position= "right") + 247 | xlab("") + ylab("Cellular fraction (%) of myeloid cell") + 248 | theme(axis.title.y=element_text(size=15),strip.text = element_text(size = 13)) 249 | # Save plot 250 | ggsave(p2, filename = paste0(dir,"plot_out/MF_across_treatment2.pdf"),width = 16, height = 5) 251 | 252 | library(ggsignif) 253 | compaired <- list(c("TN","MPR"),c("TN","NMPR"),c("MPR","NMPR")) 254 | ps <- list() 255 | for(i in unique(table.plot$cell)){ 256 | ps[[i]]<- ggplot(subset(table.plot,cell==i),aes(x=Group, y=Estimate,color=Group)) + 257 | geom_boxplot(width = 0.5,position=position_dodge(0.75),outlier.colour = NA)+ 258 | geom_jitter(size = 1.5, position = position_jitterdodge())+ 259 | scale_color_manual(name="Group",values = Group_color_panel)+ 260 | theme_bw() + 261 | theme(axis.text.x = element_text(size=13,angle = 45, hjust=1, vjust=1), axis.text.y = element_text(size=13),axis.ticks.length = unit(0.2,"cm")) + 262 | labs(x="",y="Cellular fraction (%) of all cells",title=i) + 263 | theme(axis.title.y=element_text(size=15),strip.text = element_text(size = 13))+ 264 | geom_signif(comparisons = compaired,step_increase = 0.1,map_signif_level = F,test = wilcox.test) 265 | } 266 | 267 | pdf(paste0(dir,"plot_out/MF_fraction_each_cell.pdf"),height=5,width=4) 268 | for(i in unique(table.plot$cell)){print(ps[[i]])} 269 | dev.off() 270 | 271 | saveRDS(RNA,"MF.rds") 272 | 273 | ######## MF M1_M2 plot 274 | # select MF 275 | MF <-subset(RNA, idents = c(1,2,3,4,6,8)) 276 | # feature from CIBERSORT LM22 277 | M0_features <- list(c("ACP5","BHLHE41","C5AR1","CCDC102B","CCL22","CCL7","COL8A2","CSF1","CXCL3","CXCL5","CYP27A1","DCSTAMP","GPC4","HK3","IGSF6","MARCO","MMP9","NCF2","PLA2G7","PPBP","QPCT","SLAMF8","SLC12A8","TNFSF14","VNN1")) 278 | M1_features <- list(c("ACHE","ADAMDEC1","APOBEC3A","APOL3","APOL6","AQP9","ARRB1","CCL19","CCL5","CCL8","CCR7","CD38","CD40","CHI3L1","CLIC2","CXCL10","CXCL11","CXCL13","CXCL9","CYP27B1","DHX58","EBI3","GGT5","HESX1","IDO1","IFI44L","IL2RA","KIAA0754","KYNU","LAG3","LAMP3","LILRA3","LILRB2","NOD2","PLA1A","PTGIR","RASSF4","RSAD2","SIGLEC1","SLAMF1","SLC15A3","SLC2A6","SOCS1","TLR7","TLR8","TNFAIP6","TNIP3","TRPM4")) 279 | M2_features <- list(c("ADAMDEC1","AIF1","ALOX15","CCL13","CCL14","CCL18","CCL23","CCL8","CD209","CD4","CD68","CFP","CHI3L1","CLEC10A","CLEC4A","CLIC2","CRYBB1","EBI3","FAM198B","FES","FRMD4A","FZD2","GGT5","GSTT1","HRH1","HTR2B","MS4A6A","NME8","NPL","P2RY13","PDCD1LG2","RENBP","SIGLEC1","SLC15A3","TLR8","TREM2","WNT5B")) 280 | # calculate score 281 | MF <- AddModuleScore(object=MF,features=M1_features,name="M1_score") 282 | MF <- AddModuleScore(object=MF,features=M2_features,name="M2_score") 283 | MF <- AddModuleScore(object=MF,features=M0_features,name="M0_score") 284 | # plot 285 | Group_color_panel <- c("TN"="#228B22","MPR"="#FF4500","NMPR"="#757bc8") 286 | # violin plot 287 | data.plot <- MF@meta.data[,c("Group","MF_cluster_annotation","M0_score1","M1_score1","M2_score1")] 288 | library(ggsignif) 289 | library(cowplot) 290 | compaired <- list(c("TN","MPR"),c("TN","NMPR"),c("MPR","NMPR")) 291 | p3 <- ggplot(data = data.plot,aes(x=factor(Group,levels=c("TN","MPR","NMPR")),y=M1_score1,fill=Group))+ 292 | geom_violin(color="white")+ 293 | geom_boxplot(width=0.1,position=position_dodge(0.9),fill="white")+theme_cowplot()+ 294 | scale_fill_manual(name="Group",values = Group_color_panel)+ 295 | theme(axis.text.x = element_text(size=10,angle = 45, hjust=1, vjust=1), axis.text.y = element_text(size=10),axis.ticks.length = unit(0.2,"cm"))+ 296 | NoLegend()+labs(x="",y="M1 signature")+geom_signif(comparisons = compaired,step_increase = 0.1,map_signif_level = F,test = wilcox.test) 297 | ggsave(paste0(dir,"plot_out/M1_across_treatment.pdf"),p3,width =3,height =5) 298 | p4 <- ggplot(data = data.plot,aes(x=factor(Group,levels=c("TN","MPR","NMPR")),y=M2_score1,fill=Group))+ 299 | geom_violin(color="white")+ 300 | geom_boxplot(width=0.1,position=position_dodge(0.9),fill="white")+theme_cowplot()+ 301 | scale_fill_manual(name="Group",values = Group_color_panel)+ 302 | theme(axis.text.x = element_text(size=10,angle = 45, hjust=1, vjust=1), axis.text.y = element_text(size=10),axis.ticks.length = unit(0.2,"cm"))+ 303 | NoLegend()+labs(x="",y="M2 signature")+geom_signif(comparisons = compaired,step_increase = 0.1,map_signif_level = F,test = wilcox.test) 304 | ggsave(paste0(dir,"plot_out/M2_across_treatment.pdf"),p4,width =3,height =5) 305 | p5 <- ggplot(data = data.plot,aes(x=factor(Group,levels=c("TN","MPR","NMPR")),y=M0_score1,fill=Group))+ 306 | geom_violin(color="white")+ 307 | geom_boxplot(width=0.1,position=position_dodge(0.9),fill="white")+theme_cowplot()+ 308 | scale_fill_manual(name="Group",values = Group_color_panel)+ 309 | theme(axis.text.x = element_text(size=10,angle = 45, hjust=1, vjust=1), axis.text.y = element_text(size=10),axis.ticks.length = unit(0.2,"cm"))+ 310 | NoLegend()+labs(x="",y="M0 signature")+geom_signif(comparisons = compaired,step_increase = 0.1,map_signif_level = F,test = wilcox.test) 311 | ggsave(paste0(dir,"plot_out/M0_across_treatment.pdf"),p5,width =3,height =5) 312 | #### each cluster 313 | pm0 <- ggplot(data = data.plot,aes(x=factor(Group,levels=c("TN","MPR","NMPR")),y=M0_score1,fill=Group))+ 314 | geom_violin(color="white")+ 315 | geom_boxplot(width=0.1,position=position_dodge(0.9),fill="white")+facet_grid(~MF_cluster_annotation) +theme_bw()+ 316 | scale_fill_manual(name="Group",values = Group_color_panel)+ 317 | theme(axis.text.x = element_text(size=10,angle = 45, hjust=1, vjust=1), axis.text.y = element_text(size=10),axis.ticks.length = unit(0.2,"cm"),legend.position="bottom")+ 318 | labs(x="",y="M0 signature")+geom_signif(comparisons = compaired,step_increase = 0.1,map_signif_level = F,test = wilcox.test) 319 | ggsave(paste0(dir,"plot_out/M0_cluster_across_treatment.pdf"),pm0,width =12,height =5) 320 | pm1 <- ggplot(data = data.plot,aes(x=factor(Group,levels=c("TN","MPR","NMPR")),y=M1_score1,fill=Group))+ 321 | geom_violin(color="white")+ 322 | geom_boxplot(width=0.1,position=position_dodge(0.9),fill="white")+facet_grid(~MF_cluster_annotation) +theme_bw()+ 323 | scale_fill_manual(name="Group",values = Group_color_panel)+ 324 | theme(axis.text.x = element_text(size=10,angle = 45, hjust=1, vjust=1), axis.text.y = element_text(size=10),axis.ticks.length = unit(0.2,"cm"),legend.position="bottom")+ 325 | labs(x="",y="M1 signature")+geom_signif(comparisons = compaired,step_increase = 0.1,map_signif_level = F,test = wilcox.test) 326 | ggsave(paste0(dir,"plot_out/M1_cluster_across_treatment.pdf"),pm1,width =12,height =5) 327 | pm2 <- ggplot(data = data.plot,aes(x=factor(Group,levels=c("TN","MPR","NMPR")),y=M2_score1,fill=Group))+ 328 | geom_violin(color="white")+ 329 | geom_boxplot(width=0.1,position=position_dodge(0.9),fill="white")+facet_grid(~MF_cluster_annotation) +theme_bw()+ 330 | scale_fill_manual(name="Group",values = Group_color_panel)+ 331 | theme(axis.text.x = element_text(size=10,angle = 45, hjust=1, vjust=1), axis.text.y = element_text(size=10),axis.ticks.length = unit(0.2,"cm"),legend.position="bottom")+ 332 | labs(x="",y="M2 signature")+geom_signif(comparisons = compaired,step_increase = 0.1,map_signif_level = F,test = wilcox.test) 333 | ggsave(paste0(dir,"plot_out/M2_cluster_across_treatment.pdf"),pm2,width =12,height =5) 334 | 335 | ##### DC 336 | DC <- subset(RNA,idents=c(5,9,10)) 337 | ## heapmap plot 338 | features=c("XCR1","CLEC9A","CADM1","CLNK","CD1C","CD1E","FCER1A","CLEC10A","LAMP3","FSCN1","CCR7","LAD1","CCL17","CCL19","CCL22","CX3CR1","CD86","CD83","CD80","CD40","ICOSLG", 339 | "IDO1","CD274","PDCD1LG2","CD200","TLR1","TLR2","TLR4","TLR7","TLR10") 340 | ### plot heatmap 341 | source(paste0(dir,"code_clean/Heat_Dot_data.R")) 342 | ### set colnames order 343 | plot_ord <- c("DC_XCR1","DC_CD1C","DC_LAMP3") 344 | 345 | data.plot <- Heat_Dot_data(object=DC,features=features,group.by="MF_cluster_annotation") 346 | exp.mat <- data.plot %>% select(features.plot,id,avg.exp.scaled) %>% spread(id,avg.exp.scaled) 347 | rownames(exp.mat) <- exp.mat$features.plot 348 | exp.mat$features.plot <- NULL 349 | exp.mat <- exp.mat[,plot_ord] 350 | per.mat <- data.plot %>% select(features.plot,id,pct.exp) %>% spread(id,pct.exp) 351 | rownames(per.mat) <- per.mat$features.plot 352 | per.mat$features.plot <- NULL 353 | per.mat <- per.mat[,plot_ord]/100 354 | 355 | ### plot heatmap 356 | library(ComplexHeatmap) 357 | library(circlize) ## color 358 | # set color gradient 359 | col_fun <- colorRamp2(c(-1.5, 0, 1.5), c("#118ab2", "#fdffb6", "#e63946")) 360 | # split heatmap 361 | row_split = c(rep("cDC1",4),rep("cDC2",4),rep("Activation and migration",4),rep("Chemotaxis",4),rep("Co-stimulatory",5),rep("Inhibitory",4),rep("TLRs",5)) 362 | row_split = factor(row_split,levels = c("cDC1","cDC2","Activation and migration","Chemotaxis","Co-stimulatory","Inhibitory","TLRs")) 363 | # left annotation 364 | ha = HeatmapAnnotation(df = data.frame(Marker=row_split),which = "row", 365 | col = list(Marker = c("cDC1" = "#e76f51", "cDC2"="#0077b6","Activation and migration"="#ddbea9", 366 | "Chemotaxis"="#00b4d8","Co-stimulatory"="#dc2f02","Inhibitory"="#fca311","TLRs"="#8a5a44"))) 367 | pdf(paste0(dir,"plot_out/DC_maker_heat_new.pdf"),width = 5,height = 9) 368 | Heatmap(exp.mat, col = col_fun,cluster_columns = F,cluster_rows = F, 369 | show_column_names = T,show_row_names = T,rect_gp=gpar(col="grey"), 370 | column_names_side = "top",row_names_side = "right", 371 | row_split = row_split, 372 | row_gap = unit(3, "mm"), 373 | left_annotation = ha, 374 | heatmap_legend_param=list(title = "Expression",legend_height=unit(3, "cm"))) 375 | dev.off() 376 | 377 | pdf(paste0(dir,"plot_out/DC_maker_heat_new2.pdf"),width = 4.5,height = 12) 378 | Heatmap(exp.mat, col = col_fun,cluster_columns = F,cluster_rows = F, 379 | show_column_names = T,show_row_names = T,rect_gp=gpar(type = "none"), 380 | cell_fun = function(j, i, x, y, width, height, fill){ 381 | grid.rect(x = x, y = y, width = width, height = height,gp = gpar(col = "grey", fill = NA)) 382 | grid.circle(x = x, y = y,r=per.mat[i,j]/2 * max(unit.c(width, height)),gp = gpar(fill = col_fun(exp.mat[i, j]), col = NA))}, 383 | column_names_side = "top",row_names_side = "right", 384 | row_split = row_split, 385 | row_gap = unit(3, "mm"), 386 | left_annotation = ha, 387 | heatmap_legend_param=list(title = "Expression",legend_height=unit(3, "cm"))) 388 | dev.off() 389 | 390 | # DC activating signature 391 | DC_score_gene <- read.csv(paste0(dir,"data_out/DC_score_gene.csv"),header=T,stringsAsFactors=F) 392 | DC_ap <- list(DC_score_gene$AP) 393 | DC_is <- list(DC_score_gene$IS) 394 | # calculate score 395 | DC <- AddModuleScore(object=DC,features=DC_ap,name="DC_ap") 396 | DC <- AddModuleScore(object=DC,features=DC_is,name="DC_is") 397 | library(ggsignif) 398 | data.plot <- DC@meta.data[,c("Group","MF_cluster_annotation","DC_ap1","DC_is1")] 399 | compaired <- list(c("TN","MPR"),c("TN","NMPR"),c("MPR","NMPR")) 400 | p <- ggplot(data = data.plot,aes(x=factor(Group,levels=c("TN","MPR","NMPR")),y=DC_ap1,fill=Group))+ 401 | geom_violin(color="white")+ 402 | geom_boxplot(width=0.1,position=position_dodge(0.9),fill="white")+theme_cowplot()+ 403 | scale_fill_manual(name="Group",values = Group_color_panel)+ 404 | theme(axis.text.x = element_text(size=10,angle = 45, hjust=1, vjust=1), axis.text.y = element_text(size=10),axis.ticks.length = unit(0.2,"cm"))+ 405 | NoLegend()+labs(x="",y="Antigen-presenting signature")+geom_signif(comparisons = compaired,step_increase = 0.1,map_signif_level = F,test = wilcox.test) 406 | ggsave(paste0(dir,"plot_out/DC_ap_across_treatment.pdf"),p,width =3,height =5) 407 | p <- ggplot(data = data.plot,aes(x=factor(Group,levels=c("TN","MPR","NMPR")),y=DC_is1,fill=Group))+ 408 | geom_violin(color="white")+ 409 | geom_boxplot(width=0.1,position=position_dodge(0.9),fill="white")+theme_cowplot()+ 410 | scale_fill_manual(name="Group",values = Group_color_panel)+ 411 | theme(axis.text.x = element_text(size=10,angle = 45, hjust=1, vjust=1), axis.text.y = element_text(size=10),axis.ticks.length = unit(0.2,"cm"))+ 412 | NoLegend()+labs(x="",y="Immunosuppressive signature")+geom_signif(comparisons = compaired,step_increase = 0.1,map_signif_level = F,test = wilcox.test) 413 | ggsave(paste0(dir,"plot_out/DC_is_across_treatment.pdf"),p,width =3,height =5) 414 | ## cluster 415 | pa <- ggplot(data = data.plot,aes(x=factor(Group,levels=c("TN","MPR","NMPR")),y=DC_ap1,fill=Group))+ 416 | geom_violin(color="white")+ 417 | geom_boxplot(width=0.1,position=position_dodge(0.9),fill="white")+facet_grid(~MF_cluster_annotation) +theme_bw()+ 418 | scale_fill_manual(name="Group",values = Group_color_panel)+ 419 | theme(axis.text.x = element_text(size=10,angle = 45, hjust=1, vjust=1), axis.text.y = element_text(size=10),axis.ticks.length = unit(0.2,"cm"),legend.position="bottom")+ 420 | labs(x="",y="Antigen-presenting signature")+geom_signif(comparisons = compaired,step_increase = 0.1,map_signif_level = F,test = wilcox.test) 421 | ggsave(paste0(dir,"plot_out/DC_cluster_ap_across_treatment.pdf"),pa,width =6.5,height =5) 422 | pi <- ggplot(data = data.plot,aes(x=factor(Group,levels=c("TN","MPR","NMPR")),y=DC_is1,fill=Group))+ 423 | geom_violin(color="white")+ 424 | geom_boxplot(width=0.1,position=position_dodge(0.9),fill="white")+facet_grid(~MF_cluster_annotation) +theme_bw()+ 425 | scale_fill_manual(name="Group",values = Group_color_panel)+ 426 | theme(axis.text.x = element_text(size=10,angle = 45, hjust=1, vjust=1), axis.text.y = element_text(size=10),axis.ticks.length = unit(0.2,"cm"),legend.position="bottom")+ 427 | labs(x="",y="Immunosuppressive signature")+geom_signif(comparisons = compaired,step_increase = 0.1,map_signif_level = F,test = wilcox.test) 428 | ggsave(paste0(dir,"plot_out/DC_cluster_is_across_treatment.pdf"),pi,width =6.5,height =5) 429 | 430 | 431 | 432 | 433 | -------------------------------------------------------------------------------- /07.1_B_Nichenet.R: -------------------------------------------------------------------------------- 1 | library(Seurat) 2 | library(ggplot2) 3 | library(future) 4 | library(tidyverse) 5 | library(nichenetr) 6 | plan("multiprocess", workers = 8) 7 | options(future.globals.maxSize = 10*1024^3) 8 | 9 | dir <- "./" 10 | 11 | Bcell <- readRDS("Bcell2.rds") 12 | B4 <- subset(Bcell,idents=4) 13 | 14 | ## take our B4 15 | B4_mat <- as.matrix(B4@assays$RNA@data) 16 | 17 | ### Read in NicheNet’s ligand-target prior model, ligand-receptor network and weighted integrated networks 18 | ref_dir <- "/media/inspur/AS2150G2/HJJ/scrna/NicheNet/" 19 | ligand_target_matrix <- readRDS(paste0(ref_dir,"ligand_target_matrix.rds")) 20 | lr_network <- readRDS(paste0(ref_dir,"lr_network.rds")) 21 | weighted_networks <- readRDS(paste0(ref_dir,"weighted_networks.rds")) 22 | 23 | ### Define the gene set of interest and a background of genes 24 | B_marker <- read.csv(paste0(dir,"data_out/B_clusters.csv"),stringsAsFactors=F) 25 | B4_marker <- B_marker %>% filter(cluster==4) %>% filter(avg_logFC > 0.5)%>% dplyr::top_n(50, avg_logFC) 26 | geneset_oi <- B4_marker$gene %>% .[. %in% rownames(ligand_target_matrix)] 27 | ### Define a background of genes 28 | expressed_genes_receiver <- B4_mat %>% apply(1,function(x){sum(x>0)/length(x)}) %>% .[. >= 0.1] %>% names() 29 | background_expressed_genes = expressed_genes_receiver %>% .[. %in% rownames(ligand_target_matrix)] 30 | ## define potential_ligands 31 | ligands <- lr_network %>% pull(from) %>% unique() 32 | expressed_ligands <- ligands ## here we used all ligands intersect(ligands,expressed_genes_sender) 33 | receptors <- lr_network %>% pull(to) %>% unique() 34 | expressed_receptors <- intersect(receptors,expressed_genes_receiver) 35 | lr_network_expressed <- lr_network %>% filter(from %in% expressed_ligands & to %in% expressed_receptors) 36 | head(lr_network_expressed) 37 | potential_ligands <- lr_network_expressed %>% pull(from) %>% unique() 38 | 39 | ### Perform NicheNet’s ligand activity analysis on the gene set of interest 40 | ligand_activities <- predict_ligand_activities(geneset = geneset_oi, 41 | background_expressed_genes = background_expressed_genes, 42 | ligand_target_matrix = ligand_target_matrix, 43 | potential_ligands = potential_ligands) 44 | best_upstream_ligands <- ligand_activities %>% top_n(20, pearson) %>% arrange(-pearson) %>% pull(test_ligand) 45 | 46 | ### Infer target genes of top-ranked ligands and visualize in a heatmap 47 | active_ligand_target_links_df <- best_upstream_ligands %>% lapply(get_weighted_ligand_target_links,geneset = geneset_oi, ligand_target_matrix = ligand_target_matrix, n = 250) %>% bind_rows() 48 | active_ligand_target_links_df <- na.omit(active_ligand_target_links_df) 49 | 50 | active_ligand_target_links <- prepare_ligand_target_visualization(ligand_target_df = active_ligand_target_links_df, ligand_target_matrix = ligand_target_matrix, cutoff = 0.25) 51 | 52 | order_ligands <- intersect(best_upstream_ligands, colnames(active_ligand_target_links)) %>% rev() 53 | order_targets <- active_ligand_target_links_df$target %>% unique() 54 | vis_ligand_target <- active_ligand_target_links[order_targets,order_ligands] %>% t() 55 | 56 | B4_specific <- vis_ligand_target %>% make_heatmap_ggplot("Pro B4 maturation ligands","B4-specific maturation signature", color = "red",legend_position = "top", x_axis_position = "top",legend_title = "Regulatory potential") + scale_fill_gradient2(low = "whitesmoke", high = "red", breaks = c(0,0.005,0.01)) + theme(axis.text.x = element_text(face = "italic")) 57 | pdf(paste0(dir,"plot_out/B4_NicheNetr.pdf"),width=7,height=6) 58 | B4_specific 59 | dev.off() 60 | 61 | -------------------------------------------------------------------------------- /07.2_B4_Tfh_CD8_CellphoneDB.R: -------------------------------------------------------------------------------- 1 | library(Seurat) 2 | 3 | dir <- "./" 4 | 5 | ## take B4_FCRL4 6 | Bcell <- readRDS("Bcell.rds") 7 | B4 <- subset(Bcell,idents=4) 8 | B4_count <- as.matrix(B4@assays$RNA@data) 9 | B4_meta <- data.frame(Cell=rownames(B4@meta.data), celltype = "B4_FCRL4") 10 | 11 | ## Tfh 12 | Tcell <- readRDS("Tcell.rds") 13 | T4 <- subset(Tcell,T_cluster_annotation %in% c("CD4_MAF","CD4_CXCL13")) 14 | T4_count <- as.matrix(T4@assays$RNA@data) 15 | T4_meta <- data.frame(Cell=rownames(T4@meta.data), celltype = "Tfh") 16 | 17 | ## take CD8 cell 18 | T8 <- subset(Tcell,T_cluster_annotation %in% c("CD8_IL7R","CD8_GZMK","CD8_GZMB","CD8_HAVCR2","CD8_STMN1")) 19 | T8_count <- as.matrix(T8@assays$RNA@data) 20 | T8_meta <- data.frame(Cell=rownames(T8@meta.data), celltype = "CD8 T") 21 | 22 | count <- cbind(B4_count,T4_count,T8_count) 23 | meta_data <- rbind(B4_meta,T4_meta,T8_meta) 24 | 25 | write.table(count, 'cellphonedb/B4_Tfh_T8/B4_Tfh_T8_count.txt', sep='\t', quote=F, row.names=T) 26 | write.table(meta_data, 'cellphonedb/B4_Tfh_T8/B4_Tfh_T8_meta.txt', sep='\t', quote=F, row.names=F) 27 | 28 | ################# cmd code ##################### 29 | cellphonedb method statistical_analysis --counts-data=gene_name --threads=20 --output-path=cellphonedb/B4_Tfh_T8/ --pvalue 0.01 cellphonedb/B4_Tfh_T8/B4_Tfh_T8_meta.txt cellphonedb/B4_Tfh_T8/B4_Tfh_T8_count.txt 30 | cd cellphonedb/B4_Tfh_T8/ 31 | cellphonedb plot dot_plot --means-path ./means.txt --pvalues-path ./pvalues.txt --output-path ./ 32 | cellphonedb plot heatmap_plot B4_Tfh_T8_meta.txt --pvalues-path ./pvalues.txt --output-path ./ 33 | 34 | ## pick some L-R pair to plot 35 | library(dplyr) 36 | library(ggplot2) 37 | plot_dir <- paste0(dir,"cellphonedb/B4_Tfh_T8/") 38 | mypvals <- read.delim(paste0(plot_dir,"pvalues.txt"), check.names = FALSE) 39 | mymeans <- read.delim(paste0(plot_dir,"significant_means.txt"), check.names = FALSE) 40 | # select cell pair 41 | keep <- c(which(mypvals$`B4_FCRL4|Tfh` < 0.01),which(mypvals$`Tfh|B4_FCRL4` < 0.01), 42 | which(mypvals$`B4_FCRL4|CD8 T` < 0.01),which(mypvals$`CD8 T|B4_FCRL4` < 0.01), 43 | which(mypvals$`CD8 T|Tfh` < 0.01),which(mypvals$`Tfh|CD8 T` < 0.01)) 44 | keep <- unique(keep) 45 | mypvals_keep <- mypvals[keep,] 46 | mypair <- intersect(mypvals_keep$interacting_pair,mymeans$interacting_pair) 47 | # pick out chemokines and so on 48 | chemokines <- grep("^CXC|CCL|CCR|CX3|XCL|XCR|^IL[1-9]", mypair,value = T) 49 | write.table(as.data.frame(chemokines),paste0(plot_dir,"B4_Tfh_T8_chemokines.txt"),col.names=F,quote=F,row.names=F) 50 | costimulatory <- grep("CD86|CD80|CD48|LILRB2|LILRB4|TNF|CD2|ICAM|SLAM|LT[AB]|NECTIN2|CD40|CD70|CD27|CD28|CD58|TSLP|PVR|CD44|CD55|CD[1-9]", 51 | mypair,value = T) 52 | write.table(as.data.frame(costimulatory),paste0(plot_dir,"B4_Tfh_T8_costimulatory.txt"),col.names=F,quote=F,row.names=F) 53 | coinhibitory <- grep("SIRP|CD47|ICOS|TIGIT|CTLA4|PDCD1|CD274|LAG3|HAVCR|VSIR|ENTPD1", 54 | mypair,value = T) 55 | write.table(as.data.frame(coinhibitory),paste0(plot_dir,"B4_Tfh_T8_coinhibitory.txt"),col.names=F,quote=F,row.names=F) 56 | All_LR <- c(chemokines,costimulatory,coinhibitory) 57 | write.table(as.data.frame(All_LR),paste0(plot_dir,"B4_Tfh_T8_All_LR.txt"),col.names=F,quote=F,row.names=F) 58 | 59 | #### plot the selected L-R 60 | cd cellphonedb/B4_Tfh_T8/ 61 | cellphonedb plot dot_plot --means-path ./means.txt --pvalues-path ./pvalues.txt --output-path ./ --rows B4_Tfh_T8_chemokines.txt --columns pair_plot.txt --output-name B4_Tfh_T8_chemokines.pdf 62 | cellphonedb plot dot_plot --means-path ./means.txt --pvalues-path ./pvalues.txt --output-path ./ --rows B4_Tfh_T8_costimulatory.txt --columns pair_plot.txt --output-name B4_Tfh_T8_costimulatory.pdf 63 | cellphonedb plot dot_plot --means-path ./means.txt --pvalues-path ./pvalues.txt --output-path ./ --rows B4_Tfh_T8_coinhibitory.txt --columns pair_plot.txt --output-name B4_Tfh_T8_coinhibitory.pdf 64 | cellphonedb plot dot_plot --means-path ./means.txt --pvalues-path ./pvalues.txt --output-path ./ --rows B4_Tfh_T8_All_LR.txt --columns pair_plot.txt --output-name B4_Tfh_T8_All_LR.pdf 65 | cellphonedb plot dot_plot --means-path ./means.txt --pvalues-path ./pvalues.txt --output-path ./ --rows B4_Tfh_T8_plot.txt --columns pair_plot.txt --output-name B4_Tfh_T8_plot.pdf 66 | -------------------------------------------------------------------------------- /07_B_analysis_new.R: -------------------------------------------------------------------------------- 1 | library(Seurat) 2 | library(ggplot2) 3 | library(tidyverse) 4 | 5 | dir <- "./" 6 | 7 | RNA <- readRDS("Bcell.rds") 8 | 9 | 10 | # Manually ananotate immmune markers to identify major cell clusters 11 | B_marker=c("MS4A1","CD27","GPR183","IGHD","RGS13","IGHM") 12 | marker_plot=function(SeuratObj,marker){ 13 | pn=length(marker) 14 | pp=list() 15 | for(i in 1:pn){ 16 | pg=FeaturePlot(object = SeuratObj, features = marker[i], cols = c("grey", "red"), reduction = "umap")+NoLegend()+labs(x="",y="")+theme(plot.title = element_text(hjust = 0.5)) 17 | pp[[marker[i]]]=pg 18 | } 19 | return(pp) 20 | } 21 | p=marker_plot(RNA,B_marker) 22 | for(i in 1:6){ 23 | ggsave(paste0(dir,"plot_out/B_",B_marker[i],".png"),p[[B_marker[i]]],width =6,height =6) 24 | } 25 | 26 | # Dotplot of top N DE expressed genes 27 | markers<- read.csv(paste0(dir,"/data_out/B_clusters.csv"),row.names=1,stringsAsFactors=F) 28 | markers.small <- markers %>% group_by(cluster) %>% top_n(5, avg_logFC) 29 | genes_to_check <- unique(markers.small$gene) 30 | # Create Dotplot 31 | pdf(paste(dir,"plot_out/B_dotplot.pdf", sep=""),6,8) 32 | DotPlot(RNA, features = genes_to_check) +coord_flip()+ theme(axis.title.y = element_text(size=15),axis.title.x = element_text(size=15)) 33 | dev.off() 34 | 35 | # Manually ananotate B markers 36 | # stash current cluster IDs 37 | RNA[["B.cluster"]] <- Idents(object = RNA) 38 | # enumerate current cluster IDs and the labels for them 39 | cluster.ids <- 0:(length(unique(RNA@meta.data$B.cluster))-1) 40 | # Annotate each of the clusters 41 | free_annotation <- c("Memory B", "Memory B", "Memory B","Naive B","Memory B","Memory B","GC B") 42 | # Map free annotation to cluster numbers and store as all_subtype_annotation 43 | RNA@meta.data[,'B_cluster_annotation'] <- plyr::mapvalues(x = RNA@meta.data$B.cluster, from = cluster.ids, to = free_annotation) 44 | 45 | # Annotate each of the clusters 46 | free_annotation2 <- c("B0-MS4A1", "B1-IGHM", "B2-HSPA1A","B3-IGHD","B4-FCRL4","B5-CD83","B6-RGS13") 47 | # Map free annotation to cluster numbers and store as all_subtype_annotation 48 | RNA@meta.data[,'B_cluster_annotation2'] <- plyr::mapvalues(x = RNA@meta.data$B.cluster, from = cluster.ids, to = free_annotation2) 49 | # plot umap 50 | pdf(paste(dir,"plot_out/B_cluster_annotation_umap.pdf", sep=""),width = 7,height = 6) 51 | DimPlot(RNA, reduction = "umap", label = F, group.by = 'B_cluster_annotation') 52 | dev.off() 53 | pdf(paste(dir,"plot_out/B_cluster_annotation_umap2.pdf", sep=""),width = 7,height = 6) 54 | DimPlot(RNA, reduction = "umap", label = F, group.by = 'B_cluster_annotation2') 55 | dev.off() 56 | 57 | saveRDS(RNA,"Bcell.rds") 58 | 59 | 60 | ###Calculate cell fractions in different response groups 61 | source(paste0(dir,"code/Cal_fraction.R")) 62 | tab.1 <- cal_fraction(RNA,"B_cluster_annotation2") 63 | tab.1$cell <- factor(tab.1$cell,levels =c("B3 IGHD","B0 MS4A1", "B1 IGHM", "B2 HSPA1A","B4 FCRL4","B5 CD83","B6 RGS13")) 64 | Group_color_panel <- c("TN"="#228B22","MPR"="#FF4500","NMPR"="#757bc8") 65 | # plot 66 | p1<- ggplot(tab.1, aes(x=Group, y=Estimate)) + 67 | geom_bar(stat = "identity", aes(fill=Group)) + 68 | scale_fill_manual(name = "Group", values = Group_color_panel) + facet_grid(~ cell) + 69 | theme_bw() + 70 | theme(axis.text.x = element_text(size=15,angle = 45, hjust=1, vjust=1), axis.text.y = element_text(size=15),axis.ticks.length = unit(0.2,"cm"),legend.position= "bottom") + 71 | xlab("") + ylab("Cellular fraction (%) of B cell") + 72 | theme(axis.title.y=element_text(size=16),strip.text = element_text(size = 13))+ 73 | geom_errorbar(aes(ymin=lower, ymax=upper), width=.2,position=position_dodge(0.05)) 74 | ggsave(p1, filename = paste0(dir,"plot_out/B_across_treatment.pdf"),width = 9, height = 5.5) 75 | 76 | 77 | # boxplot 78 | p2<- ggplot(table.plot) + 79 | geom_boxplot(aes(x=cell, y=Estimate,color=Group,outlier.colour = NA),width = 0.6,position=position_dodge(0.75))+ 80 | geom_jitter(aes(x=cell, y=Estimate,color=Group),size = 1.5, position = position_jitterdodge())+ 81 | scale_color_manual(name="Group",values = Group_color_panel)+ 82 | theme_bw() + 83 | theme(axis.text.x = element_text(size=13,angle = 45, hjust=1, vjust=1), axis.text.y = element_text(size=13),axis.ticks.length = unit(0.2,"cm"),legend.position= "bottom") + 84 | xlab("") + ylab("Cellular fraction (%) of B cells") + 85 | theme(axis.title.y=element_text(size=15),strip.text = element_text(size = 13)) 86 | # Save plot 87 | ggsave(p2, filename = paste0(dir,"plot_out/B_across_treatment2.pdf"),width = 9, height = 5.5) 88 | 89 | library(ggsignif) 90 | compaired <- list(c("TN","MPR"),c("TN","NMPR"),c("MPR","NMPR")) 91 | ps <- list() 92 | for(i in unique(table.plot$cell)){ 93 | ps[[i]]<- ggplot(subset(table.plot,cell==i),aes(x=Group, y=Estimate,color=Group)) + 94 | geom_boxplot(width = 0.5,position=position_dodge(0.75),outlier.colour = NA)+ 95 | geom_jitter(size = 1.5, position = position_jitterdodge())+ 96 | scale_color_manual(name="Group",values = Group_color_panel)+ 97 | theme_bw() + 98 | theme(axis.text.x = element_text(size=13,angle = 45, hjust=1, vjust=1), axis.text.y = element_text(size=13),axis.ticks.length = unit(0.2,"cm")) + 99 | labs(x="",y="Cellular fraction (%) of B cells",title=i) + 100 | theme(axis.title.y=element_text(size=15),strip.text = element_text(size = 13))+ 101 | geom_signif(comparisons = compaired,step_increase = 0.1,map_signif_level = F,test = wilcox.test) 102 | } 103 | 104 | pdf(paste0(dir,"plot_out/B_fraction_each_cell.pdf"),height=5,width=4) 105 | for(i in unique(table.plot$cell)){print(ps[[i]])} 106 | dev.off() 107 | 108 | ###Calculate cell fractions in major clusters 109 | source(paste0(dir,"code/Cal_fraction.R")) 110 | tab.1 <- cal_fraction(RNA,"B_cluster_annotation") 111 | tab.1$cell <- factor(tab.1$cell,levels =c("Memory B","Naive B","GC B")) 112 | Group_color_panel <- c("TN"="#228B22","MPR"="#FF4500","NMPR"="#757bc8") 113 | # plot 114 | p1<- ggplot(tab.1, aes(x=Group, y=Estimate)) + 115 | geom_bar(stat = "identity", aes(fill=Group)) + 116 | scale_fill_manual(name = "Group", values = Group_color_panel) + facet_grid(~ cell) + 117 | theme_bw() + 118 | theme(axis.text.x = element_text(size=15,angle = 45, hjust=1, vjust=1), axis.text.y = element_text(size=15),axis.ticks.length = unit(0.2,"cm"),legend.position= "bottom") + 119 | xlab("") + ylab("Cellular fraction (%) of B cell") + 120 | theme(axis.title.y=element_text(size=16),strip.text = element_text(size = 13))+ 121 | geom_errorbar(aes(ymin=lower, ymax=upper), width=.2,position=position_dodge(0.05)) 122 | 123 | source(paste0(dir,"code_clean/Cal_fraction_patients.R")) 124 | tab.2 <- cal_fraction_patients(RNA_sub,"B_cluster_annotation") 125 | tab.2$cell <- gsub("\\.[0-9]{1,}","",rownames(tab.2)) 126 | tab.2$cell <- gsub("\\."," ",tab.2$cell) 127 | tail(tab.2) 128 | tab.2$cell <- factor(tab.2$cell, levels =c("Memory B","Naive B","GC B")) 129 | #colnames(tab.2)[4] <- "Patient_ID" 130 | clin_info <- read.csv("clin_info.csv",header=T,stringsAsFactors=F) 131 | sample_info <- clin_info[,c("Patient_ID","Group")] 132 | table.plot <- merge(tab.2,sample_info,by="Patient_ID") 133 | table.plot$Group <- factor(table.plot$Group,levels=c("TN","MPR","NMPR")) 134 | 135 | pdf(paste0(dir,"plot_out/B_major_across_treatment.pdf"),width = 4,height = 5) 136 | p1+geom_point(data=table.plot,aes(x=Group, y=Estimate,color=Patient_ID),size = 1.5) 137 | dev.off() 138 | 139 | # boxplot 140 | p2<- ggplot(table.plot) + 141 | geom_boxplot(aes(x=cell, y=Estimate,color=Group,outlier.colour = NA),width = 0.6,position=position_dodge(0.75))+ 142 | geom_jitter(aes(x=cell, y=Estimate,color=Group),size = 1.5, position = position_jitterdodge())+ 143 | scale_color_manual(name="Group",values = Group_color_panel)+ 144 | theme_bw() + 145 | theme(axis.text.x = element_text(size=13,angle = 45, hjust=1, vjust=1), axis.text.y = element_text(size=13),axis.ticks.length = unit(0.2,"cm"),legend.position= "bottom") + 146 | xlab("") + ylab("Cellular fraction (%) of B cells") + 147 | theme(axis.title.y=element_text(size=15),strip.text = element_text(size = 13)) 148 | # Save plot 149 | ggsave(p2, filename = paste(dir,"plot_out/B_across_treatment2.pdf", sep=""),width = 4, height = 5) 150 | 151 | library(ggsignif) 152 | compaired <- list(c("TN","MPR"),c("TN","NMPR"),c("MPR","NMPR")) 153 | ps <- list() 154 | for(i in unique(table.plot$cell)){ 155 | ps[[i]]<- ggplot(subset(table.plot,cell==i),aes(x=Group, y=Estimate,color=Group)) + 156 | geom_boxplot(width = 0.5,position=position_dodge(0.75),outlier.colour = NA)+ 157 | geom_jitter(size = 1.5, position = position_jitterdodge())+ 158 | scale_color_manual(name="Group",values = Group_color_panel)+ 159 | theme_bw() + 160 | theme(axis.text.x = element_text(size=13,angle = 45, hjust=1, vjust=1), axis.text.y = element_text(size=13),axis.ticks.length = unit(0.2,"cm")) + 161 | labs(x="",y="Cellular fraction (%) of B cells",title=i) + 162 | theme(axis.title.y=element_text(size=15),strip.text = element_text(size = 13))+ 163 | geom_signif(comparisons = compaired,step_increase = 0.1,map_signif_level = F,test = wilcox.test) 164 | } 165 | 166 | pdf(paste0(dir,"plot_out/B_fraction_each_major.pdf"),height=5,width=4) 167 | for(i in unique(table.plot$cell)){print(ps[[i]])} 168 | dev.off() 169 | 170 | ###### B Trajectory 171 | library(monocle) 172 | # select B 173 | B_tj<-subset(RNA, idents = c(0:5)) 174 | # Extract data, phenotype data, and feature data from the SeuratObject 175 | data <- as(as.matrix(B_tj@assays$RNA@counts), 'sparseMatrix') 176 | pd <- new('AnnotatedDataFrame', data = B_tj@meta.data) 177 | fData <- data.frame(gene_short_name = row.names(data), row.names = row.names(data)) 178 | fd <- new('AnnotatedDataFrame', data = fData) 179 | # Construct monocle cds 180 | monocle_cds <- newCellDataSet(data, 181 | phenoData = pd, 182 | featureData = fd, 183 | lowerDetectionLimit = 0.5, 184 | expressionFamily = negbinomial.size()) 185 | 186 | monocle_cds <- estimateSizeFactors(monocle_cds) 187 | monocle_cds <- estimateDispersions(monocle_cds) 188 | ## 189 | B_DEG_genes <- differentialGeneTest(monocle_cds, fullModelFormulaStr = '~B_cluster_annotation', cores = 30) 190 | ordering_genes <- row.names (subset(B_DEG_genes, qval < 0.01)) 191 | gene_check <- row.names(B_DEG_genes)[order(B_DEG_genes$qval)][1:400] 192 | #gene_id <- c() 193 | monocle_cds <- setOrderingFilter(monocle_cds,gene_check) 194 | monocle_cds <- reduceDimension( monocle_cds, 195 | max_components = 2, 196 | method = 'DDRTree') 197 | monocle_cds <- orderCells(monocle_cds) 198 | ClusterName_color_panel <- c("B0" = "#f28482","B1-IGHM" = "#118ab2","B2-HSPA1A" = "#84a59d","B3-IGHD"="#06d6a0","B4-FCRL4"="#e07a5f","B5-CD83"="#cdb4db") 199 | #"B6-RGS13"="#006d77" 200 | library(cowplot) 201 | pdf(paste0(dir,"plot_out/B_Pseudotime.pdf"),width = 8,height = 6) 202 | plot_cell_trajectory(monocle_cds, color_by = "Pseudotime",show_branch_points=F)+theme_cowplot() 203 | plot_cell_trajectory(monocle_cds, color_by = "B_cluster_annotation2",cell_size = 1,show_branch_points=F)+theme_cowplot()+ 204 | scale_color_manual(name = "",values = ClusterName_color_panel)+guides(color = guide_legend(override.aes = list(size=5)))+ 205 | theme(axis.text.y = element_text(size=15),axis.text.x = element_text(size=15),axis.title.y = element_text(size=18),axis.title.x = element_text(size=18),axis.ticks.length = unit(0.3,"cm")) 206 | dev.off() 207 | 208 | saveRDS(monocle_cds,"./data_out/B_monocle.rds") 209 | 210 | 211 | 212 | -------------------------------------------------------------------------------- /08.1_N_Nichenet.R: -------------------------------------------------------------------------------- 1 | library(Seurat) 2 | library(ggplot2) 3 | library(future) 4 | library(tidyverse) 5 | library(nichenetr) 6 | plan("multiprocess", workers = 8) 7 | options(future.globals.maxSize = 10*1024^3) 8 | 9 | dir <- "./" 10 | 11 | Neutro <- readRDS("Neutrophil.rds") 12 | 13 | ### Read in NicheNet’s ligand-target prior model, ligand-receptor network and weighted integrated networks 14 | ref_dir <- "/media/inspur/AS2150G2/HJJ/scrna/NicheNet/" 15 | ligand_target_matrix <- readRDS(paste0(ref_dir,"ligand_target_matrix.rds")) 16 | lr_network <- readRDS(paste0(ref_dir,"lr_network.rds")) 17 | weighted_networks <- readRDS(paste0(ref_dir,"weighted_networks.rds")) 18 | 19 | ##### NicheNet for Neu_CCL3 20 | G1 <- subset(Neutro,idents=1) 21 | G1_mat <- as.matrix(G1@assays$RNA@data) 22 | ### Define the gene set of interest and a background of genes 23 | G1_maker <- read.csv(paste0(dir,"data_out/Neutrophil_clusters.csv"),stringsAsFactors=F) 24 | G1_marker <- G1_maker %>% filter(cluster==1) %>% filter(avg_logFC > 0.5)%>% dplyr::top_n(50, avg_logFC) 25 | geneset_oi <- G1_marker$gene %>% .[. %in% rownames(ligand_target_matrix)] 26 | ### Define a background of genes 27 | expressed_genes_receiver <- G1_mat %>% apply(1,function(x){sum(x>0)/length(x)}) %>% .[. >= 0.1] %>% names() 28 | background_expressed_genes = expressed_genes_receiver %>% .[. %in% rownames(ligand_target_matrix)] 29 | ## define potential_ligands 30 | ligands <- lr_network %>% pull(from) %>% unique() 31 | expressed_ligands <- ligands ## here we used all ligands intersect(ligands,expressed_genes_sender) 32 | receptors <- lr_network %>% pull(to) %>% unique() 33 | expressed_receptors <- intersect(receptors,expressed_genes_receiver) 34 | lr_network_expressed <- lr_network %>% filter(from %in% expressed_ligands & to %in% expressed_receptors) 35 | head(lr_network_expressed) 36 | potential_ligands <- lr_network_expressed %>% pull(from) %>% unique() 37 | 38 | ### Perform NicheNet’s ligand activity analysis on the gene set of interest 39 | ligand_activities <- predict_ligand_activities(geneset = geneset_oi, 40 | background_expressed_genes = background_expressed_genes, 41 | ligand_target_matrix = ligand_target_matrix, 42 | potential_ligands = potential_ligands) 43 | best_upstream_ligands <- ligand_activities %>% top_n(20, pearson) %>% arrange(-pearson) %>% pull(test_ligand) 44 | 45 | ### Infer target genes of top-ranked ligands and visualize in a heatmap 46 | active_ligand_target_links_df <- best_upstream_ligands %>% lapply(get_weighted_ligand_target_links,geneset = geneset_oi, ligand_target_matrix = ligand_target_matrix, n = 250) %>% bind_rows() 47 | active_ligand_target_links_df <- na.omit(active_ligand_target_links_df) 48 | 49 | active_ligand_target_links <- prepare_ligand_target_visualization(ligand_target_df = active_ligand_target_links_df, ligand_target_matrix = ligand_target_matrix, cutoff = 0.25) 50 | 51 | order_ligands <- intersect(best_upstream_ligands, colnames(active_ligand_target_links)) %>% rev() 52 | order_targets <- active_ligand_target_links_df$target %>% unique() 53 | vis_ligand_target <- active_ligand_target_links[order_targets,order_ligands] %>% t() 54 | 55 | G1_specific <- vis_ligand_target %>% make_heatmap_ggplot("Pro G1 maturation ligands","G1-specific maturation signature", color = "red",legend_position = "top", x_axis_position = "top",legend_title = "Regulatory potential") + scale_fill_gradient2(low = "whitesmoke", high = "red", breaks = c(0,0.005,0.01)) + theme(axis.text.x = element_text(face = "italic")) 56 | pdf(paste0(dir,"plot_out/G1_NicheNetr.pdf"),width=,height=6) 57 | G1_specific 58 | dev.off() 59 | 60 | ##### NicheNet for Neu_IFIT3 61 | G2 <- subset(Neutro,idents=2) 62 | G2_mat <- as.matrix(G2@assays$RNA@data) 63 | ### Define the gene set of interest and a background of genes 64 | G2_maker <- read.csv(paste0(dir,"data_out/Neutrophil_clusters.csv"),stringsAsFactors=F) 65 | G2_marker <- G2_maker %>% filter(cluster==2) %>% filter(avg_logFC > 0.5)%>% dplyr::top_n(50, avg_logFC) 66 | geneset_oi <- G2_marker$gene %>% .[. %in% rownames(ligand_target_matrix)] 67 | ### Define a background of genes 68 | expressed_genes_receiver <- G2_mat %>% apply(1,function(x){sum(x>0)/length(x)}) %>% .[. >= 0.1] %>% names() 69 | background_expressed_genes = expressed_genes_receiver %>% .[. %in% rownames(ligand_target_matrix)] 70 | ## define potential_ligands 71 | ligands <- lr_network %>% pull(from) %>% unique() 72 | expressed_ligands <- ligands ## here we used all ligands intersect(ligands,expressed_genes_sender) 73 | receptors <- lr_network %>% pull(to) %>% unique() 74 | expressed_receptors <- intersect(receptors,expressed_genes_receiver) 75 | lr_network_expressed <- lr_network %>% filter(from %in% expressed_ligands & to %in% expressed_receptors) 76 | head(lr_network_expressed) 77 | potential_ligands <- lr_network_expressed %>% pull(from) %>% unique() 78 | 79 | ### Perform NicheNet’s ligand activity analysis on the gene set of interest 80 | ligand_activities <- predict_ligand_activities(geneset = geneset_oi, 81 | background_expressed_genes = background_expressed_genes, 82 | ligand_target_matrix = ligand_target_matrix, 83 | potential_ligands = potential_ligands) 84 | best_upstream_ligands <- ligand_activities %>% top_n(20, pearson) %>% arrange(-pearson) %>% pull(test_ligand) 85 | 86 | ### Infer target genes of top-ranked ligands and visualize in a heatmap 87 | active_ligand_target_links_df <- best_upstream_ligands %>% lapply(get_weighted_ligand_target_links,geneset = geneset_oi, ligand_target_matrix = ligand_target_matrix, n = 250) %>% bind_rows() 88 | active_ligand_target_links_df <- na.omit(active_ligand_target_links_df) 89 | 90 | active_ligand_target_links <- prepare_ligand_target_visualization(ligand_target_df = active_ligand_target_links_df, ligand_target_matrix = ligand_target_matrix, cutoff = 0.25) 91 | 92 | order_ligands <- intersect(best_upstream_ligands, colnames(active_ligand_target_links)) %>% rev() 93 | order_targets <- active_ligand_target_links_df$target %>% unique() 94 | vis_ligand_target <- active_ligand_target_links[order_targets,order_ligands] %>% t() 95 | 96 | G2_specific <- vis_ligand_target %>% make_heatmap_ggplot("Pro G2 maturation ligands","G2-specific maturation signature", color = "red",legend_position = "top", x_axis_position = "top",legend_title = "Regulatory potential") + scale_fill_gradient2(low = "whitesmoke", high = "red", breaks = c(0,0.005,0.01)) + theme(axis.text.x = element_text(face = "italic")) 97 | pdf(paste0(dir,"plot_out/G2_NicheNetr.pdf"),width=9,height=6) 98 | G2_specific 99 | dev.off() 100 | -------------------------------------------------------------------------------- /08.2_Neutrophil_SCENIC.R: -------------------------------------------------------------------------------- 1 | library(Seurat) 2 | 3 | dir <- "./" 4 | 5 | RNA <- readRDS("Neutrophil2_new.rds") 6 | 7 | ### input data prepare 8 | cellInfo <- RNA@meta.data[,c("N_cluster_annotation","nFeature_RNA","nCount_RNA")] 9 | colnames(cellInfo) <- c("CellType","nGene","nUMI") 10 | cellInfo$CellType <- as.character(cellInfo$CellType) 11 | dir.create("SCENIC") 12 | saveRDS(cellInfo, file=paste0(dir,"SCENIC/N_cellInfo.Rds")) 13 | colVars <- list(CellType=c("Neu_OSM" = "#f8766d","Neu_S100A12" = "#7cae00", 14 | "Neu_CCL3" = "#00bfc4","Neu_IFIT3"="#c77cff")) 15 | colVars$CellType <- colVars$CellType[intersect(names(colVars$CellType), cellInfo$CellType)] 16 | saveRDS(colVars, file=paste0(dir,"SCENIC/N_colVars.Rds")) 17 | 18 | exprMat <- as.matrix(RNA@assays$RNA@counts) 19 | 20 | ### Initialize SCENIC settings 21 | library(SCENIC) 22 | org <- "hgnc" # or hgnc, or dmel 23 | dbDir <- "/media/inspur/AS2150G2/HJJ/scrna/cisTarget_databases" # RcisTarget databases location 24 | myDatasetTitle <- "Fibro" # choose a name for your analysis 25 | data(defaultDbNames) 26 | dbs <- defaultDbNames[[org]] 27 | scenicOptions <- initializeScenic(org=org, dbDir=dbDir, dbs=dbs, datasetTitle=myDatasetTitle, nCores=20) 28 | 29 | scenicOptions@inputDatasetInfo$cellInfo <- "SCENIC/N_cellInfo.Rds" 30 | scenicOptions@inputDatasetInfo$colVars <- "SCENIC/N_colVars.Rds" 31 | 32 | saveRDS(scenicOptions, file=paste0(dir,"SCENIC/N_scenicOptions.Rds")) 33 | 34 | ### Co-expression network 35 | genesKept <- geneFiltering(exprMat, scenicOptions=scenicOptions, 36 | minCountsPerGene=3*.01*ncol(exprMat), 37 | minSamples=ncol(exprMat)*.01) 38 | 39 | ## check whether any known relevant genes are filtered-out 40 | interestingGenes <- c("NR4A1", "ID2", "CEBPB") 41 | # any missing? 42 | interestingGenes[which(!interestingGenes %in% genesKept)] 43 | 44 | exprMat_filtered <- exprMat[genesKept, ] 45 | dim(exprMat_filtered) 46 | 47 | ## Correlation 48 | runCorrelation(exprMat_filtered, scenicOptions) 49 | 50 | ## GENIE3 51 | # Optional: add log (if it is not logged/normalized already) 52 | exprMat_filtered_log <- log2(exprMat_filtered+1) 53 | 54 | # Run GENIE3 for 3K-5K cells, long time 55 | runGenie3(exprMat_filtered_log, scenicOptions) 56 | # for large cells, run GRNBoost (in Python) instead of GENIE3 57 | # exportsForArboreto(exprMat,scenicOption,dir = "./") 58 | 59 | ### Build and score the GRN (runSCENIC_…) 60 | exprMat_log <- log2(exprMat+1) 61 | 62 | scenicOptions <- readRDS("SCENIC/N_scenicOptions.Rds") 63 | scenicOptions@settings$verbose <- TRUE 64 | scenicOptions@settings$nCores <- 1 65 | scenicOptions@settings$seed <- 123 66 | 67 | # For a very quick run: 68 | # coexMethod=c("top5perTarget") 69 | scenicOptions@settings$dbs <- scenicOptions@settings$dbs["10kb"] # For toy run 70 | # save... 71 | 72 | scenicOptions <- runSCENIC_1_coexNetwork2modules(scenicOptions) 73 | scenicOptions <- runSCENIC_2_createRegulons(scenicOptions, coexMethod=c("top5perTarget")) #** Only for toy run!! 74 | scenicOptions <- runSCENIC_3_scoreCells(scenicOptions, exprMat_log) 75 | 76 | ## Regulators for known cell types or clusters 77 | regulonAUC <- loadInt(scenicOptions, "aucell_regulonAUC") 78 | regulonAUC <- regulonAUC[onlyNonDuplicatedExtended(rownames(regulonAUC)),] 79 | regulonActivity_byCellType <- sapply(split(rownames(cellInfo), cellInfo$CellType), 80 | function(cells) rowMeans(getAUC(regulonAUC)[,cells])) 81 | regulonActivity_byCellType_Scaled <- t(scale(t(regulonActivity_byCellType), center = T, scale=T)) 82 | pdf("SCENIC/N_SCENIC.pdf",width =5,height =6) 83 | ComplexHeatmap::Heatmap(regulonActivity_byCellType_Scaled, name="Regulon activity", 84 | column_names_side = "top",row_names_side = "right") 85 | dev.off() 86 | 87 | topRegulators <- reshape2::melt(regulonActivity_byCellType_Scaled) 88 | colnames(topRegulators) <- c("Regulon", "CellType", "RelativeActivity") 89 | topRegulators <- topRegulators[which(topRegulators$RelativeActivity>0),] 90 | viewTable(topRegulators) 91 | 92 | saveRDS(scenicOptions, file=paste0(dir,"SCENIC/N_scenicOptions.Rds")) 93 | saveRDS(regulonActivity_byCellType_Scaled, file=paste0(dir,"SCENIC/N_regulonActivity_byCellType_Scaled.Rds")) 94 | 95 | saveRDS(scenicOptions, file="SCENIC/N_scenicOptions.Rds") # To save status 96 | 97 | 98 | -------------------------------------------------------------------------------- /08.3_Neu_CCL3_Macro_SPP1_CellphoneDB.R: -------------------------------------------------------------------------------- 1 | library(Seurat) 2 | library(future) 3 | plan("multiprocess", workers = 8) 4 | options(future.globals.maxSize = 10*1024^3) 5 | 6 | dir <- "./" 7 | 8 | ## take Neu_CCL3 9 | Neutro <- readRDS("Neutrophil.rds") 10 | G1 <- subset(Neutro,idents=1) 11 | G1_count <- as.matrix(G1@assays$RNA@data) 12 | G1_meta <- data.frame(Cell=rownames(G1@meta.data), celltype = "Neu_CCL3") 13 | 14 | ## take Macro_SPP1 15 | MF <- readRDS("MF.rds") 16 | C1 <- subset(MF,idents=1) 17 | C1_count <- as.matrix(C1@assays$RNA@data) 18 | C1_meta <- data.frame(Cell=rownames(C1@meta.data), celltype = "Macro_SPP1") 19 | 20 | count <- merge(G1_count,C1_count,by=0) 21 | rownames(count) <- count[,1] 22 | count <- count[,-1] 23 | meta_data <- rbind(G1_meta,C1_meta) 24 | 25 | write.table(count, 'cellphonedb/G1_C1/G1_C1_count.txt', sep='\t', quote=F, row.names=T) 26 | write.table(meta_data, 'cellphonedb/G1_C1/G1_C1_meta.txt', sep='\t', quote=F, row.names=F) 27 | 28 | ################# cmd code ##################### 29 | cellphonedb method statistical_analysis --counts-data=gene_name --threads=20 --output-path=cellphonedb/G1_C1/ --pvalue 0.01 cellphonedb/G1_C1/G1_C1_meta.txt cellphonedb/G1_C1/G1_C1_count.txt 30 | cd cellphonedb/G1_C1/ 31 | cellphonedb plot dot_plot --means-path ./means.txt --pvalues-path ./pvalues.txt --output-path ./ 32 | cellphonedb plot heatmap_plot G1_C1_meta.txt --pvalues-path ./pvalues.txt --output-path ./ 33 | 34 | ## pick some L-R pair to plot 35 | library(dplyr) 36 | library(ggplot2) 37 | plot_dir <- paste0(dir,"cellphonedb/G1_C1/") 38 | mypvals <- read.delim(paste0(plot_dir,"pvalues.txt"), check.names = FALSE) 39 | mymeans <- read.delim(paste0(plot_dir,"significant_means.txt"), check.names = FALSE) 40 | # select cell pair 41 | keep <- c(which(mypvals$`Neu_CCL3|Macro_SPP1` < 0.01),which(mypvals$`Macro_SPP1|Neu_CCL3` < 0.01)) 42 | keep <- unique(keep) 43 | mypvals_keep <- mypvals[keep,] 44 | mypair <- intersect(mypvals_keep$interacting_pair,mymeans$interacting_pair) 45 | # pick out chemokines and so on 46 | chemokines <- grep("^CXC|CCL|CCR|CX3|XCL|XCR|^IL[0-9]", mypair,value = T) 47 | write.table(as.data.frame(chemokines),paste0(plot_dir,"G1_C1_chemokines.txt"),col.names=F,quote=F,row.names=F) 48 | costimulatory <- grep("CD86|CD80|CD48|LILRB2|LILRB4|TNF|CD2|ICAM|SLAM|LT[AB]|NECTIN2|CD40|CD70|CD27|CD28|CD58|TSLP|PVR|CD44|CD55|CD[1-9]", 49 | mypair,value = T) 50 | write.table(as.data.frame(costimulatory),paste0(plot_dir,"G1_C1_costimulatory.txt"),col.names=F,quote=F,row.names=F) 51 | coinhibitory <- grep("SIRP|CD47|ICOS|TIGIT|CTLA4|PC1D1|CD274|LAG3|HAVCR|VSIR|ENTPD1", 52 | mypair,value = T) 53 | write.table(as.data.frame(coinhibitory),paste0(plot_dir,"G1_C1_coinhibitory.txt"),col.names=F,quote=F,row.names=F) 54 | SPP1 <- grep("SPP1", mypair,value = T) 55 | write.table(as.data.frame(SPP1),paste0(plot_dir,"G1_C1_SPP1.txt"),col.names=F,quote=F,row.names=F) 56 | All_LR <- c(chemokines,costimulatory,coinhibitory,SPP1) 57 | write.table(as.data.frame(All_LR),paste0(plot_dir,"G1_C1_All_LR.txt"),col.names=F,quote=F,row.names=F) 58 | 59 | #### plot the selected L-R 60 | cd cellphonedb/G1_C1/ 61 | cellphonedb plot dot_plot --means-path ./means.txt --pvalues-path ./pvalues.txt --output-path ./ --rows G1_C1_chemokines.txt --columns pair_plot.txt --output-name G1_C1_chemokines.pdf 62 | cellphonedb plot dot_plot --means-path ./means.txt --pvalues-path ./pvalues.txt --output-path ./ --rows G1_C1_costimulatory.txt --columns pair_plot.txt --output-name G1_C1_costimulatory.pdf 63 | cellphonedb plot dot_plot --means-path ./means.txt --pvalues-path ./pvalues.txt --output-path ./ --rows G1_C1_coinhibitory.txt --columns pair_plot.txt --output-name G1_C1_coinhibitory.pdf 64 | cellphonedb plot dot_plot --means-path ./means.txt --pvalues-path ./pvalues.txt --output-path ./ --rows G1_C1_SPP1.txt --columns pair_plot.txt --output-name G1_C1_SPP1.pdf 65 | cellphonedb plot dot_plot --means-path ./means.txt --pvalues-path ./pvalues.txt --output-path ./ --rows G1_C1_All_LR.txt --columns pair_plot.txt --output-name G1_C1_All_LR.pdf 66 | cellphonedb plot dot_plot --means-path ./means.txt --pvalues-path ./pvalues.txt --output-path ./ --rows G1_C1_plot.txt --columns pair_plot.txt --output-name G1_C1_plot.pdf 67 | -------------------------------------------------------------------------------- /08_Neutrophil_analysis_new.R: -------------------------------------------------------------------------------- 1 | library(Seurat) 2 | library(ggplot2) 3 | library(tidyverse) 4 | 5 | dir <- "./" 6 | RNA <- readRDS("Neutrophil2_new.rds") 7 | 8 | ###### Heatmap plot 9 | features=c("FCGR3B","SELL","CXCR4","CXCR2","CXCR1","CXCL8","IL1B","CCL3","CCL4","CCL4L2","S100A12","S100A9","S100A8","CYBB","ELANE","MMP9","PADI4","HMGB1","TNF","CXCL9","CXCL10","OSM","PTGS2", 10 | "ARG1","TGFB1","VEGFA","PROK2","IFIT1","IFIT2","IFIT3","RSAD2","CD274","IDO1") 11 | row_split = c(rep("Receptors",5),rep("Chemokines",5),rep("Granules",6),rep("NETs",2),rep("Pro-inflammatory",5),rep("Anti-inflammatory",4),rep("ISGs",4),rep("Checkpoints",2)) 12 | row_split = factor(row_split,levels = c("Receptors","Chemokines","Granules","NETs","Pro-inflammatory","Anti-inflammatory","ISGs","Checkpoints")) 13 | ### plot heatmap 14 | source(paste0(dir,"code_clean/Heat_Dot_data.R")) 15 | ### set colnames order 16 | plot_ord <- c("Neu_S100A12","Neu_OSM","Neu_IFIT3","Neu_CCL3") 17 | 18 | data.plot <- Heat_Dot_data(object=RNA,features=features,group.by="N_cluster_annotation") 19 | exp.mat <- data.plot %>% select(features.plot,id,avg.exp.scaled) %>% spread(id,avg.exp.scaled) 20 | rownames(exp.mat) <- exp.mat$features.plot 21 | exp.mat$features.plot <- NULL 22 | exp.mat <- exp.mat[,plot_ord] 23 | per.mat <- data.plot %>% select(features.plot,id,pct.exp) %>% spread(id,pct.exp) 24 | rownames(per.mat) <- per.mat$features.plot 25 | per.mat$features.plot <- NULL 26 | per.mat <- per.mat[,plot_ord]/100 27 | min(exp.mat);max(exp.mat) 28 | 29 | ### plot heatmap 30 | library(ComplexHeatmap) 31 | library(circlize) ## color 32 | # set color gradient 33 | col_fun <- colorRamp2(c(-1.5, 0, 1.5), c("#118ab2", "#fdffb6", "#e63946")) 34 | # left annotation 35 | annot = c("Receptors","Chemokines","Granules","NETs","Pro-inflammatory","Anti-inflammatory","ISGs","Checkpoints") 36 | 37 | ha = HeatmapAnnotation(df = data.frame(Marker=row_split),which = "row", 38 | col = list(Marker = c("Receptors" = "#e76f51", "Chemokines"="#0077b6","Granules"="#ddbea9", 39 | "NETs"="#00b4d8","Pro-inflammatory"="#dc2f02","Anti-inflammatory"="#f4a261", 40 | "ISGs"="#57cc99","Checkpoints"="#b5838d"))) 41 | pdf(paste0(dir,"plot_out/N_maker_heat_new_new.pdf"),width = 5,height = 11) 42 | Heatmap(exp.mat, col = col_fun,cluster_columns = F,cluster_rows = F, 43 | show_column_names = T,show_row_names = T,rect_gp=gpar(col="grey"), 44 | column_names_side = "top",row_names_side = "right", 45 | row_split = row_split, 46 | row_gap = unit(3, "mm"), 47 | left_annotation = ha, 48 | heatmap_legend_param=list(title = "Expression",legend_height=unit(3, "cm"))) 49 | dev.off() 50 | 51 | pdf(paste0(dir,"plot_out/N_maker_heat_new2_new.pdf"),width = 4.3,height = 14) 52 | Heatmap(exp.mat, col = col_fun,cluster_columns = F,cluster_rows = F, 53 | show_column_names = T,show_row_names = T,rect_gp=gpar(type = "none"), 54 | cell_fun = function(j, i, x, y, width, height, fill){ 55 | grid.rect(x = x, y = y, width = width, height = height,gp = gpar(col = "grey", fill = NA)) 56 | grid.circle(x = x, y = y,r=per.mat[i,j]/2 * max(unit.c(width, height)),gp = gpar(fill = col_fun(exp.mat[i, j]), col = NA))}, 57 | column_names_side = "top",row_names_side = "right", 58 | row_split = row_split, 59 | row_gap = unit(3, "mm"), 60 | left_annotation = ha, 61 | heatmap_legend_param=list(title = "Expression",legend_height=unit(3, "cm"))) 62 | dev.off() 63 | 64 | ###Calculate cell fractions in different response groups 65 | source(paste0(dir,"code_clean/Cal_fraction.R")) 66 | tab.1 <- cal_fraction(RNA,"N_cluster_annotation") 67 | tab.1$cell <- factor(tab.1$cell, levels=c("Neu_OSM","Neu_S100A12","Neu_CCL3","Neu_IFIT3")) 68 | Group_color_panel <- c("TN"="#228B22","MPR"="#FF4500","NMPR"="#757bc8") 69 | # plot 70 | p1<- ggplot(tab.1, aes(x=Group, y=Estimate)) + 71 | geom_bar(stat = "identity", aes(fill=Group)) + 72 | scale_fill_manual(name = "Group", values = Group_color_panel) + facet_grid(~ cell) + 73 | theme_bw() + 74 | theme(axis.text.x = element_text(size=15,angle = 45, hjust=1, vjust=1), axis.text.y = element_text(size=15),axis.ticks.length = unit(0.2,"cm"),legend.position= "bottom") + 75 | xlab("") + ylab("Cellular fraction (%) of neutrophil") + 76 | theme(axis.title.y=element_text(size=16),strip.text = element_text(size = 13))+ 77 | geom_errorbar(aes(ymin=lower, ymax=upper), width=.2,position=position_dodge(0.05)) 78 | # Save plot 79 | ggsave(p1, filename = paste0(dir,"plot_out/N_across_treatment_new.pdf"),width = 6, height = 5) 80 | 81 | source(paste0(dir,"code_clean/Cal_fraction_patients.R")) 82 | tab.2 <- cal_fraction_patients(RNA,"N_cluster_annotation") 83 | tab.2$cell <- gsub("\\.[0-9]{1,}","",rownames(tab.2)) 84 | tab.2$cell <- gsub("\\."," ",tab.2$cell) 85 | tab.2$cell <- factor(tab.2$cell, levels =c("Neu_OSM","Neu_S100A12","Neu_CCL3","Neu_IFIT3")) 86 | #colnames(tab.2)[4] <- "Patient_ID" 87 | clin_info <- read.csv("clin_info.csv",header=T,stringsAsFactors=F) 88 | sample_info <- clin_info[,c("Patient_ID","Group")] 89 | table.plot <- merge(tab.2,sample_info,by="Patient_ID") 90 | table.plot$Group <- factor(table.plot$Group,levels=c("TN","MPR","NMPR")) 91 | 92 | pdf(paste0(dir,"plot_out/N_across_treatment3_new.pdf"),width =6,height = 5) 93 | p1+geom_point(data=table.plot,aes(x=Group, y=Estimate,color=Patient_ID),size = 1.5) 94 | dev.off() 95 | 96 | # boxplot 97 | p2<- ggplot(table.plot) + 98 | geom_boxplot(aes(x=cell, y=Estimate,color=Group,outlier.colour = NA),width = 0.6,position=position_dodge(0.75))+ 99 | geom_jitter(aes(x=cell, y=Estimate,color=Group),size = 1.5, position = position_jitterdodge())+ 100 | scale_color_manual(name="Group",values = Group_color_panel)+ 101 | theme_bw() + 102 | theme(axis.text.x = element_text(size=13,angle = 45, hjust=1, vjust=1), axis.text.y = element_text(size=13),axis.ticks.length = unit(0.2,"cm"),legend.position= "bottom") + 103 | xlab("") + ylab("Cellular fraction (%) of neutrophil") + 104 | theme(axis.title.y=element_text(size=15),strip.text = element_text(size = 13)) 105 | # Save plot 106 | ggsave(p2, filename = paste0(dir,"plot_out/N_across_treatment2_new.pdf"),width = 6, height = 5) 107 | 108 | library(ggsignif) 109 | compaired <- list(c("TN","MPR"),c("TN","NMPR"),c("MPR","NMPR")) 110 | ps <- list() 111 | for(i in unique(table.plot$cell)){ 112 | ps[[i]]<- ggplot(subset(table.plot,cell==i),aes(x=Group, y=Estimate,color=Group)) + 113 | geom_boxplot(width = 0.5,position=position_dodge(0.75),outlier.colour = NA)+ 114 | geom_jitter(size = 1.5, position = position_jitterdodge())+ 115 | scale_color_manual(name="Group",values = Group_color_panel)+ 116 | theme_bw() + 117 | theme(axis.text.x = element_text(size=13,angle = 45, hjust=1, vjust=1), axis.text.y = element_text(size=13),axis.ticks.length = unit(0.2,"cm")) + 118 | labs(x="",y="Cellular fraction (%) of all cells",title=i) + 119 | theme(axis.title.y=element_text(size=15),strip.text = element_text(size = 13))+ 120 | geom_signif(comparisons = compaired,step_increase = 0.1,map_signif_level = F,test = wilcox.test) 121 | } 122 | 123 | pdf(paste0(dir,"plot_out/N_fraction_each_cell_new.pdf"),height=5,width=4) 124 | for(i in unique(table.plot$cell)){print(ps[[i]])} 125 | dev.off() 126 | 127 | ####### trajactory analysis ###### 128 | library(monocle) 129 | data <- as(as.matrix(RNA@assays$RNA@counts), 'sparseMatrix') 130 | pd <- new('AnnotatedDataFrame', data = RNA@meta.data) 131 | fData <- data.frame(gene_short_name = row.names(data), row.names = row.names(data)) 132 | fd <- new('AnnotatedDataFrame', data = fData) 133 | # Construct monocle cds 134 | monocle_cds <- newCellDataSet(data, 135 | phenoData = pd, 136 | featureData = fd, 137 | lowerDetectionLimit = 0.5, 138 | expressionFamily = negbinomial.size()) 139 | 140 | monocle_cds <- estimateSizeFactors(monocle_cds) 141 | monocle_cds <- estimateDispersions(monocle_cds) 142 | ## 143 | monocle_cds <- detectGenes(monocle_cds, min_expr = 0.1) 144 | expressed_genes <- row.names(subset(fData(monocle_cds),num_cells_expressed >= 10)) 145 | Neu_DEG_genes <- differentialGeneTest(monocle_cds[expressed_genes,], fullModelFormulaStr = '~N_cluster_annotation', cores = 20) 146 | write.csv(Neu_DEG_genes,"data_out/Neu_monocle_DEG2.csv",quote=F) 147 | ordering_genes <- row.names (subset(Neu_DEG_genes, qval < 0.001)) 148 | length(ordering_genes) 149 | gene_id <- row.names(Neu_DEG_genes)[order(Neu_DEG_genes$qval)][1:1000] 150 | ## 151 | monocle_cds <- setOrderingFilter(monocle_cds, gene_id) 152 | monocle_cds <- reduceDimension( 153 | monocle_cds, 154 | max_components = 2, 155 | method = 'DDRTree') 156 | monocle_cds <- orderCells(monocle_cds) 157 | ClusterName_color_panel <- c("Neu_OSM" = "#f8766d", "Neu_S100A12" = "#7cae00", 158 | "Neu_CCL3" = "#00bfc4","Neu_IFIT3"="#c77cff") 159 | library(cowplot) 160 | pdf(paste0(dir,"plot_out/Neu_Pseudotime_new.pdf"),width = 8,height = 5) 161 | plot_cell_trajectory(monocle_cds, color_by = "Pseudotime",show_branch_points=F)+theme_cowplot() 162 | plot_cell_trajectory(monocle_cds, color_by = "N_cluster_annotation",cell_size = 1,show_branch_points=F)+theme_cowplot()+ 163 | scale_color_manual(name = "", values = ClusterName_color_panel)+guides(color = guide_legend(override.aes = list(size=5)))+ 164 | theme(axis.text.y = element_text(size=15),axis.text.x = element_text(size=15),axis.title.y = element_text(size=18),axis.title.x = element_text(size=18),axis.ticks.length = unit(0.2,"cm")) 165 | dev.off() 166 | 167 | saveRDS(monocle_cds,"./data_out/Neu_monocle_new.rds") 168 | 169 | plot_genes <- c("CXCR4","CXCR2") 170 | cds_subset <- monocle_cds[plot_genes,] 171 | plot_genes_in_pseudotime(cds_subset, color_by = "Group",ncol=2) 172 | source("code_clean/Monocle_plot_gene.R") 173 | monocle_theme_opts <- function () { 174 | theme(strip.background = element_rect(colour = "white", 175 | fill = "white")) + theme(panel.border = element_blank()) + 176 | theme(axis.line.x = element_line(size = 0.25, color = "black")) + 177 | theme(axis.line.y = element_line(size = 0.25, color = "black")) + 178 | theme(panel.grid.minor.x = element_blank(), panel.grid.minor.y = element_blank()) + 179 | theme(panel.grid.major.x = element_blank(), panel.grid.major.y = element_blank()) + 180 | theme(panel.background = element_rect(fill = "white")) + 181 | theme(legend.key = element_blank()) 182 | } 183 | pdf(paste0(dir,"plot_out/N_pseudo_CXCR4_new.pdf"),width = 4,height = 8) 184 | My_plot_gene_pseudotime(cds_subset, color_by = "Group",ncol=1) 185 | dev.off() 186 | 187 | ### density 188 | plotdf=pData(monocle_cds) 189 | library(ggridges) 190 | ggplot(plotdf, aes(x=Pseudotime,y=N_cluster_annotation,fill=N_cluster_annotation))+ 191 | geom_density_ridges(scale=1) + 192 | geom_vline(xintercept = c(5,10),linetype=2)+ 193 | scale_y_discrete("")+ 194 | theme_minimal()+ 195 | theme( 196 | panel.grid = element_blank() 197 | ) 198 | ggsave("plot_out/N_monocle_cluster_density.pdf",width = 6,height = 4) 199 | 200 | ggplot(plotdf, aes(x=Pseudotime,y=Group,fill=Group))+ 201 | geom_density_ridges(scale=1) + 202 | geom_vline(xintercept = c(5,10),linetype=2)+ 203 | scale_y_discrete("")+ 204 | theme_minimal()+ 205 | theme( 206 | panel.grid = element_blank() 207 | ) 208 | ggsave("plot_out/N_monocle_Group_density.pdf",width =5,height = 4) 209 | 210 | # CCL3 and CCL4 211 | N1 <- subset(RNA,N_cluster_annotation=="Neu_CCL3") 212 | N1.gene <- FetchData(object = N1, vars = c("CCL3","CCL4","CXCL8","VEGFA")) 213 | N1.gene$Group <- N1$Group 214 | library(ggsignif) 215 | Group_color_panel <- c("TN"="#228B22","MPR"="#FF4500","NMPR"="#757bc8") 216 | compaired <- list(c("TN","MPR"),c("TN","NMPR"),c("MPR","NMPR")) 217 | p <- ggplot(data=N1.gene,aes(x=factor(Group,levels=c("TN","MPR","NMPR")),y=CXCL8,fill=Group)) + 218 | geom_violin(color="white")+ 219 | geom_boxplot(width=0.1,position=position_dodge(0.9),fill="white") + theme_cowplot()+ 220 | scale_fill_manual(name = "Group", values = Group_color_panel)+ 221 | theme(axis.text.x = element_text(size=10,angle = 45, hjust=1, vjust=1), axis.text.y = element_text(size=10),axis.ticks.length = unit(0.2,"cm"))+ 222 | NoLegend()+labs(x="")+geom_signif(comparisons = compaired,step_increase = 0.1,map_signif_level = F,test = wilcox.test) 223 | ggsave(paste0(dir,"plot_out/N1_CXCL8_treatment_new.pdf"),p,width =3,height =4) 224 | 225 | #### branch heatmap 226 | BEAM_res <- BEAM(monocle_cds, branch_point = 1, cores = 1) 227 | BEAM_res <- BEAM_res[order(BEAM_res$qval),] 228 | BEAM_res <- BEAM_res[,c("gene_short_name", "pval", "qval")] 229 | tmp1=plot_genes_branched_heatmap(monocle_cds[row.names(subset(BEAM_res, 230 | qval < 1e-6)),], 231 | branch_point = 1, 232 | num_clusters = 3, 233 | cores = 1, 234 | use_gene_short_name = T, 235 | show_rownames = F, 236 | return_heatmap = T) 237 | pdf(paste0(dir,"plot_out/N_monocle_brach_heatmap.pdf"),width=5,height=7) 238 | tmp1$ph_res 239 | dev.off() 240 | ## GO-BP analysis 241 | gene_group <- tmp1$annotation_row 242 | gene_group$gene <- rownames(gene_group) 243 | library(clusterProfiler) 244 | library(org.Hs.eg.db) 245 | allcluster_go <- data.frame() 246 | for(i in unique(gene_group$Cluster)){ 247 | samll_gene_group= filter(gene_group,gene_group$Cluster==i) 248 | df_name = bitr(samll_gene_group$gene,fromType="SYMBOL",toType=c("ENTREZID"),OrgDb="org.Hs.eg.db") 249 | go <- enrichGO(gene=unique(df_name$ENTREZID), 250 | OrgDb=org.Hs.eg.db, 251 | keyType="ENTREZID", 252 | ont="BP", 253 | pAdjustMethod="BH", 254 | pvalueCutoff=0.05, 255 | qvalueCutoff=0.05, 256 | readable=T) 257 | go_res=go@result 258 | if(dim(go_res)[1] !=0){ 259 | go_res$cluster=i 260 | allcluster_go=rbind(allcluster_go,go_res) 261 | } 262 | } 263 | write.csv(allcluster_go,"data_out/N_monocle_brach_BP.csv") 264 | 265 | ###### pseudo-time heatmap 266 | heat_cds <- monocle_cds[gene_id ,] 267 | tmp2=plot_pseudotime_heatmap(heat_cds, 268 | num_clusters = 4, 269 | cores = 1, 270 | show_rownames = F, 271 | return_heatmap = T) 272 | pdf(paste0(dir,"plot_out/N_monocle_pseudotime_heatmap.pdf"),width=5,height=7) 273 | print(tmp2) 274 | dev.off() 275 | ## GO-BP analysis 276 | gene_group <- data.frame(Cluster = factor(cutree(tmp2$tree_row,4))) 277 | gene_group$gene <- rownames(gene_group) 278 | head(gene_group) 279 | library(clusterProfiler) 280 | library(org.Hs.eg.db) 281 | allcluster_go <- data.frame() 282 | for(i in unique(gene_group$Cluster)){ 283 | samll_gene_group= filter(gene_group,gene_group$Cluster==i) 284 | df_name = bitr(samll_gene_group$gene,fromType="SYMBOL",toType=c("ENTREZID"),OrgDb="org.Hs.eg.db") 285 | go <- enrichGO(gene=unique(df_name$ENTREZID), 286 | OrgDb=org.Hs.eg.db, 287 | keyType="ENTREZID", 288 | ont="BP", 289 | pAdjustMethod="BH", 290 | pvalueCutoff=0.05, 291 | qvalueCutoff=0.05, 292 | readable=T) 293 | go_res=go@result 294 | if(dim(go_res)[1] !=0){ 295 | go_res$cluster=i 296 | allcluster_go=rbind(allcluster_go,go_res) 297 | } 298 | } 299 | write.csv(allcluster_go,"data_out/N_monocle_pseudotime_BP.csv") 300 | 301 | ###Calculate fraction of major population in different response groups 302 | source(paste0(dir,"code_clean/Cal_fraction.R")) 303 | tab.1 <- cal_fraction(RNA,"N_major_cluster") 304 | tab.1$cell <- factor(tab.1$cell, levels=c("mature","aged")) 305 | Group_color_panel <- c("TN"="#228B22","MPR"="#FF4500","NMPR"="#757bc8") 306 | # plot 307 | p1<- ggplot(tab.1, aes(x=Group, y=Estimate)) + 308 | geom_bar(stat = "identity", aes(fill=Group)) + 309 | scale_fill_manual(name = "Group", values = Group_color_panel) + facet_grid(~ cell) + 310 | theme_bw() + 311 | theme(axis.text.x = element_text(size=15,angle = 45, hjust=1, vjust=1), axis.text.y = element_text(size=15),axis.ticks.length = unit(0.2,"cm"),legend.position= "bottom") + 312 | xlab("") + ylab("Cellular fraction (%) of neutrophil") + 313 | theme(axis.title.y=element_text(size=16),strip.text = element_text(size = 13))+ 314 | geom_errorbar(aes(ymin=lower, ymax=upper), width=.2,position=position_dodge(0.05)) 315 | # Save plot 316 | ggsave(p1, filename = paste0(dir,"plot_out/N_major_across_treatment.pdf"),width = 3.2, height = 5) 317 | 318 | source(paste0(dir,"code_clean/Cal_fraction_patients.R")) 319 | tab.2 <- cal_fraction_patients(RNA,"N_major_cluster") 320 | tab.2$cell <- gsub("\\.[0-9]{1,}","",rownames(tab.2)) 321 | tab.2$cell <- gsub("\\."," ",tab.2$cell) 322 | tab.2$cell <- factor(tab.2$cell, levels =c("mature","aged")) 323 | #colnames(tab.2)[4] <- "Patient_ID" 324 | clin_info <- read.csv("clin_info.csv",header=T,stringsAsFactors=F) 325 | sample_info <- clin_info[,c("Patient_ID","Group")] 326 | table.plot <- merge(tab.2,sample_info,by="Patient_ID") 327 | table.plot$Group <- factor(table.plot$Group,levels=c("TN","MPR","NMPR")) 328 | 329 | pdf(paste0(dir,"plot_out/N_major_across_treatment3.pdf"),width = 3.2,height = 5) 330 | p1+geom_point(data=table.plot,aes(x=Group, y=Estimate,color=Patient_ID),size = 1.5) 331 | dev.off() 332 | 333 | # boxplot 334 | p2<- ggplot(table.plot) + 335 | geom_boxplot(aes(x=cell, y=Estimate,color=Group,outlier.colour = NA),width = 0.6,position=position_dodge(0.75))+ 336 | geom_jitter(aes(x=cell, y=Estimate,color=Group),size = 1.5, position = position_jitterdodge())+ 337 | scale_color_manual(name="Group",values = Group_color_panel)+ 338 | theme_bw() + 339 | theme(axis.text.x = element_text(size=13,angle = 45, hjust=1, vjust=1), axis.text.y = element_text(size=13),axis.ticks.length = unit(0.2,"cm"),legend.position= "bottom") + 340 | xlab("") + ylab("Cellular fraction (%) of neutrophil") + 341 | theme(axis.title.y=element_text(size=15),strip.text = element_text(size = 13)) 342 | # Save plot 343 | ggsave(p2, filename = paste0(dir,"plot_out/N_major_across_treatment2.pdf"),width = 3.2, height = 5) 344 | 345 | library(ggsignif) 346 | compaired <- list(c("TN","MPR"),c("TN","NMPR"),c("MPR","NMPR")) 347 | ps <- list() 348 | for(i in unique(table.plot$cell)){ 349 | ps[[i]]<- ggplot(subset(table.plot,cell==i),aes(x=Group, y=Estimate,color=Group)) + 350 | geom_boxplot(width = 0.5,position=position_dodge(0.75),outlier.colour = NA)+ 351 | geom_jitter(size = 1.5, position = position_jitterdodge())+ 352 | scale_color_manual(name="Group",values = Group_color_panel)+ 353 | theme_bw() + 354 | theme(axis.text.x = element_text(size=13,angle = 45, hjust=1, vjust=1), axis.text.y = element_text(size=13),axis.ticks.length = unit(0.2,"cm")) + 355 | labs(x="",y="Cellular fraction (%) of all cells",title=i) + 356 | theme(axis.title.y=element_text(size=15),strip.text = element_text(size = 13))+ 357 | geom_signif(comparisons = compaired,step_increase = 0.1,map_signif_level = F,test = wilcox.test) 358 | } 359 | 360 | pdf(paste0(dir,"plot_out/N_major_fraction_each_cell.pdf"),height=5,width=4) 361 | for(i in unique(table.plot$cell)){print(ps[[i]])} 362 | dev.off() 363 | 364 | 365 | 366 | -------------------------------------------------------------------------------- /Cal_fraction.R: -------------------------------------------------------------------------------- 1 | library(tidyr) 2 | library(reshape) 3 | library(ggthemes) 4 | library(rcompanion) 5 | library(GGally) 6 | library(ggrepel) 7 | library(qdapTools) 8 | library(REdaS) 9 | 10 | ### calculate cellular fraction 11 | cal_fraction <- function(SeuratObj,cluster){ 12 | meta.temp <- SeuratObj@meta.data[,c(cluster, "Group")] 13 | # Create list to store frequency tables 14 | prop.table.error <- list() 15 | for(i in 1:length(unique(SeuratObj@meta.data$Group))){ 16 | vec.temp <- meta.temp[SeuratObj@meta.data$Group==unique(SeuratObj@meta.data$Group)[i],cluster] 17 | # Convert to counts and calculate 95% CI 18 | # Store in list 19 | table.temp <- freqCI(vec.temp, level = c(.95)) 20 | prop.table.error[[i]] <- print(table.temp, percent = TRUE, digits = 3) 21 | # 22 | } 23 | # Name list 24 | names(prop.table.error) <- unique(meta.temp$Group) 25 | # Convert to data frame 26 | tab.1 <- as.data.frame.array(do.call(rbind, prop.table.error)) 27 | # Add Group column 28 | b <- c() 29 | a <- c() 30 | for(i in names(prop.table.error)){ 31 | a <- rep(i,nrow(prop.table.error[[1]])) 32 | b <- c(b,a) 33 | } 34 | tab.1$Group <- b 35 | # Add common cell names 36 | tab.1$cell <- gsub("\\.[0-9]","",row.names(tab.1)) 37 | tab.1$cell <- gsub("\\."," ",tab.1$cell) 38 | # Resort factor Group 39 | tab.1$Group <- factor(tab.1$Group, levels = c("TN", "MPR", "NMPR")) 40 | # Rename percentile columns 41 | colnames(tab.1)[1] <- "lower" 42 | colnames(tab.1)[3] <- "upper" 43 | return(tab.1) 44 | } -------------------------------------------------------------------------------- /Cal_fraction_patients.R: -------------------------------------------------------------------------------- 1 | library(REdaS) 2 | 3 | ### calculate cellular fraction 4 | cal_fraction_patients <- function(SeuratObj,cluster){ 5 | meta.temp <- SeuratObj@meta.data[,c(cluster, "Patient_ID")] 6 | # Create list to store frequency tables 7 | prop.table.error <- list() 8 | for(i in 1:length(unique(SeuratObj@meta.data$Patient_ID))){ 9 | vec.temp <- meta.temp[SeuratObj@meta.data$Patient_ID==unique(SeuratObj@meta.data$Patient_ID)[i],cluster] 10 | # Convert to counts and calculate 95% CI 11 | # Store in list 12 | table.temp <- freqCI(vec.temp, level = c(.95)) 13 | prop.table.error[[i]] <- print(table.temp, percent = TRUE, digits = 3) 14 | # 15 | } 16 | # Name list 17 | names(prop.table.error) <- unique(meta.temp$Patient_ID) 18 | # Convert to data frame 19 | tab.1 <- as.data.frame.array(do.call(rbind, prop.table.error)) 20 | # Add Group column 21 | b <- c() 22 | a <- c() 23 | for(i in names(prop.table.error)){ 24 | a <- rep(i,nrow(prop.table.error[[1]])) 25 | b <- c(b,a) 26 | } 27 | tab.1$Patient_ID <- b 28 | # Add common cell names 29 | tab.1$cell <-rownames(tab.1) 30 | # tab.1$cell <- gsub("\\.[0-9]{1,}","",rownames(tab.1)) 31 | # tab.1$cell <- gsub("\\."," ",tab.1$cell) 32 | # Rename percentile columns 33 | colnames(tab.1)[1] <- "lower" 34 | colnames(tab.1)[3] <- "upper" 35 | colnames(tab.1)[4] <- "Patient_ID" 36 | return(tab.1) 37 | } -------------------------------------------------------------------------------- /GSVA.R: -------------------------------------------------------------------------------- 1 | ##GSVA 2 | require(GSVA) 3 | require(GSEABase) 4 | require(GSVAdata) 5 | require(clusterProfiler) 6 | data(c2BroadSets) 7 | library(limma) 8 | ## kcdf: kcdf="Gaussian" for continuous and 'Poisson for integer counts' 9 | 10 | GSVA_run <- function(SeuratObj,cluster_name,cluster1,cluster2,gmtFile,kcdf){ 11 | hallgmt <- read.gmt(gmtFile) 12 | hall_list = split(hallgmt$gene, hallgmt$ont) 13 | expr=as.matrix(SeuratObj@assays$RNA@data) 14 | hall <- gsva(expr, hall_list, parallel.sz=10,kcdf=kcdf) 15 | ## get DE pathways 16 | group <- factor(SeuratObj@meta.data[,cluster_name],levels = c(cluster1,cluster2),ordered = F) 17 | design <- model.matrix(~0+group) 18 | colnames(design) <- c("C1","C2") 19 | rownames(design) <- colnames(hall) 20 | 21 | fit <- lmFit(hall,design) 22 | cont.matrix=makeContrasts('C1-C2',levels = design) 23 | fit2=contrasts.fit(fit,cont.matrix) 24 | fit2=eBayes(fit2) 25 | 26 | gs <- topTable(fit2,adjust='BH', number=Inf, p.value=0.05) 27 | gs$cluster <- ifelse(gs$t > 0 , "C1", "C2") 28 | return(gs) 29 | } 30 | 31 | GSVA_run2 <- function(SeuratObj,cluster_name,cluster1,cluster2,kcdf){ 32 | expr=as.matrix(SeuratObj@assays$RNA@data) 33 | ## change gene symbol to geneid 34 | gene_entrezid <- bitr(rownames(expr), fromType = "SYMBOL", toType = "ENTREZID", OrgDb = "org.Hs.eg.db") 35 | expression_filt <- expr[gene_entrezid$SYMBOL,] 36 | rownames(expression_filt) <- gene_entrezid$ENTREZID 37 | expression_filt <- as.matrix(expression_filt) 38 | 39 | hall <- gsva(expression_filt, c2BroadSets, parallel.sz=10,kcdf=kcdf) 40 | ## get DE pathways 41 | group <- factor(SeuratObj@meta.data[,cluster_name],levels = c(cluster1,cluster2),ordered = F) 42 | design <- model.matrix(~0+group) 43 | colnames(design) <- c("C1","C2") 44 | rownames(design) <- colnames(hall) 45 | 46 | fit <- lmFit(hall,design) 47 | cont.matrix=makeContrasts('C1-C2',levels = design) 48 | fit2=contrasts.fit(fit,cont.matrix) 49 | fit2=eBayes(fit2) 50 | 51 | gs <- topTable(fit2,adjust='BH', number=Inf, p.value=0.05) 52 | gs$cluster <- ifelse(gs$t > 0 , "C1", "C2") 53 | return(gs) 54 | } 55 | -------------------------------------------------------------------------------- /Heat_Dot_data.R: -------------------------------------------------------------------------------- 1 | Heat_Dot_data <- function (object, assay = NULL, features, cols = c("lightgrey", 2 | "red"), col.min = -2.5, col.max = 2.5, dot.min = 0, dot.scale = 6, 3 | idents = NULL, group.by = NULL, split.by = NULL, cluster.idents = FALSE, 4 | scale = TRUE, scale.by = "radius", scale.min = NA, scale.max = NA) 5 | { 6 | # assay <- assay %||% DefaultAssay(object = object) 7 | # DefaultAssay(object = object) <- assay 8 | split.colors <- !is.null(x = split.by) && !any(cols %in% 9 | rownames(x = brewer.pal.info)) 10 | scale.func <- switch(EXPR = scale.by, size = scale_size, 11 | radius = scale_radius, stop("'scale.by' must be either 'size' or 'radius'")) 12 | feature.groups <- NULL 13 | if (is.list(features) | any(!is.na(names(features)))) { 14 | feature.groups <- unlist(x = sapply(X = 1:length(features), 15 | FUN = function(x) { 16 | return(rep(x = names(x = features)[x], each = length(features[[x]]))) 17 | })) 18 | if (any(is.na(x = feature.groups))) { 19 | warning("Some feature groups are unnamed.", call. = FALSE, 20 | immediate. = TRUE) 21 | } 22 | features <- unlist(x = features) 23 | names(x = feature.groups) <- features 24 | } 25 | cells <- unlist(x = CellsByIdentities(object = object, idents = idents)) 26 | data.features <- FetchData(object = object, vars = features, 27 | cells = cells) 28 | data.features$id <- if (is.null(x = group.by)) { 29 | Idents(object = object)[cells, drop = TRUE] 30 | } 31 | else { 32 | object[[group.by, drop = TRUE]][cells, drop = TRUE] 33 | } 34 | if (!is.factor(x = data.features$id)) { 35 | data.features$id <- factor(x = data.features$id) 36 | } 37 | id.levels <- levels(x = data.features$id) 38 | data.features$id <- as.vector(x = data.features$id) 39 | if (!is.null(x = split.by)) { 40 | splits <- object[[split.by, drop = TRUE]][cells, drop = TRUE] 41 | if (split.colors) { 42 | if (length(x = unique(x = splits)) > length(x = cols)) { 43 | stop("Not enough colors for the number of groups") 44 | } 45 | cols <- cols[1:length(x = unique(x = splits))] 46 | names(x = cols) <- unique(x = splits) 47 | } 48 | data.features$id <- paste(data.features$id, splits, 49 | sep = "_") 50 | unique.splits <- unique(x = splits) 51 | id.levels <- paste0(rep(x = id.levels, each = length(x = unique.splits)), 52 | "_", rep(x = unique(x = splits), times = length(x = id.levels))) 53 | } 54 | data.plot <- lapply(X = unique(x = data.features$id), FUN = function(ident) { 55 | data.use <- data.features[data.features$id == ident, 56 | 1:(ncol(x = data.features) - 1), drop = FALSE] 57 | avg.exp <- apply(X = data.use, MARGIN = 2, FUN = function(x) { 58 | return(mean(x = expm1(x = x))) 59 | }) 60 | pct.exp <- apply(X = data.use, MARGIN = 2, FUN = function (x) { 61 | return(length(x = x[x > 0])/length(x = x))}) 62 | return(list(avg.exp = avg.exp, pct.exp = pct.exp)) 63 | }) 64 | names(x = data.plot) <- unique(x = data.features$id) 65 | if (cluster.idents) { 66 | mat <- do.call(what = rbind, args = lapply(X = data.plot, 67 | FUN = unlist)) 68 | mat <- scale(x = mat) 69 | id.levels <- id.levels[hclust(d = dist(x = mat))$order] 70 | } 71 | data.plot <- lapply(X = names(x = data.plot), FUN = function(x) { 72 | data.use <- as.data.frame(x = data.plot[[x]]) 73 | data.use$features.plot <- rownames(x = data.use) 74 | data.use$id <- x 75 | return(data.use) 76 | }) 77 | data.plot <- do.call(what = "rbind", args = data.plot) 78 | if (!is.null(x = id.levels)) { 79 | data.plot$id <- factor(x = data.plot$id, levels = id.levels) 80 | } 81 | if (length(x = levels(x = data.plot$id)) == 1) { 82 | scale <- FALSE 83 | warning("Only one identity present, the expression values will be not scaled", 84 | call. = FALSE, immediate. = TRUE) 85 | } 86 | avg.exp.scaled <- sapply(X = unique(x = data.plot$features.plot), 87 | FUN = function(x) { 88 | data.use <- data.plot[data.plot$features.plot == 89 | x, "avg.exp"] 90 | if (scale) { 91 | data.use <- scale(x = data.use) 92 | data.use <- MinMax(data = data.use, min = col.min, 93 | max = col.max) 94 | } 95 | else { 96 | data.use <- log1p(x = data.use) 97 | } 98 | return(data.use) 99 | }) 100 | avg.exp.scaled <- as.vector(x = t(x = avg.exp.scaled)) 101 | if (split.colors) { 102 | avg.exp.scaled <- as.numeric(x = cut(x = avg.exp.scaled, 103 | breaks = 20)) 104 | } 105 | data.plot$avg.exp.scaled <- avg.exp.scaled 106 | data.plot$features.plot <- factor(x = data.plot$features.plot, 107 | levels = features) 108 | data.plot$pct.exp[data.plot$pct.exp < dot.min] <- NA 109 | data.plot$pct.exp <- data.plot$pct.exp * 100 110 | if (split.colors) { 111 | splits.use <- vapply(X = as.character(x = data.plot$id), 112 | FUN = gsub, FUN.VALUE = character(length = 1L), 113 | pattern = paste0("^((", paste(sort(x = levels(x = object), 114 | decreasing = TRUE), collapse = "|"), ")_)"), 115 | replacement = "", USE.NAMES = FALSE) 116 | data.plot$colors <- mapply(FUN = function(color, value) { 117 | return(colorRampPalette(colors = c("grey", color))(20)[value]) 118 | }, color = cols[splits.use], value = avg.exp.scaled) 119 | } 120 | color.by <- ifelse(test = split.colors, yes = "colors", 121 | no = "avg.exp.scaled") 122 | if (!is.na(x = scale.min)) { 123 | data.plot[data.plot$pct.exp < scale.min, "pct.exp"] <- scale.min 124 | } 125 | if (!is.na(x = scale.max)) { 126 | data.plot[data.plot$pct.exp > scale.max, "pct.exp"] <- scale.max 127 | } 128 | if (!is.null(x = feature.groups)) { 129 | data.plot$feature.groups <- factor(x = feature.groups[data.plot$features.plot], 130 | levels = unique(x = feature.groups)) 131 | } 132 | # plot <- ggplot(data = data.plot, mapping = aes_string(x = "features.plot", 133 | # y = "id")) + geom_point(mapping = aes_string(size = "pct.exp", 134 | # color = color.by)) + scale.func(range = c(0, dot.scale), 135 | # limits = c(scale.min, scale.max)) + theme(axis.title.x = element_blank(), 136 | # axis.title.y = element_blank()) + guides(size = guide_legend(title = "Percent Expressed")) + 137 | # labs(x = "Features", y = ifelse(test = is.null(x = split.by), 138 | # yes = "Identity", no = "Split Identity")) + theme_cowplot() 139 | # if (!is.null(x = feature.groups)) { 140 | # plot <- plot + facet_grid(facets = ~feature.groups, 141 | # scales = "free_x", space = "free_x", switch = "y") + 142 | # theme(panel.spacing = unit(x = 1, units = "lines"), 143 | # strip.background = element_blank()) 144 | # } 145 | # if (split.colors) { 146 | # plot <- plot + scale_color_identity() 147 | # } 148 | # else if (length(x = cols) == 1) { 149 | # plot <- plot + scale_color_distiller(palette = cols) 150 | # } 151 | # else { 152 | # plot <- plot + scale_color_gradient(low = cols[1], high = cols[2]) 153 | # } 154 | # if (!split.colors) { 155 | # plot <- plot + guides(color = guide_colorbar(title = "Average Expression")) 156 | # } 157 | # return(plot) 158 | return(data.plot) 159 | } -------------------------------------------------------------------------------- /Monocle_plot_gene.R: -------------------------------------------------------------------------------- 1 | My_plot_gene_pseudotime <- function (cds_subset, min_expr = NULL, cell_size = 0.75, nrow = NULL, 2 | ncol = 1, panel_order = NULL, color_by = "State", trend_formula = "~ sm.ns(Pseudotime, df=3)", 3 | label_by_short_name = TRUE, relative_expr = TRUE, vertical_jitter = NULL, 4 | horizontal_jitter = NULL) 5 | { 6 | f_id <- NA 7 | Cell <- NA 8 | if (cds_subset@expressionFamily@vfamily %in% c("negbinomial", 9 | "negbinomial.size")) { 10 | integer_expression <- TRUE 11 | } 12 | else { 13 | integer_expression <- FALSE 14 | relative_expr <- TRUE 15 | } 16 | if (integer_expression) { 17 | cds_exprs <- exprs(cds_subset) 18 | if (relative_expr) { 19 | if (is.null(sizeFactors(cds_subset))) { 20 | stop("Error: to call this function with relative_expr=TRUE, you must call estimateSizeFactors() first") 21 | } 22 | cds_exprs <- Matrix::t(Matrix::t(cds_exprs)/sizeFactors(cds_subset)) 23 | } 24 | cds_exprs <- reshape2::melt(round(as.matrix(cds_exprs))) 25 | } 26 | else { 27 | cds_exprs <- reshape2::melt(as.matrix(exprs(cds_subset))) 28 | } 29 | if (is.null(min_expr)) { 30 | min_expr <- cds_subset@lowerDetectionLimit 31 | } 32 | colnames(cds_exprs) <- c("f_id", "Cell", "expression") 33 | cds_pData <- pData(cds_subset) 34 | cds_fData <- fData(cds_subset) 35 | cds_exprs <- merge(cds_exprs, cds_fData, by.x = "f_id", by.y = "row.names") 36 | cds_exprs <- merge(cds_exprs, cds_pData, by.x = "Cell", by.y = "row.names") 37 | if (integer_expression) { 38 | cds_exprs$adjusted_expression <- cds_exprs$expression 39 | } 40 | else { 41 | cds_exprs$adjusted_expression <- log10(cds_exprs$expression) 42 | } 43 | if (label_by_short_name == TRUE) { 44 | if (is.null(cds_exprs$gene_short_name) == FALSE) { 45 | cds_exprs$feature_label <- as.character(cds_exprs$gene_short_name) 46 | cds_exprs$feature_label[is.na(cds_exprs$feature_label)] <- cds_exprs$f_id 47 | } 48 | else { 49 | cds_exprs$feature_label <- cds_exprs$f_id 50 | } 51 | } 52 | else { 53 | cds_exprs$feature_label <- cds_exprs$f_id 54 | } 55 | cds_exprs$f_id <- as.character(cds_exprs$f_id) 56 | cds_exprs$feature_label <- factor(cds_exprs$feature_label) 57 | new_data <- data.frame(Pseudotime = pData(cds_subset)$Pseudotime) 58 | model_expectation <- genSmoothCurves(cds_subset, cores = 1, 59 | trend_formula = trend_formula, relative_expr = T, new_data = new_data) 60 | colnames(model_expectation) <- colnames(cds_subset) 61 | library(plyr) 62 | expectation <- ddply(cds_exprs, .(f_id, Cell), function(x) data.frame(expectation = model_expectation[x$f_id, 63 | x$Cell])) 64 | cds_exprs <- merge(cds_exprs, expectation) 65 | cds_exprs$expression[cds_exprs$expression < min_expr] <- min_expr 66 | cds_exprs$expectation[cds_exprs$expectation < min_expr] <- min_expr 67 | if (is.null(panel_order) == FALSE) { 68 | cds_exprs$feature_label <- factor(cds_exprs$feature_label, 69 | levels = panel_order) 70 | } 71 | q <- ggplot(aes(Pseudotime, expression), data = cds_exprs) 72 | # if (is.null(color_by) == FALSE) { 73 | # q <- q + geom_point(aes_string(color = color_by), size = I(cell_size), 74 | # position = position_jitter(horizontal_jitter, vertical_jitter)) 75 | # } 76 | # else { 77 | # q <- q + geom_point(size = I(cell_size), position = position_jitter(horizontal_jitter, 78 | # vertical_jitter)) 79 | # } 80 | q <- q + geom_line(aes(x = Pseudotime, y = expectation), 81 | data = cds_exprs) 82 | q <- q + scale_y_log10() + facet_wrap(~feature_label, nrow = nrow, 83 | ncol = ncol, scales = "free_y") 84 | if (min_expr < 1) { 85 | q <- q + expand_limits(y = c(min_expr, 1)) 86 | } 87 | if (relative_expr) { 88 | q <- q + ylab("Relative Expression") 89 | } 90 | else { 91 | q <- q + ylab("Absolute Expression") 92 | } 93 | q <- q + xlab("Pseudo-time") 94 | q <- q + monocle_theme_opts() 95 | q 96 | } -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # NSCLC-immunotherapy 2 | The scripts are used to analyze single cell RNA sequencing data in the paper "Tumor Microenvironment Remodeling after Neoadjuvant Immunotherapy in Non-small Cell Lung Cancer Revealed by Single-Cell RNA Sequencing", https://genomemedicine.biomedcentral.com/articles/10.1186/s13073-023-01164-9, including quality control, clustering, CopyKat, trajectory, CellPhoneDB, Nichenet, and SCENIC analyses. 3 | The scripts need modification accroding to the comments(##) in the script before running. 4 | -------------------------------------------------------------------------------- /my_plot_pseudotime_heatmap.R: -------------------------------------------------------------------------------- 1 | my_plot_pseudotime_heatmap <- function (cds_subset, cluster_rows = TRUE, hclust_method = "ward.D2", 2 | num_clusters = 6, hmcols = NULL, add_annotation_row = NULL, 3 | add_annotation_col = NULL, show_rownames = FALSE, use_gene_short_name = TRUE, 4 | norm_method = c("log", "vstExprs"), scale_max = 3, scale_min = -3, 5 | trend_formula = "~sm.ns(Pseudotime, df=3)", return_heatmap = FALSE, 6 | cores = 1) 7 | { 8 | num_clusters <- min(num_clusters, nrow(cds_subset)) 9 | pseudocount <- 1 10 | newdata <- data.frame(Pseudotime = seq(min(pData(cds_subset)$Pseudotime), 11 | max(pData(cds_subset)$Pseudotime), length.out = 100)) 12 | m <- genSmoothCurves(cds_subset, cores = cores, trend_formula = trend_formula, 13 | relative_expr = T, new_data = newdata) 14 | m = m[!apply(m, 1, sum) == 0, ] 15 | norm_method <- match.arg(norm_method) 16 | if (norm_method == "vstExprs" && is.null(cds_subset@dispFitInfo[["blind"]]$disp_func) == 17 | FALSE) { 18 | m = vstExprs(cds_subset, expr_matrix = m) 19 | } 20 | else if (norm_method == "log") { 21 | m = log10(m + pseudocount) 22 | } 23 | m = m[!apply(m, 1, sd) == 0, ] 24 | m = Matrix::t(scale(Matrix::t(m), center = TRUE)) 25 | m = m[is.na(row.names(m)) == FALSE, ] 26 | m[is.nan(m)] = 0 27 | m[m > scale_max] = scale_max 28 | m[m < scale_min] = scale_min 29 | heatmap_matrix <- m 30 | row_dist <- as.dist((1 - cor(Matrix::t(heatmap_matrix)))/2) 31 | row_dist[is.na(row_dist)] <- 1 32 | if (is.null(hmcols)) { 33 | bks <- seq(-3.1, 3.1, by = 0.1) 34 | hmcols <- blue2green2red(length(bks) - 1) 35 | } 36 | else { 37 | bks <- seq(-3.1, 3.1, length.out = length(hmcols)) 38 | } 39 | ph <- pheatmap(heatmap_matrix, useRaster = T, cluster_cols = FALSE, 40 | cluster_rows = cluster_rows, show_rownames = F, show_colnames = F, 41 | clustering_distance_rows = row_dist, clustering_method = hclust_method, 42 | cutree_rows = num_clusters, silent = TRUE, filename = NA, 43 | breaks = bks, border_color = NA, color = hmcols) 44 | if (cluster_rows) { 45 | annotation_row <- data.frame(Cluster = factor(cutree(ph$tree_row, 46 | num_clusters))) 47 | } 48 | else { 49 | annotation_row <- NULL 50 | } 51 | if (!is.null(add_annotation_row)) { 52 | old_colnames_length <- ncol(annotation_row) 53 | annotation_row <- cbind(annotation_row, add_annotation_row[row.names(annotation_row), 54 | ]) 55 | colnames(annotation_row)[(old_colnames_length + 1):ncol(annotation_row)] <- colnames(add_annotation_row) 56 | } 57 | if (!is.null(add_annotation_col)) { 58 | if (nrow(add_annotation_col) != 100) { 59 | stop("add_annotation_col should have only 100 rows (check genSmoothCurves before you supply the annotation data)!") 60 | } 61 | annotation_col <- add_annotation_col 62 | } 63 | else { 64 | annotation_col <- NA 65 | } 66 | if (use_gene_short_name == TRUE) { 67 | if (is.null(fData(cds_subset)$gene_short_name) == FALSE) { 68 | feature_label <- as.character(fData(cds_subset)[row.names(heatmap_matrix), 69 | "gene_short_name"]) 70 | feature_label[is.na(feature_label)] <- row.names(heatmap_matrix) 71 | row_ann_labels <- as.character(fData(cds_subset)[row.names(annotation_row), 72 | "gene_short_name"]) 73 | row_ann_labels[is.na(row_ann_labels)] <- row.names(annotation_row) 74 | } 75 | else { 76 | feature_label <- row.names(heatmap_matrix) 77 | row_ann_labels <- row.names(annotation_row) 78 | } 79 | } 80 | else { 81 | feature_label <- row.names(heatmap_matrix) 82 | if (!is.null(annotation_row)) 83 | row_ann_labels <- row.names(annotation_row) 84 | } 85 | row.names(heatmap_matrix) <- feature_label 86 | if (!is.null(annotation_row)) 87 | row.names(annotation_row) <- row_ann_labels 88 | colnames(heatmap_matrix) <- c(1:ncol(heatmap_matrix)) 89 | ph_res <- pheatmap(heatmap_matrix[, ], useRaster = T, cluster_cols = FALSE, 90 | cluster_rows = cluster_rows, show_rownames = show_rownames, 91 | show_colnames = F, clustering_distance_rows = row_dist, 92 | clustering_method = hclust_method, cutree_rows = num_clusters, 93 | annotation_row = annotation_row, annotation_col = annotation_col, 94 | treeheight_row = 20, breaks = bks, fontsize = 6, color = hmcols, 95 | border_color = NA, silent = TRUE, filename = NA) 96 | grid::grid.rect(gp = grid::gpar("fill", col = NA)) 97 | grid::grid.draw(ph_res$gtable) 98 | resaa=list() 99 | resaa$annotation_row = annotation_row 100 | resaa$ph_res = ph_res 101 | if (return_heatmap) { 102 | return(resaa) 103 | } 104 | } --------------------------------------------------------------------------------