UMAP/t-SNE 左下角自定义箭头坐标轴

Original JunJunLab 老俊俊的生信笔记 2022-08-20

收录于合集 #单细胞笔记 21个

金箍当头,欲说还休

1引言

单细胞 UMAP/t-SNE 聚类图,在某些文章里,左下角的坐标轴是这样:

它省去了默认的 两个 PC 主成分的数值坐标轴, 大家好像似乎比较倾向于更喜欢这种样式的,也行看起来比较简洁。因为 seurat 的 DimPlot 函数输出绘图并不是这样的,但是自己去画似乎又有些麻烦,于是在这里我分享一些绘制左下角箭头样的坐标轴给大家。

2加载 R 包和数据集

library(Seurat)
library(ggplot2)
library(ggsci)
library(grid)
library(ggrepel)
library(tidyverse)
library(SeuratData)
library(tidydr)
library(patchwork)
library(pbmc3k.SeuratData)

# load data
pbmc3k <- LoadData("pbmc3k", type = "pbmc3k.final")
pbmc3k <- UpdateSeuratObject(object = pbmc3k)
pbmc3k

# An object of class Seurat
# 13714 features across 2638 samples within 1 assay
# Active assay: RNA (13714 features, 2000 variable features)
# 2 dimensional reductions calculated: pca, umap

数据做了 PCA 和 UMAP,这里再做一个 TSNE 的聚类可视化:

# TSNE cluster
pbmc3k <- RunTSNE(pbmc3k, dims = 1:10)

3绘图

提取前两个主成分数据:

# extact PC ranges
pc12 <- Embeddings(object = pbmc3k,reduction = 'tsne') %>%
  data.frame()

# check
head(pc12,3)

#                    tSNE_1     tSNE_2
# AAACATACAACCAC -11.623140   6.503336
# AAACATTGAGCTAC -24.344204 -22.695458
# AAACATTGATCAGC  -1.332336  23.519638

构造坐标轴需要的标签和位置信息:

# get botomn-left coord
lower <- floor(min(min(pc12$tSNE_1),min(pc12$tSNE_2))) - 2

# get relative line length
linelen <- abs(0.3*lower) + lower

# mid point
mid <- abs(0.3*lower)/2 + lower

# axies data
axes <- data.frame(x = c(lower,lower,lower,linelen),y = c(lower,linelen,lower,lower),
                   group = c(1,1,2,2),
                   label = rep(c('t-SNE2','t-SNE1'),each = 2))

# axies label
label <- data.frame(lab = c('t-SNE2','t-SNE1'),angle = c(90,0),
                    x = c(lower - 3,mid),y = c(mid,lower - 2.5))

可视化:

# plot
DimPlot(pbmc3k,reduction = 'tsne',label = T) +
  NoAxes() + NoLegend() +
  theme(aspect.ratio = 1) +
  scale_colour_lancet() +
  geom_line(data = axes,
            aes(x = x,y = y,group = group),
            arrow = arrow(length = unit(0.1, "inches"),
                          ends="last", type="closed")) +
  geom_text(data = label,
            aes(x = x,y = y,angle = angle,label = lab),fontface = 'italic')

4Y 叔的 tidydr

前不久 Y 叔写的 tidydr 包里的 theme_br 函数也可以达到一样的效果:

DimPlot(pbmc3k,reduction = 'tsne',label = T) +
  scale_colour_npg() +
  theme_dr(xlength = 0.3,
           ylength = 0.3,
           arrow = grid::arrow(length = unit(0.1, "inches"), type = "closed")) +
  NoLegend() +
  theme(aspect.ratio = 1,
        panel.grid = element_blank())

5构造函数

为了方便,将以上代码进行部分修改和修饰,包装成函数,使其更方便的进行绘图,函数测试:

# test plot
# umap
umap <- AddCornerAxes(object = pbmc3k,reduction = 'umap',
              relLength = 0.3,relDist = 0.08)

# tsne
tsne <- AddCornerAxes(object = pbmc3k,reduction = 'tsne',
              relLength = 0.2,relDist = 0.08)

# combine
umap + tsne