if(T){
  set.seed(123456)
  library(patchwork)
  library(Seurat)#4.0
  library(tidyverse)
  library(SeuratData)
  library(cowplot)
  library(data.table)
  library(clusterProfiler)
  library(org.Hs.eg.db)
  library(clustree)
  library(scDblFinder)
  library(BiocParallel)
  library(SingleCellExperiment)
  library(harmony)
  library(SC3)
  library(scater)
  library(CellChat)
  library(ggplot2)
  library(ggalluvial)
  library(NMF)  
  # setwd("")
}
########一、合并样本去除批次########
####创建seurat对象####
#使用目录向量合并
dir = c('1_RAW_data/HC1', '1_RAW_data/HC2', '1_RAW_data/PT1','1_RAW_data/PT2')
names(dir)=c("HC1","HC2","PT1","PT2")#使用merge函数合并seurat对象
scRNAlist <- list()
for(i in 1:length(dir)){
  scRNAlist[[i]] <- CreateSeuratObject(Read10X(data.dir = dir[i]),
                                       min.cells=1)
}
scRNA <- merge(scRNAlist[[1]], y=c(scRNAlist[[2]],
                                   scRNAlist[[3]],
                                   scRNAlist[[4]]))
rm(scRNAlist)
Idents(scRNA)="orig.ident"
scRNA[['groups']] <- c(rep("HC",length(grep(pattern = "HC",scRNA@meta.data$orig.ident))),
                       rep("PT",length(grep(pattern = "PT",scRNA@meta.data$orig.ident))))
scRNA[['patient']] = "P"
if(T){
  scRNA@meta.data$patient[grep(pattern = "1",scRNA@meta.data$orig.ident)]="P1"
  scRNA@meta.data$patient[grep(pattern = "2",scRNA@meta.data$orig.ident)]="P2"
}
scRNA[['nCount_RNA_S']] = "S"
if(T){
  scRNA@meta.data$nCount_RNA_S[scRNA@meta.data$nCount_RNA>=500]="500"
  scRNA@meta.data$nCount_RNA_S[scRNA@meta.data$nCount_RNA>=5000]="5K"
  scRNA@meta.data$nCount_RNA_S[scRNA@meta.data$nCount_RNA>=10000]="10K"
}
saveRDS(scRNA,"scRNA_beforeqc.Rds")
########二、数据质控和过滤########

scRNA = as.SingleCellExperiment(scRNA)
scRNA <- scDblFinder(scRNA, samples="orig.ident", 
                     BPPARAM=MulticoreParam(6));gc()##双细胞过滤
scRNA=as.Seurat(scRNA)
table(scRNA$scDblFinder.class)
write.csv(scRNA@meta.data,"meta_data_scDblFinder.csv")
p1<-scRNA@meta.data %>%
  ggplot(aes(x=orig.ident,fill=scDblFinder.class))+
  geom_bar()+
  theme_classic() +
  theme(axis.text.x = element_text(angle = 45, vjust = 1, hjust=1)) +
  theme(plot.title = element_text(hjust=0.5, face="bold")) +
  ggtitle("NCells")
ggsave('NCells.pdf',plot=p1,width = 12,height = 6)

scRNA[["percent.mt"]] <- PercentageFeatureSet(scRNA, pattern = "^MT-")
HB.genes <- c("HBA1","HBA2","HBB","HBD","HBE1","HBG1","HBG2","HBM","HBQ1","HBZ")
HB_m = which(rownames(scRNA@assays$RNA) %in% HB.genes)
HB.genes = rownames(scRNA@assays$RNA)[HB_m]
HB.genes <- HB.genes[!is.na(HB.genes)]
scRNA[["percent.HB"]]<-PercentageFeatureSet(scRNA, features=HB.genes)
scRNA[["percent.ribo"]] <- PercentageFeatureSet(scRNA, pattern = "^RP[SL]")
scRNA[["percent.HSP"]] <- PercentageFeatureSet(scRNA, pattern = "^HSP")
# Add number of genes per UMI for each cell to metadata
scRNA$log10GenesPerUMI <- log10(scRNA$nFeature_RNA) / log10(scRNA$nCount_RNA)
#scRNA[["percent.PROM1"]] <- PercentageFeatureSet(scRNA, pattern = "PROM1");gc()

scRNA@meta.data %>% #[which(scRNA$seurat_clusters==33),]
  ggplot(aes(x=orig.ident, fill=scDblFinder.class)) + 
  geom_bar() +                      
  theme_classic() +   
  theme(axis.text.x = element_text(angle = 45, vjust = 1, hjust=1)) +
  theme(plot.title = element_text(hjust=0.5, face="bold")) +
  ggtitle("NCells")

scRNA@meta.data %>% 
  ggplot(aes(color=orig.ident, x=nCount_RNA, fill=orig.ident)) + 
  geom_density(alpha = 0.15) + 
  scale_x_log10() + 
  theme_classic() +
  ylab("log10 Counts density") +
  geom_vline(xintercept = 700) #参数可调整

scRNA@meta.data %>% 
  ggplot(aes(color=orig.ident, x=nCount_RNA, fill=orig.ident)) + 
  geom_histogram(alpha = 0.15,bins = 500) + 
  scale_x_log10() + 
  theme_classic() +
  ylab("log10 Counts density") +
  geom_vline(xintercept = 700) 

# Visualize the distribution of genes detected per cell
scRNA@meta.data %>% 
  ggplot(aes(color=orig.ident, x=nFeature_RNA, fill= orig.ident)) + 
  geom_density(alpha = 0.2) + 
  scale_x_log10() +
  theme_classic() +
  ylab("log10 gene density") +
  geom_vline(xintercept = 600) #多在500-1000找到合适的地方

scRNA@meta.data %>% 
  ggplot(aes(color=orig.ident, x=nFeature_RNA, fill= orig.ident)) + 
  geom_histogram(alpha = 0.15,bins = 500) + 
  scale_x_log10() +
  theme_classic() +
  ylab("log10 gene density") +
  geom_vline(xintercept = 600)  

scRNA@meta.data %>% 
  ggplot(aes(x=orig.ident, y=log10(nFeature_RNA), fill=orig.ident)) + 
  geom_boxplot() + 
  theme_classic() +
  theme(axis.text.x = element_text(angle = 45, vjust = 1, hjust=1)) +
  theme(plot.title = element_text(hjust=0.5, face="bold")) +
  ggtitle("NCells vs NGenes")

scRNA@meta.data %>% 
  ggplot(aes(x=nCount_RNA, y=nFeature_RNA, color=percent.mt)) + 
  geom_point(size=0.5,alpha=0.2) + 
  scale_colour_gradient(low = "gray60", high = "red") +
  stat_smooth(method=lm) +
  scale_x_log10() + 
  scale_y_log10() + 
  theme_classic() +
  geom_vline(xintercept = 700) +
  geom_hline(yintercept = 600) +facet_wrap(~orig.ident)

scRNA@meta.data %>% 
  ggplot(aes(color=orig.ident, x=percent.mt, fill=orig.ident)) + 
  geom_density(alpha = 0.2) + 
  scale_x_log10() + 
  theme_classic() +
  geom_vline(xintercept = 30)  #调线粒体

scRNA@meta.data %>%
  ggplot(aes(x=log10GenesPerUMI, color = orig.ident, fill=orig.ident)) +
  geom_density(alpha = 0.2) +
  theme_classic() +
  geom_vline(xintercept = 0.78)

Idents(scRNA)="orig.ident"
#画图看
col.num <- length(levels(as.factor(scRNA@meta.data$orig.ident)))
violin <- VlnPlot(scRNA,
                  features = c("nFeature_RNA", "nCount_RNA", "percent.mt","percent.HB"),
                  cols =rainbow(col.num),
                  pt.size = 0, 
                  ncol = 4) +
  theme(axis.title.x=element_blank(), axis.text.x=element_blank(), axis.ticks.x=element_blank())

FeatureScatter(scRNA, feature1 = "nCount_RNA", feature2 = "nFeature_RNA",pt.size = 0.1)
FeatureScatter(scRNA, feature1 = "nCount_RNA", feature2 = "percent.mt",pt.size = 0.1)
FeatureScatter(scRNA, feature1 = "nCount_RNA", feature2 = "percent.HB",pt.size = 0.1)

#设置质控标准,质控
scRNAbak=scRNA
scRNA=scRNAbak
scRNA = subset(scRNA,cells=which(scRNA$nFeature_RNA > 700 & scRNA$percent.mt < 35 &
                                   scRNA$nCount_RNA > 600 & scRNA$percent.HB<0.1 &
                                   scRNA$log10GenesPerUMI >0.78 & scRNA$scDblFinder.class=="singlet"))
table(scRNA@meta.data$orig.ident)

Idents(scRNA)="orig.ident"
col.num <- length(levels(as.factor(scRNA@meta.data$orig.ident)))
VlnPlot(scRNA,
                 features = c("nFeature_RNA", "nCount_RNA", "percent.mt","percent.HB"),
                 cols =rainbow(col.num),
                 pt.size = 0,
                 ncol = 4) +
  theme(axis.title.x=element_blank(), axis.text.x=element_blank(), axis.ticks.x=element_blank())

FeatureScatter(scRNA, feature1 = "nCount_RNA", feature2 = "nFeature_RNA",pt.size = 0.1)
FeatureScatter(scRNA, feature1 = "nCount_RNA", feature2 = "percent.mt",pt.size = 0.1)
FeatureScatter(scRNA, feature1 = "nCount_RNA", feature2 = "percent.HB",pt.size = 0.1)
saveRDS(scRNA,"scRNAafterqc.Rds")
write.csv(scRNA@meta.data,"metadata_afterqc.csv")

####整合数据####
scRNA <- SCTransform(scRNA,seed.use = 123456,#variable.features.n = NULL,variable.features.rv.th=2.3,
                     conserve.memory = T);gc()
length(scRNA@assays$SCT@var.features)
scRNA <- RunPCA(scRNA,seed.use = 123456,npcs = 100)
scRNA <- RunHarmony(scRNA, group.by.vars="orig.ident", max.iter.harmony=20,plot_convergence=TRUE,#theta=3,
                    assay.use="SCT");gc()

DimHeatmap(scRNA,dims = 1:20,reduction="harmony",
           nfeatures = 10,cells = 5000)

ElbowPlot(scRNA,50,reduction="harmony")
ggsave("3_intergrate/DimHeatmappca.png",DimHeatmap(scRNA,dims = 1:50,reduction="pca",
                                                   nfeatures = 10,cells = 5000),width = 8,height = 30)
ggsave("3_intergrate/ElbowPlotpca.png",ElbowPlot(scRNA,50,reduction="pca"))

pc.num=1:35
scRNA <- RunUMAP(scRNA,reduction="harmony", dims=pc.num,seed.use=123456L)
scRNA <- RunTSNE(scRNA,reduction="harmony", dims=pc.num,seed.use = 123456)
scRNA <- FindNeighbors(scRNA,reduction="harmony",dims = pc.num)#k.param = 50,n.trees = 500
scRNA <- RunUMAP(scRNA,reduction="pca", dims=pc.num,seed.use=123456L)
scRNA <- RunTSNE(scRNA,reduction="pca", dims=pc.num,seed.use = 123456)
scRNA <- FindNeighbors(scRNA,reduction="pca",dims = pc.num,k.param = 50,n.trees = 500)
scRNA <- FindClusters(scRNA,random.seed=123456,resolution=c(0.3,0.5,0.8))
scRNA <- FindClusters(scRNA,random.seed=123456,resolution=0.8)#finnal

if(T){
  p= DimPlot(scRNA,split.by = "seurat_clusters",ncol=6)
  ggsave("split_seurat_clusters.png",p,width = 12,height = 12)
  
  p=VlnPlot(scRNA,features = c("EPCAM","CDH1","PTPRC","PECAM1","DCN","CD79A","CD3D","LAMP3","CD14","TPSAB1","CLEC4C"),pt.size = 0.1)
  ggsave("vlnplot.png",p,width=18,height=10)
  
  clus_tree = clustree(scRNA)+theme(legend.position = "bottom")+
    scale_color_brewer(palette = "Set1");clus_tree
  ggsave("scRNA_clustree.pdf", plot = clus_tree, width = 15, height = 6)
 
  #Umap
  plot1 = DimPlot(scRNA, reduction = "umap", label=T)
  plot2 = DimPlot(scRNA, reduction = "umap", group.by='orig.ident',label=F)
  ggsave("UMAP_intergrated.png", plot = plot1+plot2, width = 12, height = 5)
  plot4 = DimPlot(scRNA, reduction = "umap", split.by = "orig.ident",ncol = 5)
  ggsave("UMAP_intergrated_split.png", plot = plot4, width = 10, height = 10)
  # tSNE
  plot1 = DimPlot(scRNA, reduction = "tsne", label=T)
  plot2 = DimPlot(scRNA, reduction = "tsne", group.by='orig.ident',label=F)
  ggsave("tSNE_intergrated.pdf", plot = plot1+plot2, width = 12, height = 6)
  plot4 = DimPlot(scRNA, reduction = "tsne", split.by = "orig.ident",ncol = 5)
  ggsave("orig.ident_tsne.pdf", plot = plot4, width = 12, height = 8)
  cell_cycle = FeaturePlot(scRNA,c("PCNA","MKI67"))
  ggsave("cell_cycle.png",cell_cycle,width = 12,height = 6)
}
gc()
saveRDS(scRNA, file="scRNA_cluster.Rds")
write.csv(scRNA@meta.data,"meta.data.csv")

########三、鉴定细胞类型########
####使用SingleR鉴定细胞系####
scRNA = readRDS("scRNA_cluster.Rds")
options(stringsAsFactors = F)
options(BioC_mirror="https://mirrors.tuna.tsinghua.edu.cn/bioconductor")
options("repos" = c(CRAN="http://mirrors.cloud.tencent.com/CRAN/"))
options(download.file.method = 'libcurl')
options(url.method='libcurl')
library(SingleR)
DefaultAssay(scRNA) <- "SCT"
load("SingleR_ref/ref_Human_all.RData")#ref_Human_all
load("SingleR_ref/ref_Monaco_114s.RData")
load("SingleR_ref/ref_Hematopoietic.RData")#ref_Hematopoietic
testdata <- GetAssayData(scRNA, slot="data")
clusters <- scRNA@meta.data$seurat_clusters
if(T){
  #MonacoImmuneData免疫细胞label.fine, HumanPrimaryCellAtlasData全部细胞label.main
  cellpred1 <- SingleR(test = testdata, ref = ref_Human_all, labels = ref_Human_all$label.main,
                       method = "cluster", clusters = clusters,
                       assay.type.test = "logcounts", assay.type.ref = "logcounts")
  cellpred2 <- SingleR(test = testdata, ref = ref_Human_all, labels = ref_Human_all$label.fine,
                       method = "cluster", clusters = clusters,
                       assay.type.test = "logcounts", assay.type.ref = "logcounts")
  cellpred3 <- SingleR(test = testdata, ref = ref_Monaco, labels = ref_Monaco$label.main,
                       method = "cluster", clusters = clusters,
                       assay.type.test = "logcounts", assay.type.ref = "logcounts")
  cellpred4 <- SingleR(test = testdata, ref = ref_Monaco, labels = ref_Monaco$label.fine,
                       method = "cluster", clusters = clusters,
                       assay.type.test = "logcounts", assay.type.ref = "logcounts")
  cellpred5 <- SingleR(test = testdata, ref = ref_Hematopoietic, labels = ref_Hematopoietic$label.main,
                       method = "cluster", clusters = clusters,
                       assay.type.test = "logcounts", assay.type.ref = "logcounts")
  # cellpred6 <- SingleR(test = testdata, ref = ref_Hematopoietic, labels = ref_Hematopoietic$label.fine,
  #                      method = "cluster", clusters = clusters,
  #                      assay.type.test = "logcounts", assay.type.ref = "logcounts")
  cellpred6 =cellpred5
  celltype = data.frame(ClusterID=rownames(cellpred1),
                        celltype_altas_main = cellpred1$labels,
                        celltype_altas_fine = cellpred2$labels,
                        celltype_Mona_main = cellpred3$labels,
                        celltype_Mona_fine = cellpred4$labels,
                        celltype_Hema_main = cellpred5$labels,
                        celltype_Hema_fine = cellpred6$labels,stringsAsFactors = F
  )
  celltype$manual = ""
  rm(cellpred1,cellpred2,cellpred3,cellpred4,cellpred5,cellpred6)
}

####人工鉴定细胞类型####
#CellMarker：http://biocc.hrbmu.edu.cn/CellMarker/index.jsp
#PanglaoDB：https://panglaodb.se/index.html
#explore these important marker genes
VlnPlot(scRNA,features = c("EPCAM","CDH1","PTPRC","PECAM1","DCN","CD79A","CD3D","LAMP3","CD14","TPSAB1","CLEC4C"),pt.size = 0.1)
VlnPlot(scRNA,features = c("EPCAM","ITGB4","CD24","CDH1","PTPRC","NGFR"),pt.size = 0)#"Epithelials"
VlnPlot(scRNA,features = c("COL1A1","DCN","COL1A2","C1R","COL3A1","BSG","KRT19","IGFBP4","CKAP4","FAP",
                           "THY1"),pt.size = 0)#basal /"Fibroblasts"
VlnPlot(scRNA,features = c("PECAM1","CLDN5","FLT1","CDH5","RAMP2","PLVAP","VWF","CD34"),pt.size = 0)#"Endothelials"
VlnPlot(scRNA,features = c("CD79A","IGKC","IGLC3","IGHG3","MS4A1"),pt.size = 0)#"B cells"
VlnPlot(scRNA,features = c("CD3D","CD3E","CD3G","TRBC1","TRBC2","TRAC","PTPRC","CD4","CD8A","CD8B"),pt.size = 0)#"T cells"
VlnPlot(scRNA,features = c("MS4A2","TPSAB1","IL1RL1","TPSB2","CPA3","KIT"),pt.size = 0)#"Mast cells"
VlnPlot(scRNA,features = c("CD14", "CD163", "CD68", "CSF1R","FCGR3A","FCGR3B","CXCL2",
                           "PPA1","CST3","LYZ","APOE","VCAN"),pt.size=0)# "Macro_monos"  "Macrophage/monocyte"
VlnPlot(scRNA,features = c("ITGAX","ITGAM","ANPEP","CD14","CD1C","CD80","CD83","CD86"
                           ,"HLA-DRA","CLEC9A","FCER1A","LAMP3"),pt.size=0)#"mDCs" "Conventional dendritic cell"#CD11b#CD13#CD33#CD80#CD83#CD86#MHCII
VlnPlot(scRNA,features = c("IL3RA","CLEC4C","LILRA4","NRP1",
                           "PTGDS","NRP1","KLK1","MAP3K2","TCF4","ANPEP","GZMB","THBD"),pt.size=0)#"pDCs"
VlnPlot(scRNA,features = c("CEACAM1","CEACAM8","CEACAM6","CEACAM3","S100A8","S100A9",
                           "MNDA","FCGR3B","SELL","CXCL8","MME",
                           "TLR1","TLR9","TLR6","CXCR1"),pt.size=0)#"Neutrophil"
VlnPlot(scRNA,features = c("NCAM1","CD244","KLRG1","KLRD1","MME","CD69","NKG7"),pt.size=0)#"NK"

if(T){
  celltype[0+1,8] ="T cells"
  celltype[3+1,8] ="T cells"
  celltype[7+1,8] ="T cells"
  celltype[8+1,8] ="T cells"
  celltype[12+1,8] ="T cells"
  celltype[16+1,8] ="B cells"
  celltype[20+1,8] ="Mast cells"
  celltype[4+1,8] ="Myeloid cells"
  celltype[19+1,8] ="Myeloid cells"
  celltype[23+1,8] ="Myeloid cells"
  celltype[15+1,8] ="Endothelials"
  celltype[22+1,8] ="Endothelials"
  celltype[13+1,8] ="Fibroblasts"
  celltype[17+1,8] ="Fibroblasts"
  celltype[18+1,8] ="Fibroblasts"
  celltype[2+1,8] ="Epithelials"
  celltype[5+1,8] ="Epithelials"
  celltype[6+1,8] ="Epithelials"
  celltype[10+1,8] ="Epithelials"
  celltype[11+1,8] ="Epithelials"
  celltype[21+1,8] ="Epithelials"
  celltype[24+1,8] ="Epithelials"
  celltype[1+1,8] ="Epithelials"
  celltype[9+1,8] ="Epithelials"
  celltype[14+1,8] ="Epithelials"
}#
write.csv(celltype,"celltype.csv",row.names = F)
#写入scRNA
scRNA@meta.data$cell_type = "NA"
for(i in 1:nrow(celltype)){
  scRNA@meta.data[which(scRNA@meta.data$seurat_clusters == celltype$ClusterID[i]),'cell_type'] <- celltype$manual[i]
}
Idents(scRNA)="cell_type"
saveRDS(scRNA,file = "scRNA.RDs")

if(T){
  p1 = DimPlot(scRNA, group.by="cell_type", label=T, label.size=4, reduction='tsne',
               cols=c("#1E90FF","#008B8B","#90EE90","#BA55D3","#FFD700","#FF3030","#00C5CD","#9C9C9C","#FF8247"))
  p3 = DimPlot(scRNA, group.by="nCount_RNA_S", label=T, label.size=4, reduction='tsne',
               cols = c("#0000FF","#999999","#0072B2"))
  p5 = DimPlot(scRNA, group.by="patient", label=F, label.size=4, reduction='tsne',
               cols=c("#1E90FF","#90EE90","#BA55D3","#FFD700","#FF3030","#00C5CD"))
  p7 = DimPlot(scRNA, group.by="groups", label=F, label.size=4, reduction='tsne',
               cols = c("#1E90FF","#FFD700","#FF3030"))
  p9 = DimPlot(scRNA, group.by="seurat_clusters", label=T, label.size=4, reduction='tsne')
  p9
  p2 = DimPlot(scRNA, group.by="cell_type", label=T, label.size=4, reduction='umap',
               cols=c("#228B22","#FFFF00","#7CFC00","#9370DB","#0000FF","#87CEEB","#F08080","#999999","#FFA500"))
  p4 = DimPlot(scRNA, group.by="nCount_RNA_S", label=T, label.size=4, reduction='umap',
               cols = c("#0000FF","#999999","#0072B2"))
  p6 = DimPlot(scRNA, group.by="patient", label=F, label.size=4, reduction='umap',
               cols=c("#1E90FF","#90EE90","#BA55D3","#FFD700","#FF3030","#00C5CD"))
  p8 = DimPlot(scRNA, group.by="groups", label=F, label.size=4, reduction='umap',
               cols = c("#1E90FF","#FFD700","#FF3030"))
  ggsave("celltype_cluster_tsne.pdf", p1+p3+p5+p7, width=10,height=8)
  ggsave("celltype_cluster_umap.pdf", p2+p4+p6+p8, width=10,height=8)
}
ggsave("figure1_c_cluster+nCount.pdf",p9+p3,width = 10,height = 4)
ggsave("figure1_d_celltype.pdf",p2,width = 10,height = 8)
#marker gene heatmap
marker = FindAllMarkers(scRNA,logfc.threshold = 2,min.pct = 0.25,test.use ="MAST")
sig.markers = marker %>% dplyr::select(gene,everything()) %>% subset(p_val < 0.01)#学习一下管道符
top10 = sig.markers %>% group_by(cluster) %>% top_n(n = 10, wt = avg_log2FC)
write.csv(marker,"marker.csv")

top5 = sig.markers %>% group_by(cluster) %>% top_n(n = 5, wt = avg_log2FC)
plot1 = DoHeatmap(scRNA,feature=top5$gene,label = F)#,group.by = "cell_type"
ggsave("DoHeatmap_top5_markers_cell_type.png", plot=plot1, width=12, height=9)#height=18
ggsave("DoHeatmap_top5_markers_cell_type.pdf", plot=plot1, width=12, height=9)
plot1 =DotPlot(scRNA, feature=unique(top10$gene),cols = rainbow(3))+RotatedAxis()#,split.by="groups"
ggsave("DotPlot_top10_markers_cell_type.png", plot=plot1, width=20, height=10)

# 
genelist=sig.markers$gene[which(sig.markers$cluster=="T cells")]
ego_ALL <- enrichGO(gene          = genelist,
                    OrgDb         = 'org.Hs.eg.db',
                    keyType       = 'SYMBOL',
                    ont           = "ALL",
                    pAdjustMethod = "BH",
                    pvalueCutoff  = 0.01,
                    qvalueCutoff  = 0.05)
barplot(ego_ALL,showCategory = 50) + ggtitle("GO term")
ggsave("5_cell_identify/T_cells_GO.pdf",width = 12,height = 10)
genelist <- bitr(genelist, fromType="SYMBOL",
                 toType="ENTREZID", OrgDb='org.Hs.eg.db')
genelist <- pull(genelist,ENTREZID)
ekegg <- enrichKEGG(gene = genelist, organism = 'hsa')
KEGG = barplot(ekegg, showCategory=20)+ggtitle("KEGG term")
ggsave('T_cells_KEGG.pdf', plot=KEGG, width = 12,height = 10)

#cell_proportion
p<-scRNA@meta.data %>% 
  ggplot(aes(x=ident, fill=cell_type)) + 
  geom_bar(position = position_fill()) + ##必要的话，geom_bar(position = position_fill()),绝对数量
  theme_classic() +
  labs(x= "ident",y = "Cell proportion",fill="")+ 
  theme(axis.text.x = element_text(angle = 45, vjust = 1, hjust=1)) +
  theme(plot.title = element_text(hjust=0.5, face="bold")) +
  scale_fill_manual(values = c("#111111","#111111","#111111","#111111","#111111","#111111","#111111","#111111","#111111"))+
  theme(legend.position="right")+
  ggtitle("")
p
ggsave("cell_proportion.pdf",plot=p,width=,height=)

########五、特定细胞再聚类分析########
scRNA<-readRDS("5_cell_identify/scRNA.RDs")
dir.create("6_subcluster")
colnames(scRNA@meta.data)
Idents(scRNA) = "cell_type"
table(scRNA@meta.data$cell_type)
aim_cells_type ="Epithelials"
aim_cells <- subset(scRNA, idents = aim_cells_type)#c("mDCs","Macro_monos")
dim(aim_cells)
if(T){
  dir.create(paste0("6_subcluster/",aim_cells_type))
  aim_cells <- SCTransform(aim_cells,seed.use = 123456,
                           conserve.memory = T);gc()
  length(aim_cells@assays$SCT@var.features)
  aim_cells <- RunPCA(aim_cells,seed.use = 123456)
  aim_cells <- RunHarmony(aim_cells, group.by.vars="orig.ident", max.iter.harmony=20,
                          assay.use="SCT");gc()
}
ElbowPlot(aim_cells,ndims = 50, reduction = "harmony")
DimHeatmap(aim_cells, dims = 1:20, nfeatures=10, cells = 1000, balanced = TRUE,reduction = "harmony")
pc.num=1:30
if(T){
  aim_cells <- FindNeighbors(aim_cells, dims = pc.num,reduction="harmony")
  aim_cells = FindClusters(aim_cells,resolution = c(0.1,0.2,0.3,0.4,0.5,0.6,0.8),random.seed=123456)
  clus_tree = clustree(aim_cells)+theme(legend.position = "bottom")+
    scale_color_brewer(palette = "Set1")
  ggsave(paste0("6_subcluster/",aim_cells_type,"/scRNA_clustree.pdf"), plot = clus_tree, width = 15, height = 6)
  table(aim_cells@meta.data$seurat_clusters)
  clus_tree
}
aim_cells = FindClusters(aim_cells,resolution = c(0.2))

if(T){
  aim_cells = RunTSNE(aim_cells, reduction="harmony", dims=pc.num,seed.use=123456)
  aim_cells<- RunUMAP(aim_cells, reduction="harmony", dims=pc.num,seed.use=123456L)
  plot1 = DimPlot(aim_cells, reduction = "tsne",label = T)
  plot3 = DimPlot(aim_cells,group.by = "groups", reduction = "tsne",label = T)
  plot2 = DimPlot(aim_cells, reduction = "umap",label = T)
  plot4 = DimPlot(aim_cells,group.by = "groups", reduction = "umap",label = T)
  ggsave(paste0("6_subcluster/",aim_cells_type,"/",aim_cells_type,"_cluster.pdf"), plot = plot1+plot3+plot2+plot4, width = 12, height = 8)
  plot5=DimPlot(aim_cells,group.by = "orig.ident",label = T)
  ggsave(paste0("6_subcluster/",aim_cells_type,"/",aim_cells_type,"_orig.ident.pdf"), plot = plot5, width = 12, height = 8)
}

if(T){
  diff.wilcox = FindAllMarkers(aim_cells,assay = "SCT",logfc.threshold = 0.5,only.pos = T,test.use = "MAST")#%>%
  all.markers = diff.wilcox %>% dplyr::select(gene, everything()) %>% subset(p_val<0.01)
  top = all.markers %>% group_by(cluster) %>% subset(avg_log2FC>1.5)
  top10 = all.markers %>% group_by(cluster) %>% top_n(n = 10, wt = avg_log2FC)
  write.csv(all.markers, paste0("6_subcluster/",aim_cells_type,"/",aim_cells_type,"_diff_genes_allmarker.csv"), row.names = F)
  write.csv(top10, paste0("6_subcluster/",aim_cells_type,"/",aim_cells_type,"_diff_genes_top10.csv"), row.names = F)
  for(i in 1:length(table(aim_cells@meta.data$seurat_clusters))){
    p = VlnPlot(aim_cells,features = top10$gene[which(top10$cluster==(i-1))],pt.size=0,
                group.by = "seurat_clusters",assay = "RNA")
    ggsave(paste0("6_subcluster/",aim_cells_type,"/",aim_cells_type,"_cluster_",(i-1),"_diffgene.pdf"), plot=p, width=12, height=12)
  }
  top10_genes = CaseMatch(search = as.vector(top10$gene), match = rownames(aim_cells))
  plot3 = DoHeatmap(aim_cells, features = top10_genes, group.by = "seurat_clusters", 
                    group.bar = T)
  ggsave(paste0("6_subcluster/",aim_cells_type,"/",aim_cells_type,"_","top10_markers_heatmap.pdf"), plot=plot3,
         width=12, height=12)
  gc()
}

VlnPlot(aim_cells,features = c("EPCAM","CDH1","PTPRC","PECAM1","DCN","CD79A","CD3D","CD68","CD14","TPSAB1","CLEC4C"),pt.size = 0)
genelist=all.markers$gene[which(diff.wilcox$cluster==1 & diff.wilcox$avg_log2FC>0)]

ego_ALL <- enrichGO(gene = genelist,
                    OrgDb = 'org.Hs.eg.db',
                    keyType  = 'SYMBOL',
                    ont           = "ALL",
                    pAdjustMethod = "BH",
                    pvalueCutoff  = 0.01,
                    qvalueCutoff  = 0.05)
barplot(ego_ALL,showCategory = 50) + ggtitle("GO term")

####细胞亚型手工鉴定####
#B cells
VlnPlot(aim_cells,features = c("CD27","CD19","IGHD","IGHM","MKI67","IGHG1","SDC1","JCHAIN","CD69","CD86","HLA-DRA",
                               "CD74","TNFRSF13C","PTPRC","CD38","CD24","CR2","MS4A1","FCER2","CD40"),
        pt.size = 0,assay="SCT")#SDC1=CD138 FCER2=CD23    #
celltype_sub[0+1,8]="Memory B cells"#IgD IgM CD19+CD27-IgD+CD38(low) CD23=FCER2
celltype_sub[1+1,8]="Memory B cells"#IgD IgM CD19+CD27-IgD+CD38(low) CD23=FCER2
celltype_sub[2+1,8]="Plasma B cells"   #SDC1=CD138 CD38 JCHAIN
celltype_sub[3+1,8]="Naive B cells"

#Endothelial cells
rownames(aim_cells)[grep("TGF",rownames(aim_cells))]
VlnPlot(aim_cells,features = c("CD34","FLT1","PDPN","VCAM1","PROX1","IGFBP3","VWF","CDH5","PLVAP","ICAM1","MT2A","CD34",
                               "MT2A","PECAM1","TEK","LYVE1","FLT4","HSPG2","ACKR1","SBSN","IGFBP3","SPRY1","EDNRB","SELE"),
        pt.size = 0,assay = "SCT")
VlnPlot(aim_cells,features = c("TGFB1I1","TGFBR2","BSG","PODXL","ICAM1",
                               "TGFBR3","C1R","COL4A1","FOSB"),
        pt.size = 0.1,assay = "SCT")
FeaturePlot(aim_cells,features = c("PDPN","ACKR1","EDNRB"),split.by = "groups")
celltype_sub[0+1,8]="ECs-V"
celltype_sub[1+1,8]="ECs-V"
celltype_sub[2+1,8]="ECs-V"
celltype_sub[3+1,8]="ECs-L"

#Epithelial cells
#PECAM1=CD31   FLT4=VEGFR3 KDR,FLT1,FLT4=VEGFR
VlnPlot(aim_cells,features = c("ALPG","MUC16","EPCAM","MDM2","WT1","KRT19","CASC19"))
VlnPlot(aim_cells,features = c("CHD1","CHD2","TJP1","VIM","LYZ","PROM1","CD44","FABP5","KIT","CD164",
                               "TWISTNB","EPCAM","KRT14","KRT5","KRT8","KRT18",
                               "IFI27","TP63","SLPI","KRT6A","MUC1","TERT"),
        pt.size = 0,assay = "SCT")
VlnPlot(aim_cells,features = c("ALDH1A3","ALDH1A1","ALDH1L1","CD44","CD24","PROM1","SOX2","ANPEP","FUT4","NGFR"),
        pt.size = 0.1,assay = "SCT")#"Cancer stem cells"
VlnPlot(aim_cells,features = c("PCNA","MKI67"),
        pt.size = 0.1,assay = "SCT")##周期性标志物
VlnPlot(aim_cells,features = c("SNAI1","SNAI2","CHD1","CHD2",
                               "TWIST1","TWIST2","TCF3","ZEB1","ZEB2","PRRX1","FOXC2","TAZ"),
        pt.size = 0.1,assay = "SCT")#EMT
VlnPlot(aim_cells,c("IFNG","HIF1A","EPAS1","VEGFA","VEGFB","VEGFC","PGK1","TFRC","NPC1","ENTPD1","NT5E"))
VlnPlot(aim_cells,c("AARS2","ABCA13","ABCB10","ADAP1","ADGB","ADGRE5","AGBL2","AGBL5","AK8","AK9","AKAP14",
                    "ALDH16A1","ALDH1A1","ALDH3B1","ALMS1","ANKMY1","ANKRD18A","ANKRD54","ANKRD66","ANKUB1","AP3M2","APBB2","APCDD1","APH1B")) #纤毛上皮
VlnPlot(aim_cells,c("EPCAM","ALPL","MUC16","MCAM","WT1","ABCB5","MS4A1","NGFR","CD44","HBME")) #cancer cell
VlnPlot(aim_cells,features = c("CCND1","EGFR","CD47","TGFBI","MKI67","LETM1","CASC19"),
        pt.size = 0.1,assay = "SCT")
celltype_sub[0+1,8]="Effect EPs"##KEGG通路，涉及多条通路，参与炎症、抗肿瘤等效应，且特异性表达IL1R2（免疫抑制因子）、TFGBI、CCL2、CCN1等
celltype_sub[1+1,8]="EPs-MAGEA4"#kegg,涉及很多外源性凋亡的过程（死亡受体相关性凋亡），GO富集也富集了细胞周期相关的功能，可能因为阻滞再subG1期较多，会引起凋亡，另外CASC19 癌症易感基因，表达MAGEA4,CTAG2等肿瘤抗原
celltype_sub[2+1,8]="EPs-KRT4"##上皮发生发育，以及角化有关，是否癌前病变时产生的。
celltype_sub[3+1,8]="EPs-PEG10"  #PEG10基因为遗传印记基因，且MDM2基因高表达，转移趋势，这一类特异性不强，不好分析  
celltype_sub[4+1,8]="Effect EPs"#GO富集了许多炎症效应功能等；MUC16,TSPAN1,AGR2 都是癌基因，纤毛上皮也是均有表达
celltype_sub[5+1,8]="Proliferative EPs"# MKI67，CENPF，TOP2A，CCNB1等特异性基因都和有丝分裂有关，周期性细胞的特性，表达癌症易感基因CASC19
celltype_sub[6+1,8]="Ciliated EPs"##这一类应该是纤毛上皮细胞,GO富集
VlnPlot(aim_cells,features = c("CCL2"),group.by = "cell_type_sub",pt.size = 0,cols = c("#87CEEB","#87CEEB","#87CEEB","#87CEEB","#87CEEB","#87CEEB"))
##cluster2，表现出角化的特性
# "EPs-C3"#TGFBI
# "EPs-C1"#MKI67
# "Basal EPs" # TP63  ACTA2, KRT14,KART KRT5, MYLK, TP63
# "Ciliated epithelial cell"#"AARS2","ABCA13","ABCB10","ADAP1","ADGB","ADGRE5","AGBL2","AGBL5","AK8","AK9","AKAP14"

#Fibroblasts
rownames(aim_cells)[grep("TGF",rownames(aim_cells))]
VlnPlot(aim_cells,features = c("COL1A1","COL4A1", "COL10A1","TGFBI"
                               ,"MMP2","ACTA2","RGS5","MYH11","CNN1","CHD2",
                               "CTNNB1","C1R", "WNT5A","VIM","FAP","CD44",
                               "THY1","IFI27","ZEB1","SNAI2","COL1A1","PDGFRB"),
        pt.size = 0,assay="SCT")
VlnPlot(aim_cells,features = c("SNAI1","SNAI2","CHD1","CHD2",
                               "TWIST1","TWIST2","TCF3","ZEB1","ZEB2","PRRX1","FOXC2","TAZ"),
        pt.size = 0.1,assay = "SCT")#EMT
VlnPlot(aim_cells,c("IFNG","HIF1A","EPAS1","VEGFA","VEGFB","VEGFC","PGK1","TFRC","NPC1","ENTPD1","NT5E"))
FeaturePlot(aim_cells,features = c("COL10A1","THY1"),split.by = "groups")
celltype_sub[0+1,8]="CAFs"#CNN1, MYH11,ACAT2
celltype_sub[1+1,8]="CAFs"#LC MMP2 WNT5A MME FAP 
celltype_sub[2+1,8]="Myofibroblast" #
celltype_sub[3+1,8]="NFs"#
celltype_sub[4+1,8]="CAFs" #SNAI2-
p1<-VlnPlot(aim_cells,features = c("NT5E",'VEGFA'),group.by = "cell_type_sub",pt.size = 0,cols = c("#87CEEB","#87CEEB","#87CEEB","#87CEEB","#87CEEB","#87CEEB"))
p2<-VlnPlot(aim_cell,features = c("TWIST2","FZD1"),group.by = "cell_type_sub",pt.size = 0,cols = c("#87CEEB","#87CEEB","#87CEEB","#87CEEB","#87CEEB","#87CEEB"))+NoLegend()
p3<-RidgePlot(aim_cells,features = c("NT5E",'VEGFA'),group.by = "cell_type_sub",cols = c("#87CEEB","#87CEEB","#87CEEB","#87CEEB","#87CEEB","#87CEEB"))
p4<-RidgePlot(aim_cells,features = c("TWIST2","SNAI2"),group.by = "cell_type_sub",cols = c("#87CEEB","#87CEEB","#87CEEB","#87CEEB","#87CEEB","#87CEEB"))

#Myeloids
VlnPlot(aim_cells,features = c("EPCAM","CDH1","PTPRC","PECAM1","COL1A1","CD79A","CD3D","CD68","CD14","TPSAB1","CLEC4C"),pt.size = 0,stack=T)
VlnPlot(aim_cells,features = c("CD163","CD14","CD68","CXCL2","FCER1A","TLR2",
                               "CLEC9A","CD86","HLA-DRA","FCGR2B","CSF1R","CCR7",
                               "FCGR2A","ITGAM","ITGAX","CD40","CD1C","CD33",
                               "THBD","VCAN","FCGR3A","LAMP3","MRC1","CXCR2"),
        pt.size = 0,assay = "SCT")
VlnPlot(aim_cells,features = c("CD14", "CD163", "CD68", "CSF1R","FCGR3A","FCGR3B",
                               "IRF4","STAT6"),pt.size=0,stack = T)#"Macrophage"
VlnPlot(aim_cells,features = c("ITGAX","ITGAM","CD14", "CD163", "CLEC9A",
                               "CD68", "CSF1R","FCGR3A","CD80","CD83","CD86"),pt.size=0)#"Dendritic cell"
VlnPlot(aim_cells,features = c("CXCL8","ITGAM","MNDA","FCGR3B","SELL","CHD1","TLR1","TLR9","TLR6","MME",
                               "CHD2","ITGAX","FUT4","ANPEP","CXCR2","CD74","CEACAM8"),pt.size=0)
VlnPlot(aim_cells,features = c('CD163','CD14','CD68','TLR2',"FCGR3A",'FCGR2A','FCGR2B','CXCL2'),pt.size = 0,stack = T)#m1
VlnPlot(aim_cells,features = c('CSF1R', 'CD163', 'MSR1', 'MRC1', 'CD209', 'FCER1A', 'IRF4', 'STAT6', 'VSIG4', 'CXCL2'),pt.size = 0,stack = T)
FeaturePlot(aim_cells,features = c("LAMP3"),split.by = "groups")

celltype_sub[0+1,8] ="Macrophages-M1"  #CD163 CD14 CD68 TLR2 CD16/CD32 CXCL2
celltype_sub[1+1,8] ="Macrophages-M2" #CD115=CSF1R, CD163, CD204, CD206=MRC1, CD209, Fc-epsilon RI-alpha, IRF4, STAT6, VSIG4 CXCL2
celltype_sub[2+1,8] ="Monocyte"
celltype_sub[3+1,8] ="Macrophages-M1"
celltype_sub[4+1,8] ="mDCs-CCL22"
celltype_sub[5+1,8] ="mDCs−CLEC9A"
celltype_sub[6+1,8] ="Macrophages−M1"
# "Conventional Dendritic cells" #CD1C CD207 CCR7 CD40 LAMP3+ CLEC9A CLEC9A CD11C
# "Mast cells" #"MS4A2","TPSAB1","IL1RL1","PTPRC","CPA3"
# "Neutrophils" #MHC- CMTM2 CXCR2 CD16 CD32
# "Plasmacytoid dendritic cells"#IL3RA=CD123 GZMB
VlnPlot(aim_cells,features = c("IL3RA","CLEC4C","LILRA4","NRP1",
                           "PTGDS","NRP1","KLK1","MAP3K2","TCF4","ANPEP","GZMB","THBD"),pt.size=0,stack = T)#"pDCs"

#mast cell pDCs
celltype_sub[0+1,8]="Mast cells"
celltype_sub[1+1,8]="Mast cells"
celltype_sub[2+1,8]="Mast cells"

#T cells
VlnPlot(aim_cells,features = c("CD4","CD8A","CD8B","CD3D","CD3E","IL2RA","GZMK","CXCL13","LAG3",
                               "ITGB1","TFRC","FOXP3","CTLA4","PDCD1","GATA3","ICOS","CD69","BCL6",
                               "ENTPD1","IL17RA"),
        pt.size = 0.1,assay = "SCT")
VlnPlot(aim_cells,features = c("IL7R","FCGR3A","FGFBP2","ITGAX","NCAM1","CD3D","CD3E","SELL","PTPRC",
                               "TRBC1","TRBC2","TRAC","NKG7","KLRD1","CD40LG","CCR7","FAS"),
        pt.size = 0.1,assay = "SCT")
VlnPlot(aim_cells,features = c("IL7R","CD4","PTPRC","CD27","CD8A","CD8B","CCR7","CXCR4","SELL",
                               "CD3D","CCL5","HLA-DRB1","TRBC1","TBX21","CXCR3"),
        pt.size = 0.1,assay = "SCT")
VlnPlot(aim_cells,features = c("CD4","CD8A","CD8B","IL2RA","PTPRC","SELL","CD3D","CD3E","CD40LG","TRAC",
                               "IL7R","CCR5","CCR7","KLRG1","IL7R","CD27","TCF7","GNLY","NKG7"),
        pt.size = 0.1,assay = "SCT")
celltype_sub[0+1,8]="Naive T cells"
celltype_sub[1+1,8]="Effector CD8 T cells"
celltype_sub[2+1,8]="Treg"
celltype_sub[3+1,8]="Exhausted CD8 T cells"
celltype_sub[4+1,8]="Exhausted CD8 T cells"
celltype_sub[5+1,8]="Exhausted CD8 T cells"
celltype_sub[6+1,8]="NK"
celltype_sub[7+1,8]="Effector CD8 T cells"
celltype_sub[8+1,8]="NKT"
celltype_sub[9+1,8]="NKT"
celltype_sub[10+1,8]="Exhausted CD8 T cells"
celltype_sub[11+1,8]="Treg"

#写入
aim_cells@meta.data$cell_type_sub = "NA"
for(i in 1:nrow(celltype_sub)){
  aim_cells@meta.data[which(aim_cells@meta.data$seurat_clusters == celltype_sub$ClusterID[i]),'cell_type_sub'] <- celltype_sub$manual[i]
}
saveRDS(aim_cells,paste0("subcluster/",aim_cells_type,".RDs"))

# 必要的话，可做功能富集
library(data.table)
library(clusterProfiler)
library(org.Hs.eg.db)
all.markers = fread(paste0('subcluster/',aim_cells_type,paste0('/',aim_cells_type,'_diff_genes_allmarker.csv')))
top20 = all.markers %>% group_by(cluster) %>% top_n(n = 20, wt = avg_log2FC)
#top20基因作小提琴图,KEGG,GO图#
for (i in 1:7) {
  p = VlnPlot(aim_cells,features = top20$gene[which(top20$cluster==(i-1))],pt.size=0,
              group.by = "seurat_clusters")
ggsave(paste0('subcluster/',aim_cells_type,paste0('/',aim_cells_type,'_top20_markers_cluster',(i-1),'.pdf')), plot=p, width=12, height=12)
}  #GO
for (i in 1:7) {
  genelist=all.markers$gene[which(all.markers$cluster==(i-1))]#,[-which(all.markers$cluster==3)]
  ego_ALL <- enrichGO(gene          = genelist,
                      OrgDb         = 'org.Hs.eg.db',
                      keyType       = 'SYMBOL',
                      ont           = "ALL",
                      pAdjustMethod = "BH",
                      pvalueCutoff  = 0.01,
                      qvalueCutoff  = 0.05)
  GO <- barplot(ego_ALL,showCategory = 20) + ggtitle("GO term")#GO <- barplot(ego_ALL,showCategory = 20) + ggtitle("GO term")
  ggsave(paste0('subcluster/',aim_cells_type,paste0('/GO_KEGG/',aim_cells_type,'_all_markers_GO_cluster',(i-1),'.pdf')), plot=GO, width = 12,height = 10)
  #kegg
  genelist <- bitr(genelist, fromType="SYMBOL",
                   toType="ENTREZID", OrgDb='org.Hs.eg.db')
  genelist <- pull(genelist,ENTREZID)
  ekegg <- enrichKEGG(gene = genelist, organism = 'hsa')
  KEGG = barplot(ekegg, showCategory=20)+ggtitle("KEGG term")  
  ggsave(paste0('subcluster/',aim_cells_type,paste0('/GO_KEGG/',aim_cells_type,'_all_markers_KEGG_cluster',(i-1),'.pdf')), plot=KEGG, width = 12,height = 10)
  print(i-1)
}
########整合得到最终的细胞数据########
a = readRDS("6_subcluster/B cells.RDs")
b= readRDS("6_subcluster/Endothelials.RDs")
c= readRDS("6_subcluster/Epithelials.RDs")
d= readRDS("6_subcluster/Fibroblasts.RDs")
e= readRDS("6_subcluster/Myeloid cells.RDs")
f= readRDS("6_subcluster/Mast cells.RDs")
g= readRDS("6_subcluster/T cells.RDs")
scRNA <- merge(a, y=c(b,c,d,e,f,g))
colnames(scRNA@meta.data)
# scRNA@meta.data = scRNA@meta.data[,-c(7,8,9,10,11,21,22,23,24,25,26,28,29)]
write.csv(scRNA@meta.data,"subcluster/metadata_modify_before.csv")
metadata = scRNA@meta.data
dim(scRNA)
dim(metadata)
table(scRNA$cell_type_sub)
table(metadata$cell_type_sub)#Delete = 2764
saveRDS(scRNA,"subcluster/scRNA.RDs")

scRNA_finnal <- readRDS("subcluster/scRNA.RDs")
scRNA_finnal = subset(scRNA_finnal,cells=rownames(metadata))
identical(rownames(metadata),rownames(scRNA_finnal@meta.data));gc()
scRNA_finnal@meta.data=metadata #17599
scRNA_finnal@assays$SCT@var.features = scRNA@assays$SCT@var.features
dim(scRNA_finnal)
saveRDS(scRNA_finnal,"finaal/scRNA_finnal.RDs")
write.csv(scRNA_finnal@meta.data,"finaal/metadata_finnal.csv")

#B cells
a = readRDS("subcluster/B cells.RDs")
dim(a);print("Delete");length(which(a$cell_type_sub =="Delete"))
a = subset(a,cells=which(a$cell_type_sub !="Delete"));dim(a)
saveRDS(a,"finaal/B cells.RDs");rm(list=ls())
# Endothelials
a= readRDS("subcluster/Endothelials.RDs")
dim(a);print("Delete");length(which(a$cell_type_sub =="Delete"))
a = subset(a,cells=which(a$cell_type_sub !="Delete"));dim(a)
saveRDS(a,"finaal/Endothelials.RDs");rm(list=ls())
# Epithelials
a= readRDS("subcluster/Epithelials.RDs")
dim(a);print("Delete");length(which(a$cell_type_sub =="Delete"))
a = subset(a,cells=which(a$cell_type_sub !="Delete"));dim(a)
saveRDS(a,"finaal/Epithelials.RDs");rm(list=ls())
# Fibroblasts
a= readRDS("subcluster/Fibroblasts.RDs")
dim(a);print("Delete");length(which(a$cell_type_sub =="Delete"))
a = subset(a,cells=which(a$cell_type_sub !="Delete"));dim(a)
saveRDS(a,"finaal/Fibroblasts.RDs");rm(list=ls())
# Myeloid cells
a= readRDS("subcluster/Myeloid cells.RDs")
dim(a);print("Delete");length(which(a$cell_type_sub =="Delete"))
a = subset(a,cells=which(a$cell_type_sub !="Delete"));dim(a)
saveRDS(a,"finaal/Myeloid cells.RDs");rm(list=ls())
# Mast cells
a= readRDS("subcluster/Mast cells.RDs")
dim(a);print("Delete");length(which(a$cell_type_sub =="Delete"))
a = subset(a,cells=which(a$cell_type_sub !="Delete"));dim(a)
saveRDS(a,"finaal/Mast cells.RDs");rm(list=ls())
# # pDCs
# a= readRDS("subcluster/pDCs.RDs")
# dim(a);print("Delete");length(which(a$cell_type_sub =="Delete"))
# a = subset(a,cells=which(a$cell_type_sub !="Delete"));dim(a)
# saveRDS(a,"finaal/pDCs.RDs");rm(list=ls())
# T cells
a= readRDS("subcluster/T cells.RDs")
dim(a);print("Delete");length(which(a$cell_type_sub =="Delete"))
a = subset(a,cells=which(a$cell_type_sub !="Delete"));dim(a)
saveRDS(a,"finaal/T cells.RDs");rm(list=ls())

####修改细胞群名称
#1、修改上皮细胞的CSC2 = "CSCs-PROM1+CD44-" #188个 100%来源于癌旁
#为Ciliated EPs
#2、修改CSC1 = "CSCs-PROM1+CD44+" #1015个 93.1%来源于癌旁,6.6%来源于癌症
#为CSCs
# Epithelials@meta.data$cell_type_sub[grep("CD44-",Epithelials@meta.data$cell_type_sub)] = "Ciliated EPs"
# Epithelials@meta.data$cell_type_sub[grep("CD44+",Epithelials@meta.data$cell_type_sub)] = "CSCs"
# table(Epithelials$cell_type_sub)
# saveRDS(Epithelials,"7_finaal/Epithelials.RDs")
a = readRDS("6_subcluster/B cells.RDs")
a@meta.data$cell_type_sub[grep("Naive B cells",a@meta.data$cell_type_sub)] = "Follicular B cells"
table(a$cell_type_sub)
saveRDS(a,"6_subcluster/B cells.RDs")

##########################################以上全部做完细胞亚型鉴定#################################################
########monocle3##########
library(monocle3)
# aim_cells = Epithelials;Idents(Epithelials)
aim_cells_type="T cells"
aim_cells<- readRDS('finaal/T cells.RDs')
Idents(aim_cells)
fData <- data.frame(gene_short_name = row.names(aim_cells@assays$RNA@counts),
                    row.names = row.names(aim_cells@assays$RNA@counts))
cds <- new_cell_data_set(aim_cells@assays$RNA@counts,
                         cell_metadata = aim_cells@meta.data,
                         gene_metadata = fData)
cds <- preprocess_cds(cds, num_dim =15 ,verbose=T)#50
plot_pc_variance_explained(cds)
cds <- reduce_dimension(cds,verbose=T,cores = 6)
###从harmony 导入坐标到cds
cds.embed <- cds@int_colData$reducedDims$UMAP
int.embed <- Embeddings(aim_cells, reduction = "umap")
int.embed <- int.embed[rownames(cds.embed),]
cds@int_colData$reducedDims$UMAP <- int.embed
plot_cells(cds,color_cells_by="cell_type_sub")
cds <- cluster_cells(cds)
cds <- learn_graph(cds)
plot_cells(cds,
           color_cells_by = "cell_type_sub",
           label_groups_by_cluster=FALSE,
           label_leaves=FALSE,
           label_branch_points=FALSE)
cds <- order_cells(cds)
p1 = plot_cells(cds,
                color_cells_by = "pseudotime",
                label_cell_groups=FALSE,
                label_leaves=TRUE,
                label_branch_points=F,
                graph_label_size=3)
ggsave(paste0("finaal/Fig/",aim_cells_type,"_pseudotime.pdf", p1, width=7,height=6))
saveRDS(cds,paste0("monocle/",aim_cells_type,"_cds.RDS"))
#Finding genes that change as a function of pseudotime
ciliated_cds_pr_test_res <- graph_test(cds, neighbor_graph="principal_graph", cores=6)
saveRDS(ciliated_cds_pr_test_res,"monocle/ciliated_cds_pr_test_res.RDS")

pr_deg_ids <- row.names(subset(ciliated_cds_pr_test_res, q_value < 0.05))
gene_module_df <- find_gene_modules(cds[pr_deg_ids,],resolution=c(1e-06, 1e-05, 1e-04, 1e-03, 1e-02, 1e-01))# resolution=c(0,10^seq(-6,-1))
cell_group_df <- tibble::tibble(cell=row.names(colData(cds)), 
                                cell_group=colData(cds)$cell_type_sub)
agg_mat <- aggregate_gene_expression(cds, gene_module_df, cell_group_df)
row.names(agg_mat) <- stringr::str_c("Module ", row.names(agg_mat))
pheatmap::pheatmap(agg_mat,
                   scale="column", clustering_method="ward.D2")
write.csv(gene_module_df,"monocle/gene_module_df.csv")
plot_cells(cds, genes=c(""),
           show_trajectory_graph=FALSE,
           label_cell_groups=FALSE,
           label_leaves=FALSE)
plot_cells(cds,
           genes=gene_module_df %>% filter(module %in% c(21,33)),
           label_cell_groups=FALSE,
           show_trajectory_graph=FALSE)

########六、细胞通讯分析########
####iTALK####
devtools::install_github("Coolgenome/iTALK", build_vignettes = TRUE)
devtools::install_local("10_celltalk/iTALK-master.zip")
library(iTALK)
library(Seurat)
library(tidyverse)
library(iTALK)
library(ggplot2)
rm(list=ls())
#定义scRNA
scRNA <- readRDS("subcluster/scRNA.RDs")
cell.expr <- data.frame(t(as.matrix(scRNA@assays$RNA@counts)), check.names=F);cell.expr[1:3,1:3]

######查看样本内配体-受体概况
dir.create('celltalk/italk')
setwd("italk")
cell.meta = subset(scRNA@meta.data, select=c("orig.ident","cell_type"))
names(cell.meta) <- c("compare_group", "cell_type")
memory.limit(1350000)
data.italk <- merge(cell.expr, cell.meta, by=0)
data.italk = column_to_rownames(data.italk,var = "Row.names")
mycolor <- c("#92D0E6","#F5949B","#E11E24","#FBB96F","#007AB8","#A2D184","#00A04E","#BC5627","#0080BD","#EBC379","#A74D9D")
cell_type <- unique(data.italk$cell_type)
cell_col <- structure(mycolor[1:length(cell_type)], names=cell_type)
comm_list<-c('growth factor','other','cytokine','checkpoint')
PN=20
name = names(table(data.italk$compare_group))

#寻找高表达的配体受体基因,top_genes=50代表提取平均表达量前50%的基因
highly_exprs_genes <- rawParse(data, top_genes=50, stats="mean")  #
res<-NULL
for(comm_type in comm_list){
  #comm_type = 'cytokine'
  res_cat <- FindLR(highly_exprs_genes, datatype='mean count', comm_type=comm_type)
  res_cat <- res_cat[order(res_cat$cell_from_mean_exprs*res_cat$cell_to_mean_exprs, decreasing=T),]
  write.csv(res_cat, paste0('Sample2_LRpairs_',comm_type,"_ALL.xls"))#name[i],
  #绘制细胞通讯关系网络图
  pdf(paste0('Sample2_LRpairs_',comm_type,"_ALL.pdf"), width=6, height=7)#name[i],
  NetView(res_cat, col=cell_col, vertex.label.cex=1.2, edge.label.cex=0.9,vertex.size=30, arrow.width=3, edge.max.width=10, margin = 0.2)
  dev.off()
  #绘制topPN的配体-受体圈图
  pdf(paste0('Sample2_LRpairs_',comm_type,"_ALL_topPN.pdf"), width=6, height=7)#name[i],
  LRPlot(res_cat[1:PN,],datatype='mean count',cell_col=cell_col,link.arr.lwd=res_cat$cell_from_mean_exprs[1:PN],link.arr.width=res_cat$cell_to_mean_exprs[1:PN], text.vjust = "0.35cm")
  dev.off()
  res<-rbind(res,res_cat)
}
res <- res[order(res$cell_from_mean_exprs*res$cell_to_mean_exprs, decreasing=T),]
write.csv(res, paste0("Sample2_LRpairs_Overview_ALL.xls"))
res.top <- res[1:PN,]
pdf(paste0('Sample2_LRpairs_Overview_net_ALL.pdf'), width=6, height=7)
NetView(res, col=cell_col, vertex.label.cex=1.2, edge.label.cex=0.9, 
        vertex.size=30, arrow.width=3, edge.max.width=10, margin = 0.2)
dev.off()
pdf(paste0('Sample2_LRpairs_Overview_circ_ALL.pdf'), width=6, height=7)
LRPlot(res.top, datatype='mean count', link.arr.lwd=res.top$cell_from_mean_exprs,
       cell_col=cell_col, link.arr.width=res.top$cell_to_mean_exprs)
dev.off()
cat("ALL","done!")
# }

#DEGs
setwd("italk")
dir.create('DEG')
setwd('DEG')

cell.meta = subset(scRNA@meta.data, select=c("groups","cell_type"))
names(cell.meta) <- c("compare_group", "cell_type")
data.italk <- merge(cell.expr, cell.meta, by=0)
data.italk = column_to_rownames(data.italk,var = "Row.names")

rm(scRNA)
##设置绘图颜色和其他变量
mycolor <- c("#92D0E6","#F5949B","#E11E24","#FBB96F","#007AB8","#A2D184","#00A04E","#BC5627","#0080BD","#EBC379","#A74D9D")
cell_type <- unique(data.italk$cell_type)
cell_col <- structure(mycolor[1:length(cell_type)], names=cell_type)
#通讯类型变量
comm_list<-c('growth factor','other','cytokine','checkpoint')
#圈图展示配体-受体对的数量
PN=20
name = names(table(data.italk$compare_group))

##各个细胞类型分别执行差异分析，然后合并在一起
data = data.italk[1:2000,]
deg_B <- DEG(data.italk %>% filter(cell_type=='B cells'), method='Wilcox',contrast=c("HC","PT"))
deg_T <- DEG(data.italk %>% filter(cell_type=='T cells'), method='Wilcox',contrast=c("HC","PT"))
deg_Myeloid<-DEG(data.italk %>% filter(cell_type=='Myeloid cells'), method='Wilcox',contrast=c("HC","PT"))
deg_Mast<-DEG(data.italk %>% filter(cell_type=='Mast cells'), method='Wilcox',contrast=c("HC","PT"))
deg_Epi<-DEG(data.italk %>% filter(cell_type=='Epithelials'), method='Wilcox',contrast=c("HC","PT"))
deg_Edo<-DEG(data.italk %>% filter(cell_type=='Endothelials'), method='Wilcox',contrast=c("HC","PT"))
deg_Fib<-DEG(data.italk %>% filter(cell_type=='Fibroblasts'), method='Wilcox',contrast=c("HC","PT"))
# deg_T2 <- DEG(data.italk %>% filter(cell_type=='T cells'), method='Wilcox',contrast=c("HC","LM"))
deg_3 <- rbind(deg_B, deg_T,deg_Myeloid,deg_Mast,deg_Epi,deg_Edo,deg_Fib)

##各个配体-受体分类分别作图
res<-NULL
for(comm_type in comm_list){
  #comm_type='growth factor' 
  #多个细胞类型之间显著表达的配体-受体，结果会过滤同一细胞类型内的配体-受体关系
  res_cat <- FindLR(data_1=deg_3, datatype='DEG', comm_type=comm_type)
  #单个细胞类型显著表达的配体-受体
  #res_cat <- FindLR(data_1=deg_T, datatype='DEG', comm_type=comm_type)
  res_cat <- res_cat[order(res_cat$cell_from_logFC*res_cat$cell_to_logFC, decreasing=T),]
  write.csv(res_cat, paste0('LRpairs_DEG_',comm_type,'.xls'))
  res_cat = res_cat[1:8,]
  #plot by ligand category
  png(paste0('LRpairs_DEG_',comm_type,'_circ.png'), width=600, height=650)
  if(nrow(res_cat)==0){
    next
  }else if(nrow(res_cat)>=PN){
    LRPlot(res_cat, datatype='DEG', link.arr.lwd=res_cat$cell_from_logFC,
           cell_col=cell_col, link.arr.width=res_cat$cell_to_logFC)
  }else{
    LRPlot(res_cat, datatype='DEG', link.arr.lwd=res_cat$cell_from_logFC,
           cell_col=cell_col, link.arr.width=res_cat$cell_to_logFC)
  }
  dev.off()
  png(paste0('LRpairs_DEG_',comm_type,'_net.png'), width=600, height=650)
  NetView(res_cat, col=cell_col, vertex.label.cex=1.2, edge.label.cex=0.9, 
          vertex.size=30, arrow.width=3, edge.max.width=10, margin = 0.2)
  dev.off()
  res<-rbind(res,res_cat)
}
##所有配体-受体分类一起作图
res<-res[order(res$cell_from_logFC*res$cell_to_logFC, decreasing=T),]
write.csv(res, 'LRpairs_DEG_alln.xls')
if(is.null(res)){
  print('No significant pairs found')
}else if(nrow(res)>=PN){
  res.top <- res[1:PN,]
  png(paste0('LRpairs_DEG_alln_net.png'), width=600, height=650)
  NetView(res, col=cell_col, vertex.label.cex=1.2, edge.label.cex=0.9, 
          vertex.size=30, arrow.width=3, edge.max.width=10, margin = 0.2)
  dev.off()    
  png('LRpairs_DEG_alln_circ.png', width=600, height=650)
  LRPlot(res.top, datatype='DEG', link.arr.lwd=res.top$cell_from_logFC,
         cell_col=cell_col, link.arr.width=res.top$cell_to_logFC)
  dev.off()
}else{
  png(paste0('LRpairs_DEG_alln_net.png'), width=600, height=650)
  NetView(res, col=cell_col, vertex.label.cex=1.2, edge.label.cex=0.9, 
          vertex.size=30, arrow.width=3, edge.max.width=10, margin = 0.2)
  dev.off()    
  png('LRpairs_DEG_alln_circ.png', width=600, height=650)
  LRPlot(res, datatype='DEG', link.arr.lwd=res$cell_from_logFC,
         cell_col=cell_col, link.arr.width=res$cell_to_logFC)
  dev.off()
}

#####nichenetr#####
library(nichenetr)
library(Seurat)
library(tidyverse)
rm(list=ls())
setwd("nichenet")

##读入nichenet先验数据 
ligand_target_matrix <- readRDS(url("https://zenodo.org/record/3260758/files/ligand_target_matrix.rds"))
lr_network = readRDS(url("https://zenodo.org/record/3260758/files/lr_network.rds"))
weighted_networks = readRDS(url("https://zenodo.org/record/3260758/files/weighted_networks.rds"))
# weighted_networks列表包含两个数据框，lr_sig是配体-受体权重信号网络，gr是配体-靶基因权重调控网络
##读入单细胞数据
scRNA <- readRDS("subcluster/scRNA.RDs")
scRNA <- UpdateSeuratObject(scRNA)
head(scRNA@meta.data)

Idents(scRNA) <- "cell_type"
nichenet_output = nichenet_seuratobj_aggregate(seurat_obj = scRNA, 
                                               top_n_ligands = 20,   #20
                                               receiver = c("Epithelials"), 
                                               sender = c("Epithelials","Mast cells","T cells", "Fibroblasts", "B cells", "Endothelials","Myeloid cells"),#"Mast cells","T cells", "Fibroblasts", "B cells", "Endothelials",
                                               condition_colname = "groups", 
                                               condition_oi = "HC", 
                                               condition_reference = "PT", 
                                               ligand_target_matrix = ligand_target_matrix, 
                                               lr_network = lr_network, 
                                               weighted_networks = weighted_networks, 
                                               organism = "human",
                                               assay_oi="SCT")
# top_n_ligands参数指定用于后续分析的高活性配体的数量
## 查看配体活性分析结果
# 主要参考pearson指标，bona_fide_ligand=True代表有文献报道的配体-受体，
# bona_fide_ligand=False代表PPI预测未经实验证实的配体-受体。
lig_from="ALL_Epi"
x <- nichenet_output$ligand_activities
write.csv(x, paste0(lig_from,"_ligand_activities.csv"), row.names = F)
# 查看top20 ligands
nichenet_output$top_ligands
# 查看top20 ligands在各个细胞亚群中表达情况
p = DotPlot(scRNA, features = nichenet_output$top_ligands, cols = "RdYlBu") + RotatedAxis()
ggsave(paste0(lig_from,"_top20_ligands.png"), p, width = 12, height = 6)
# 按"groups"的分类对比配体的表达情况
p = DotPlot(scRNA, features = nichenet_output$top_ligands, split.by = "groups") + RotatedAxis()
ggsave(paste0(lig_from,"_top20_ligands_compare.png"), p, width = 12, height = 8)
# 用小提琴图对比配体的表达情况
p = VlnPlot(scRNA, features = nichenet_output$top_ligands, 
            split.by = "groups",  pt.size = 0, combine = T)
ggsave(paste0(lig_from,"_VlnPlot_ligands_compare.png"), p, width = 30, height = 24)

## 查看配体调控靶基因
p = nichenet_output$ligand_target_heatmap
ggsave(paste0(lig_from,"_Heatmap_ligand-target.png"), p, width = 12, height = 6)
# 更改热图的风格
p = nichenet_output$ligand_target_heatmap + 
  scale_fill_gradient2(low = "whitesmoke",  high = "royalblue", breaks = c(0,0.0045,0.009)) + 
  xlab("HC response genes in Epithelials") + 
  ylab("Prioritized immmune cell ligands")
ggsave(paste0(lig_from,"_Heatmap_ligand-target2.png"), p, width = 12, height = 6)
# 查看top配体调控的靶基因及其评分
x <- nichenet_output$ligand_target_matrix
#x2 <- nichenet_output$ligand_target_df
write.csv(x, paste0(lig_from,"_ligand_target.csv"), row.names = T)
# 查看被配体调控靶基因的表达情况
p = DotPlot(scRNA %>% subset(idents = "Epithelials"), 
            features = nichenet_output$top_targets, 
            split.by = "groups") + RotatedAxis()
ggsave(paste0(lig_from,"_Targets_Expression_dotplot.png"), p, width = 40, height = 10)
p = VlnPlot(scRNA %>% subset(idents = "Epithelials"), features = nichenet_output$top_targets, 
            split.by = "groups", pt.size = 0, combine = T, ncol = 8)
ggsave(paste0(lig_from,"_Targets_Expression_vlnplot.png"), p, width = 12, height = 8)

## 查看受体情况
# 查看配体-受体互作
p = nichenet_output$ligand_receptor_heatmap
ggsave(paste0(lig_from,"_Heatmap_ligand-receptor.png"), p, width = 12, height = 6)
x <- nichenet_output$ligand_receptor_matrix
#x <- nichenet_output$ligand_receptor_df
write.csv(x, paste0(lig_from,"_ligand_receptor.csv"), row.names = T)
# 查看受体表达情况
p = DotPlot(scRNA %>% subset(idents = "Epithelials"), 
            features = nichenet_output$top_receptors, 
            split.by = "groups") + RotatedAxis()
ggsave(paste0(lig_from,"_Receptors_Expression_dotplot.png"), p, width = 18, height = 6)
p = VlnPlot(scRNA %>% subset(idents = "Epithelials"),
            features = nichenet_output$top_receptors, 
            split.by = "groups", pt.size = 0, combine = T, ncol = 8)
ggsave(paste0(lig_from,"Receptors_Expression_vlnplot.png"), p, width = 30, height = 24)
# 有文献报道的配体-受体
# Show ‘bona fide’ ligand-receptor links that are described in the literature and not predicted based on PPI
p = nichenet_output$ligand_receptor_heatmap_bonafide
ggsave(paste0(lig_from,"_Heatmap_ligand-receptor_bonafide.png"), p, width = 8, height = 4)
x <- nichenet_output$ligand_receptor_matrix_bonafide
#x <- nichenet_output$ligand_receptor_df_bonafide
write.csv(x, paste0(lig_from,"_ligand_receptor_bonafide.csv"), row.names = F)

########七、转录调控网络分析:scenic########

########scRNA画图总结########
#RidgePlot
p1 = RidgePlot(scRNA, features = "CD4")
p2 = RidgePlot(scRNA, features = "PC_2")
ggsave('visual/ridgeplot_eg.png',p1+p2, width = 8,height = 8)

#VInPlot
p1 = VlnPlot(scRNA, features = "nCount_RNA", pt.size = 0)
# p2 = VlnPlot(scRNA, features = "CD8A", pt.size = 0)
p2 = VlnPlot(scRNA, features = "EPCAM", pt.size = 0)
ggsave('visual/vlnplot_eg.png', p1+p2, width = 8,height = 8)

#FeaturePlot
p1 <- FeaturePlot(scRNA,features = "CD4",reduction = 'tsne')
p2 <- FeaturePlot(scRNA,features = "CD8A", reduction = 'umap')
p3 <- FeaturePlot(scRNA,features = "PC_1")
ggsave('visual/featureplot_eg.png', p1+p2, width = 8,height = 8)

#DotPlot
genelist = read.csv("subcluster/Epithelials/Epithelials_diff_genes_top10.csv")
genelist <- pull(genelist, gene) %>% as.character
p = DoHeatmap(scRNA, features = genelist, group.by = "seurat_clusters",group.bar = T, size = 0.5)
ggsave('visual/heatmap_eg.pdf', p, width = 12, height = 9)

#FeatureScatter
p1 <- FeatureScatter(scRNA, feature1 = 'PC_1', feature2 = 'PC_2')
p2 <- FeatureScatter(scRNA, feature1 = 'nCount_RNA', feature2 = 'nFeature_RNA')
ggsave(visual/featurescatter_eg.png', p1|p2, width = 10, height = 4)

#DimPlot
p1 <- DimPlot(scRNA, reduction = 'tsne', group.by = "cell_type", label=T)
p4 <- DimPlot(scRNA, reduction = 'umap', group.by = "seurat_clusters", label=T)
ggsave('visual/dimplot_eg.png', p1/p4, width = 10, height = 8)

pie <- ggplot(pData(scRNA),
              aes(x = factor(1), fill = factor(cell_Type))) + geom_bar(width = 1)
pie + coord_polar(theta = "y") +
  theme(axis.title.x = element_blank(), axis.title.y = element_blank())

########差异SCDE/DEsingle########(Single Cell Differential Expression)
# devtools::install_github('hms-dbmi/scde', build_vignettes = FALSE)
# library(scde)
library(DEsingle)
# 载入数据
scRNA<-readRDS("subcluster/scRNA.RDs")
meta.data<-scRNA@meta.data
group_list<-ifelse(meta.data$groups=="HC","tumor","normal")
table(group_list)

#######single gene TCGA analysis######
##unicox analysis##
install.packages('survival')
setwd("uniCox")
library(survival)
gene="BMPR2"
rt=read.table(paste0(gene,"_coxInput.txt"),header=T,sep="\t",check.names=F,row.names=1)
outTab=data.frame()
for(i in colnames(rt[,3:ncol(rt)])){
 cox <- coxph(Surv(futime, fustat) ~ rt[,i], data = rt)
 coxSummary = summary(cox)
 coxP=coxSummary$coefficients[,"Pr(>|z|)"]
 outTab=rbind(outTab,
              cbind(id=i,
              HR=coxSummary$conf.int[,"exp(coef)"],
              HR.95L=coxSummary$conf.int[,"lower .95"],
              HR.95H=coxSummary$conf.int[,"upper .95"],
              pvalue=coxSummary$coefficients[,"Pr(>|z|)"])
              )
}
write.table(outTab,file=paste0(gene,"_uniCox.xls"),sep="\t",row.names=F,quote=F)
p = VlnPlot(scRNA %>% subset(idents = "Epithelials"),
            features = c("BMPR2"), 
            split.by = "groups", pt.size = 0)

ggsave(paste0("Epi_BMPR2_Expression_vlnplot.pdf"), p, width = 10, height = 6)

###BMPR2下游
BMPR2_miR<-read.table("BMPR2_TargetScan_Conserved_sites_predicted_targeting_details.csv",sep = ",",header = T,check.names = F)
survival_miR<-read.table("GSE117558_p0.05.csv",sep = ",",header = T)
IN<-intersect(x=SORL1_miR$miRNA,y=survival_miR$miRNA_ID)
IN<-intersect(x=BMPR2_miR$miRNA,y=survival_miR$miRNA_ID)
IN

#p<0.1:"hsa-miR-363-3p","hsa-miR-367-3p","hsa-miR-92b-3p","hsa-miR-328-3p","hsa-miR-128-3p","hsa-miR-129-2-3p","hsa-miR-135a-5p" 
#p<0.05:"hsa-miR-363-3p","hsa-miR-129-2-3p"
##BMPR2 p<0.05
# [1] "hsa-miR-130b-3p"  "hsa-miR-363-3p"   "hsa-miR-136-5p"   "hsa-miR-129-2-3p" "hsa-miR-520b"     "hsa-miR-520e"    
# [7] "hsa-miR-590-5p"