复现顶刊单细胞气泡图——修改版！

原创

生信医道

发布于 2025-04-09 18:15:25

5170

文章被收录于专栏：顶刊美图顶刊美图单细胞分享

点击这里，获取示例数据和相关教程

前言

之前有一篇推文卡卡带大家复现了一个顶刊的气泡图，推文可见如下：

跟着顶刊学配色｜单细胞marker基因气泡图

复现之后卡卡总是觉得效果不尽人意！翻来覆去，卡卡找到原到了作者原文章的代码，再次进行复现，这次可以说是百分之百的还原度了！😍

后台回复20250409获得本文的示例数据

先来看原图：

Pan-cancer T cell atlas links a cellular stress response state to immunotherapy resistance

GitHub代码链接：https://github.com/Coolgenome/TCM/tree/main

复现

加载示例数据

rm(list=ls())
library(Seurat)         # 用于单细胞数据分析


# 设置工作目录
setwd("./sxyd")

# 加载单细胞数据
load("./scRNA.Rdata")

绘图

markers <- c(
"MS4A1","BANK1","CD79A","TNFRSF13C","BCL11A",
"IL7R","CD3G","CD2","ITM2A","CD3D",
"IGLL1","MZB1","IGLL5","SSR4",
"KRT18","KRT19","DEFB1","CTSS","EPCAM","SOX4",
"RGS5","COL1A1","ACTA2","PDGFRB",
"LYZ","AIF1","RNASE1","C1QB","HLA - DRA",
"PECAM1","CDH5","SPARCL1","STC1","SPARC","TM4SF1","INSR",
"GNLY","GZMB","KLRD1","KLRF1","B3GNT7",
"APOA2","ALB","APOA1","AMBP","APOH","TTR"
)

colorsForDataType <- c("#6DCCDD", "#EDCAE0", "#F494BE", "#F9B26C", "#A6ADCC", "#C4DA5D")

Idents(scRNA)="celltype"

gene <- intersect(markers, rownames(scRNA))
p <- DotPlot(scRNA, features = rev(gene))
data <- p$data[,c('id','features.plot','pct.exp','avg.exp.scaled')]
table(data$id)
## data$id <- factor(data$id, levels = rev(dataTypeLevel))
plotx <- ggplot(data, aes(x = id, y = features.plot)) +
  geom_point(
    aes(fill = avg.exp.scaled, size = pct.exp),
    color = 'black',
    shape = 21,
    stroke = 0.01
  ) +
  xlab("") + ylab("") +
  scale_fill_gradientn(
    colors = c("#5DBCFF", "#6DCCFF", "white", colorsForDataType[3], "#F484AE")
  ) +
  scale_size(
    range = c(0, 3.2),
    limits = c(0, 100),
    breaks = c(0,20,40,60,80,100)
  ) +
  theme(
    text = element_text(size = 10),
    panel.grid.major = element_line(colour = "grey90", size = 0.2),
    panel.grid.minor = element_blank(),
    panel.background = element_blank(),
    axis.line = element_line(colour = "black"),
    axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1), # x轴文本靠右对齐
    axis.text.y = element_text(angle = 0, vjust = 0.5, hjust = 1), # y轴文本靠右对齐
    legend.position = "right", # 将图例放在右侧
    legend.title = element_text(size = 10)
  ) +
  guides(
    size = guide_legend(
      title.position = "top",
      title.hjust = 0.5,
      ncol = 1,
      byrow = TRUE,
      override.aes = list(stroke = 0.4)
    ),
    fill = guide_colourbar(
      title.position = "top",
      title.hjust = 0.5
    )
  )
ggsave( "dotplot.pdf", plotx, width = 4,
        height = 6.5)