单细胞常见的可视化方式有DimPlot，FeaturePlot ，DotPlot ，VlnPlot 和 DoHeatmap集中 ，在Seurat中均可以实现，但文献中的图大多会精美很多。之前 scRNA分析 | 定制 美化FeaturePlot 图，你需要的都在这介绍了FeaturePlot的美化方式。在跟SCI学umap图| ggplot2 绘制umap图，坐标位置 ，颜色 ，大小还不是你说了算 介绍过DimPlot的一些调整方法，本次再介绍一种更惊艳的umap图。
2022年发表于Cell Metabolism 的Mapping the single-cell transcriptomic response of murine diabetic kidney disease to therapies 文献中有一张主图中绘制的细胞大群及亚群的umap图很惊艳，作者提供了plot1cell 包，本文介绍一下如何复现下图。
一 载入R包，数据
使用之前注释过的sce.anno.RData数据 ，后台回复 anno 即可获取 。这里要下载一下plot1cell图，大概率会提示缺少XXX包，这时候只要指定安装即可。
devtools::install_github("TheHumphreysLab/plot1cell")#根据实际缺少包进行安装bioc.packages <- c("biomaRt","GenomeInfoDb","EnsDb.Hsapiens.v86","GEOquery","simplifyEnrichment","ComplexHeatmap")BiocManager::install(bioc.packages)dev.packages <- c("chris-mcginnis-ucsf/DoubletFinder","Novartis/hdf5r","mojaveazure/loomR")devtools::install_github(dev.packages)#再重新装一次devtools::install_github("TheHumphreysLab/plot1cell")library(plot1cell)library(Seurat)library(tidyverse)library(stringr)library(RColorBrewer)load("sce.anno.RData")head(sce2,2)
已经注释过了，下面可以直接使用。
二 plot1cell 函数
1，绘制大群umap图
首先使用prepare_circlize_data函数得到绘图信息，然后plot_circlize函数可以直接绘制umap主图 并把单独的celltype圈画起来 。
###Prepare data for ploting 准备圈图数据circ_data <- prepare_circlize_data(sce2, scale = 0.8 )set.seed(1234)# 设置细胞分群信息的颜色cluster_colors<-rand_color(length(levels(sce2)))group_colors<-rand_color(length(names(table(sce2$group))))rep_colors<-rand_color(length(names(table(sce2$orig.ident))))# 绘制细胞分群圈图plot_circlize(circ_data,do.label = T, pt.size = 0.01,col.use = cluster_colors ,bg.color = 'white',kde2d.n = 1000,repel = T,label.cex = 0.6)
对比文章图 还缺少（1）背景颜色 ，（2）circos字体较小，（3）外面其他的圈 以及（4）四周的亚群umap图 。
2，背景颜色以及circos大小设置
作者的plot_circlize函数中，将circos图中的刻度和label的大小固定了，需要简单修改一下就可以修改了。修改后的plot_circlize_change 函数可以使用 circos.cex 修改circos刻度的大小 , labels.cex 修改circos上label的大小 。
后台回复 "circos" 即可获得plot_circlize_change 函数文件。
plot_circlize_change(circ_data,do.label = T, pt.size = 0.01,col.use = cluster_colors ,bg.color = '#E0D4CA',kde2d.n = 1000,repel = T,labels.cex = 1,circos.cex = 0.5,label.cex = 1)
3，添加多层track
使用add_track函数添加其他细胞群注释的其他信息 ，可是是metadata中的其他列，这里使用group 和 sample 为例 。
add_track(circ_data,group = "group",colors = group_colors, track_num = 2) ## can change it to one of the columns in the meta data of your seurat objectadd_track(circ_data,group = "orig.ident",colors = rep_colors, track_num = 3)
到这里就完成了主图umap的绘制，其实就可以放到正文了。
三 添加细胞亚型umap
至于最后一点，其实可以用将AI / PS等工具将各个亚型小图的umap PS弄上去，但是这里还是给出使用代码的方式。
1 ，批量亚型分析
因为亚型之前没有分析，这里先批量的进行一下各个亚型的标准Seurat分析（本文不做注释，后续会介绍）
sub_celltype <- c("Epi","Myeloid" ,"Fibroblast" ,"T")sub.celltype_list <- sapply(sub_celltype,function(slide){print(slide)sub.celltype <- subset(sce2 , celltype == slide )sub.celltype <- NormalizeData(sub.celltype)sub.celltype <- FindVariableFeatures(sub.celltype)sub.celltype <- ScaleData(sub.celltype )sub.celltype <- RunPCA(sub.celltype,npcs = 20)sub.celltype <- FindNeighbors(sub.celltype,dims = 1:20)sub.celltype <- FindClusters(sub.celltype, resolution = 1)sub.celltype <- RunUMAP(sub.celltype,dims = 1:20)return(sub.celltype)})sub.celltype_list
得到的是各个亚型的结果，list形式。
2 ，添加四周亚型umap图
my36colors <-c('#E5D2DD', '#53A85F', '#F1BB72', '#F3B1A0', '#D6E7A3', '#57C3F3', '#476D87','#E95C59', '#E59CC4', '#AB3282', '#23452F', '#BD956A', '#8C549C', '#585658','#9FA3A8', '#E0D4CA', '#5F3D69', '#C5DEBA', '#58A4C3', '#E4C755', '#F7F398','#AA9A59', '#E63863', '#E39A35', '#C1E6F3', '#6778AE', '#91D0BE', '#B53E2B','#712820', '#DCC1DD', '#CCE0F5', '#CCC9E6', '#625D9E', '#68A180', '#3A6963','#968175')Fibroblast <- sub.celltype_list$FibroblastIdents(Fibroblast) <- "seurat_clusters"subcolors <- my36colors[1:nlevels(Fibroblast)]#subcolors <- c('#bff542','#83f78f','#EBA1A2','#D70016','#eab3fc','#83b1f7','#D70016','#eab3fc','#83b1f7')Fibroblast_meta<-get_metadata(Fibroblast, color = subcolors)Fibroblast_meta %>%dplyr::group_by(seurat_clusters) %>%summarize(x = median(x = x),y = median(x = y)) -> centers_Fibpoints(Fibroblast_meta$x*0.32-1.2,Fibroblast_meta$y*0.32-0.73, pch = 19, col = alpha(Fibroblast_meta$Colors,0.5), cex = 0.1);text(centers_Fib$x*0.32-1.2,centers_Fib$y*0.32-0.73, labels=centers_Fib$seurat_clusters, cex = 0.6, col = 'black')
注意这里的subcolors 可以自定义，也可以每次都使用my36colors 中的颜色，但是一定要注意以下2点
(1) subcolors 要和 Idents(Fibroblast)中的nlevels一致。
（2）Fibroblast_meta$x*0.32-1.2和后面Fibroblast_meta$y*0.32-0.73 中的 0.32 ，1.2 ，0.73等 数值代表位置，可能需要多次尝试。
#T subtypesT.sub <- sub.celltype_list$Tsubcolors <- my36colors[1:nlevels(T.sub)]T_meta<-get_metadata(T.sub, color = subcolors)T_meta %>%dplyr::group_by(Cluster) %>%summarize(x = median(x = x),y = median(x = y)) -> centers_Tpoints(T_meta$x*0.32+1.2,T_meta$y*0.32+0.73, pch = 19, col = alpha(T_meta$Colors,0.5), cex = 0.1);text(centers_T$x*0.32+1.2,centers_T$y*0.32+0.73, labels=centers_T$Cluster, cex = 0.6, col = 'black')#Myeloid subtypesMyeloid.sub <- sub.celltype_list$Myeloidsubcolors <- my36colors[1:nlevels(Myeloid.sub)]Myeloid_meta<-get_metadata(Myeloid.sub, color = subcolors)Myeloid_meta %>%dplyr::group_by(Cluster) %>%summarize(x = median(x = x),y = median(x = y)) -> centers_Myepoints(Myeloid_meta$x*0.32-1.2,Myeloid_meta$y*0.32+0.73, pch = 19, col = alpha(Myeloid_meta$Colors,0.5), cex = 0.1);text(centers_Mye$x*0.32-1.2,centers_Mye$y*0.32+0.73, labels=centers_Mye$Cluster, cex = 0.6, col = 'black')##Epi subtypeEpi.sub <- sub.celltype_list$Episubcolors <- my36colors[1:nlevels(Epi.sub)]Epi_meta<-get_metadata(Epi.sub, color = subcolors)Epi_meta %>%dplyr::group_by(Cluster) %>%summarize(x = median(x = x),y = median(x = y)) -> centers_Epipoints(Epi_meta$x*0.3+1.2,Epi_meta$y*0.3-0.73, pch = 19, col = alpha(Epi_meta$Colors,0.5), cex = 0.1);text(centers_Epi$x*0.3+1.2,centers_Epi$y*0.3-0.73, labels=centers_Epi$Cluster, cex = 0.6, col = 'black')
3 ，添加四周umap的title 和 track的legend
（1）添加，优化四周umap的title ，注意位置和大小
title_text <- function(x0, y0, x1, y1, text, rectArgs = NULL, textArgs = NULL) {center <- c(mean(c(x0, x1)), mean(c(y0, y1)))do.call('rect', c(list(xleft = x0, ybottom = y0, xright = x1, ytop = y1), rectArgs))do.call('text', c(list(x = center[1], y = center[2], labels = text), textArgs))}title_text(x0 = -1.35, x1 = -1.05, y0 = -1.06, y1=-1, text = 'Fibroblasts',rectArgs = list(border='#F9F2E4',lwd=0.5),textArgs = list(col='black',cex = 1))title_text(x0 = 1.05, x1 = 1.35, y0 = -1.06, y1=-1, text = 'Epi cells',rectArgs = list(border='#F9F2E4',lwd=0.5),textArgs = list(col='black',cex = 1))title_text(x0 = -1.35, x1 = -1.05, y0 = 1.06, y1=1, text = 'Myeloid',rectArgs = list(border='#F9F2E4',lwd=0.5),textArgs = list(col='black',cex = 1))title_text(x0 = 1.05, x1 = 1.35, y0 = 1.06, y1=1, text = 'T cells',rectArgs = list(border='#F9F2E4',lwd=0.5),textArgs = list(col='black',cex = 1))
（2）添加track的legend
#plot group#col_use<-c('#00288A','#DD001F','#84D000','#00CB47','#947F00','#006234')cc<-get_metadata(sce2, color = col_use)cc %>%dplyr::group_by(celltype) %>%summarize(x = median(x = x),y = median(x = y)) -> centerscol_group<-c('darkgreen','blue')lgd_points = Legend(labels = names(table(cc$group)), type = "points",title_position = "topleft",title = "Group",title_gp = gpar(col='black',fontsize = 7, fontface='bold'),legend_gp = gpar(col = col_group),labels_gp = gpar(col='black',fontsize = 5),grid_height = unit(2, "mm"),grid_width = unit(2, "mm"),background = col_group)draw(lgd_points, x = unit(15, "mm"), y = unit(50, "mm"),just = c("right", "bottom"))
OK ，搞定！
参考资料：
https://github.com/TheHumphreysLab/plot1cell
◆ ◆ ◆ ◆ ◆
精心整理（含图PLUS版）|R语言生信分析，可视化（R统计，ggplot2绘图，生信图形可视化汇总）
