R-南丁格尔玫瑰图: 人民日报都在用的细胞分群占比图

2020年3月12日的疫情图片

最近人民日报的NCP疫情图引起了很多科研工作者的兴趣，公众号EasyShu上推出了R语言ggplot2，以及Python版本的仿制效果。既然是一种，表明分类数量关系的图形，肯定能用于我们单细胞分群后亚群细胞数量的可视化了。

首先我们seurat自带的数据集用执行简单的分群。

rm(list=ls())
library(clustree)
library(Seurat)
package.version("Seurat")

pbmc_small <- FindClusters(
  object = pbmc_small,
  resolution = c(0.4, 0.8, 1.2,1.6),
  save.SNN = TRUE
)
head(pbmc_small@meta.data)

                  orig.ident nCount_RNA nFeature_RNA RNA_snn_res.0.8 letter.idents groups RNA_snn_res.1
ATGCCAGAACGACT SeuratProject         70           47               0             A     g2             0
CATGGCCTGTGCAT SeuratProject         85           52               0             A     g1             0
GAACCTGATGAACC SeuratProject         87           50               0             B     g2             0
TGACTGGATTCTCA SeuratProject        127           56               0             A     g2             0
AGTCAGACTGCACA SeuratProject        173           53               0             A     g2             0
TCTGATACACGTGT SeuratProject         70           48               0             A     g1             0
               RNA_snn_res.0.4 RNA_snn_res.1.2 RNA_snn_res.1.6 seurat_clusters
ATGCCAGAACGACT               0               1               3               3
CATGGCCTGTGCAT               0               5               9               9
GAACCTGATGAACC               0               5              11              11
TGACTGGATTCTCA               0               1               7               7
AGTCAGACTGCACA               0               1               3               3
TCTGATACACGTGT               0               1               3               3

亚群数量太少了展示出来就不好看了,我选用RNA_snn_res.1.6的结果。

library(tidyverse)
table(pbmc_small@meta.data$RNA_snn_res.1.6)

 0  1 10 11  2  3  4  5  6  7  8  9 
17 14  2  4  9  6  7  5  5  3  6  2 

然后我们根据分群的结果生成绘图数据框：

as.data.frame(table(pbmc_small@meta.data$RNA_snn_res.1.6)) -> dat
dat[order(as.numeric(dat$Freq)),]-> dat
id=1:length(dat$Var1)
dat <- data.frame(dat,id)


dat <-
  dat %>%
  mutate(
    label = case_when(
      id >= 9 ~ paste0("C", Var1 , "\n", Freq),
      id < 9  ~ paste0("C", Var1 , ":", Freq)
    )
  )

dat$Var1 <-factor(dat$Var1,levels=dat$Var1) 

head(dat)

  Var1 Freq id label
1   10    2  1 C10:2
2    9    2  2  C9:2
3    7    3  3  C7:3
4   11    4  4 C11:4
5    5    5  5  C5:5
6    6    5  6  C6:5

开始第一阶段绘图：南丁格尔玫瑰图之前世——柱形图

p1 <- ggplot(data = dat, aes(x = Var1, y = Freq, label = label)) +
  geom_col(aes(fill = id), width = 1, size = 0) +
  geom_col(
    aes(y = 5),
    fill = "white",
    width = 1,
    alpha = 0.2,
    size = 0
  ) +
  geom_col(
    aes(y = 2.5),
    fill = "white",
    width = 1,
    alpha = 0.2,
    size = 0
  )

p1

这里有个知识点，通过geom_col来控制下半部分的颜色层次。

南丁格尔玫瑰花：

p2 <-
  p1 +
  coord_polar() +
  theme_void() +
  scale_y_continuous(limits = c(0, 20))
p2

精细的控制需要注意坐标轴的搭配，不然容易不协调。接下来我们添加标签。

p3 <-
  p2 +
  geom_text(
    dat = . %>% dplyr::filter(id < 9),
    nudge_y = 1,
    angle = 95 - 180 * c(1:8) / 8,
    fontface = "bold",
    size = 2
  ) +
  geom_text(
    data = . %>% dplyr::filter(id>=9),
    nudge_y = -1,
    fontface = "bold",
    angle = 80 - 75 * c(1:4)/4,
    size = 3,
    color = "white",
  )
p3

最后我们用拾色器让它更像人民日报的风格主题：

p4 <-
  p3 +
  scale_fill_gradientn(
    colors = c("#54778f", "#4EB043", "#E69D2A", "#DD4714", "#A61650"),
    guide = F
  )
p4

本文基本是模仿Angus在 [EasyShu]上的代码，更多参数解释参见大佬原文：

---

R-南丁格尔玫瑰图: 仿制效果最好的疫情玫瑰图