首页
学习
活动
专区
圈层
工具
发布
30 篇文章
1
使用PHATE复现Science Immunology上文章的结果
2
你确定你研究的是成纤维细胞吗
3
读取loom格式的单细胞文件
4
velocyto的正确安装方法
5
Seurat4.0系列教程20:单细胞对象的格式转换
6
Seurat4.0系列教程8:细胞周期评分和回归分析
7
MACA: 一款自动注释细胞类型的工具
8
肺癌四阶段:AAH-AIS-MIA-IA的单细胞图谱
9
你认为是双细胞人家说是全新细胞亚群
10
copykat为什么没有infercnv直观呢
11
一大波神经元单细胞亚群相关的标志基因
12
单细胞转录组分析—追踪移植后造血干细胞的分化
13
单细胞转录组揭示肺腺癌特有的肿瘤微环境
14
小细胞肺癌(SCLC)病人的scRNA-seq数据分析
15
单细胞转录组分析COVID-19重症患者肺泡巨噬细胞亚型
16
CancerSCEM: 人类癌症单细胞表达图谱数据库
17
你真的需要如此多的单细胞亚群注释工具吗
18
使用PHATE进行单细胞高维数据的可视化
19
小鼠早期原肠化的转录异质性和细胞命运决定的scRNA-seq图谱
20
单细胞测序揭示PD-L1免疫治疗联合紫杉醇化疗在三阴性乳腺癌中的作用机制
21
单细胞转录组的细分亚群的降维聚类分群加上gsea或者gsva以及转录因子和拟时序流程(仅需8000元)
22
单细胞不同亚群和状态能区分吗
23
肿瘤相关成纤维细胞异质性
24
肿瘤样品的单细胞需要提取上皮细胞继续细分
25
乳腺癌患者抗PD1治疗期间肿瘤内变化的单细胞图谱
26
晚期非小细胞肺癌肿瘤异质性和微环境的单细胞分析
27
脑组织单细胞悬液制备流程
28
什么,你想要的单细胞亚群比例太少了?
29
让Single cell UMAP注释支棱起来
30
RNAvelocity4:velocyto.R的使用
清单首页生信文章详情

让Single cell UMAP注释支棱起来

分享是一种态度

最近在画UMAP的时候发现有的时候细胞亚群的注释与点重合颜色上不是很搭配,同事提出让注释“支棱”起来,首先想到的是ggforce中的geom_mark_ellipse,实践中遇到一些问题(比如,ggforce会受outlier影响,看起来比较乱),于是有了这一篇Single cell的记录。

ggforee

受outlier影响

尝试用ggforce注释

代码语言:javascript
复制
library(dplyr)
library(Seurat)
library(SeuratData)
library(patchwork)
library(ggforce)
##InstallData("pbmc3k")
data("pbmc3k")
代码语言:javascript
复制
points <- 
  data.frame(pbmc3k.final@reductions$umap@cell.embeddings, cluster=Idents(pbmc3k.final))
DimPlot(pbmc3k.final) + 
  geom_mark_ellipse(data=points, aes(x=UMAP_1, y=UMAP_2, label=cluster, col=cluster),
                    inherit.aes = F) + 
  NoLegend()

版本一

非常难看不是吗?因为有一些cluster(Naive CD4 T)存在异常值,ggforce中的函数会包含所有的点。所以应该将异常值去掉,这个方法有很多,我使用的是之前用到的置信椭圆的方法。

修改

思路如下:

  • 对每一个cluster计算一个尽量小的置信椭圆
  • 用置信椭圆上的点来画geom_mark_ellipse
代码语言:javascript
复制
points <- 
  data.frame(pbmc3k.final@reductions$umap@cell.embeddings, cluster=Idents(pbmc3k.final))
## adapted from https://github.com/fawda123/ggord/blob/master/R/ggord.R
theta <- c(seq(-pi, pi, length = 50), seq(pi, -pi, length = 50))
circle <- cbind(cos(theta), sin(theta))
library(plyr)
aux <- function(x, one, two, prob=0.8) {
    if(nrow(x) <= 2) {
      return(NULL)
    }
    sigma <- var(cbind(x[,one], x[,two]))
    mu <- c(mean(x[,one]), mean(x[,two]))
    ed <- sqrt(qchisq(prob, df = 2))
    data.frame(sweep(circle %*% chol(sigma) * ed, 2, mu, FUN = '+'))
}
ell <- plyr::ddply(points, "cluster", aux, one="UMAP_1", two="UMAP_2")
DimPlot(pbmc3k.final) + 
  geom_mark_ellipse(data=ell, aes(x=X1, y=X2, label=cluster, col=cluster),
                    inherit.aes = F) + 
  NoLegend()

版本二

微调

下面就是进行一些微调,将椭圆缩小使注释指在亚群上更好的位置

代码语言:javascript
复制
## 调整prob参数
ell <- plyr::ddply(points, "cluster", aux, one="UMAP_1", two="UMAP_2", prob=0.1)
DimPlot(pbmc3k.final) + 
  geom_mark_ellipse(data=ell, aes(x=X1, y=X2, label=cluster, col=cluster),
                    inherit.aes = F) + 
  NoLegend()

把椭圆隐藏

代码语言:javascript
复制
DimPlot(pbmc3k.final) + 
  geom_mark_ellipse(data=ell, aes(x=X1, y=X2, label=cluster, group=cluster),
                    color=NA,
                    inherit.aes = F) + 
  NoLegend()
下一篇
举报
领券