社区首页 >专栏 >scRNA复现|所见即所得，和Cell学umap，plot1cell完成惊艳的细胞注释umap图

scRNA复现|所见即所得，和Cell学umap，plot1cell完成惊艳的细胞注释umap图

生信补给站

发布于 2023-08-25 02:27:24

2.4K00

代码可运行

文章被收录于专栏：生信补给站生信补给站

运行总次数：0

代码可运行

单细胞常见的可视化方式有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 object
add_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 subtypes
Fibroblast <- sub.celltype_list$Fibroblast
Idents(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_Fib

points(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_metax*0.32-1.2和后面Fibroblast_metay*0.32-0.73 中的 0.32 ，1.2 ，0.73等数值代表位置，可能需要多次尝试。

#T subtypes
T.sub <- sub.celltype_list$T
subcolors <- 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_T
points(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 subtypes
Myeloid.sub <- sub.celltype_list$Myeloid
subcolors <- 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_Mye
points(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 subtype
Epi.sub <- sub.celltype_list$Epi
subcolors <- 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_Epi

points(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)) -> centers
col_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"))