SCpubr包:让你的单细胞测序分析图表更加高级好看,代码实操分享

R包封面

该R包由国外友人Enblacar完成,目前处于预印本阶段,旨在提供一种简化的方式,为已知的单细胞可视化生成可发布的图形。与“审美愉悦”一词一样主观,这是一组跨不同情节类型实施的主题修改。该软件包也可作为个人项目,具有未来的增长前景。

可以使用以下命令安装此软件包:

if(!requireNamespace("devtools", quietly = T)){
  install.packages("devtools") # If not installed.
}
devtools::install_github("enblacar/SCpubr")

同时,为了使该包正常执行,需要安装下列包:

  • colortools

  • dplyr

  • enrichR

  • forcats

  • ggbeeswarm

  • ggplot2

  • ggpubr

  • ggrastr

  • ggrepel

  • Matrix

  • Nebulosa

  • patchwork

  • pbapply

  • purrr

  • rlang

  • scales

  • Seurat

  • stringr

  • svglite

  • tidyr

  • viridis

可以使用以下命令安装所有软件包:

cran_packages <- c("colortools",
                   "dplyr",
                   "enrichR",
                   "forcats",
                   "ggbeeswarm",
                   "ggplot2",
                   "ggpubr",
                   "ggrepel",
                   "Matrix",
                   "patchwork",
                   "purrr",
                   "rlang",
                   "scales",
                   "Seurat",
                   "stringr",
                   "svglite",
                   "tidyr",
                   "viridis")
install.packages(cran_packages)
bioconductor_packages <- c("Nebulosa")
if (!require("BiocManager", quietly = TRUE))
    install.packages("BiocManager")
BiocManager::install(bioconductor_packages)

seura对象的准备质控与降维

#引用R包
library(dplyr)
library(Seurat)
library(patchwork)
library(ggplot2)
library(SingleR)
library(CCA)
library(clustree)
library(cowplot)
library(monocle)
library(tidyverse)
library(SCpubr)

#设置目录并读取data文件夹下的10X文件
data_dir <- paste0(getwd(),"/data") #路径必须中文
samples=list.files(data_dir)
dir=file.path(data_dir,samples)
afdata <- Read10X(data.dir = dir)
# 简单创建一个seurat对象“sample”,每个feature至少在3细胞中表达同时每个细胞中至少200个feature被检测到
sample <- Seurat::CreateSeuratObject(counts = afdata,
                                     project = "SeuratObject",
                                     min.cells = 3,
                                     min.features = 200)
# 计算一下线粒体与核糖体基因的百分比,在sample@meta.data添加列名"percent.mt"与"percent.rb"
sample <- Seurat::PercentageFeatureSet(sample, pattern = "^MT-", col.name = "percent.mt")
sample <- Seurat::PercentageFeatureSet(sample, pattern = "^RP", col.name = "percent.rb")
# 质控
mask1 <- sample$nCount_RNA >= 1000
mask2 <- sample$nFeature_RNA >= 500
mask3 <- sample$percent.mt <= 20
mask <- mask1 & mask2 & mask3
sample <- sample[, mask]
# 标准化
sample <- Seurat::SCTransform(sample)
# 简单降个维
sample <- Seurat::RunPCA(sample)
sample <- Seurat::RunUMAP(sample, dims = 1:30)
sample <- Seurat::RunTSNE(sample, dims = 1:30)
# 分一下cluster
sample <- Seurat::FindNeighbors(sample, dims = 1:30)
sample <- Seurat::FindClusters(sample, resolution = 1.2)
#简单注释一下
refdata=celldex::HumanPrimaryCellAtlasData()
afdata <- GetAssayData(sample, slot="data")
cellpred <- SingleR(test = afdata,
                    ref = refdata,
                    labels = refdata$label.main,
                    method = "cluster",
                    clusters = sample@meta.data$seurat_clusters)
metadata <- cellpred@metadata
celltype = data.frame(ClusterID = rownames(cellpred),
                      celltype = cellpred$labels,
                      stringsAsFactors = F)
#########细胞注释后结果可视化
newLabels=celltype$celltype
names(newLabels)=levels(sample)
sample=RenameIdents(sample, newLabels)

三种算法简单可视化一下:

#简单可视化一下
p1<-DimPlot(sample, reduction = "pca")
p2<-DimPlot(sample, reduction = "tsne")
p3<-DimPlot(sample, reduction = "umap")
p1+p2+p
image.png

增加一列celltype到sample@metada里:

#增加一列为celltype的对象
kk=as.data.frame(sample@active.ident)
colnames(kk)="celltype"
identical(colnames(sample),row.names(kk))
sample$celltype <-kk$celltype
identical(sample@meta.data[,"celltype"],kk[,"celltype"])
afmeta <- sample@meta.data
metada表头

使用SCpubr的do_DimPlot函数降维:

p4<-do_DimPlot(sample = sample,
                   plot.title = "af object",
                   reduction = "pca",
                   dims = c(2, 1)) #选择展示的主成分,这边是PC2与PC1
p5<-do_DimPlot(sample = sample,
                   plot.title = "af object",
                   reduction = "tsne",
                   dims = c(2, 1))
p6<-do_DimPlot(sample = sample,
                   plot.title = "af object",
                   reduction = "umap",
                   dims = c(2, 1))
p4+p5+p6
image.png

图片调整:

#更改图例位置置顶top并修改列数为2(放在左边则为left)
p4<-do_DimPlot(sample = sample,
                       plot.title = "My object", #标题
                       reduction = "pca",
                       legend.position = "top",
                       legend.ncol = 2,
                       dims = c(2, 1))
p5<-do_DimPlot(sample = sample,
                       plot.title = "My object",
                       reduction = "tsne",
                       legend.position = "top",
                       legend.ncol = 2,
                       dims = c(2, 1))
p6<-do_DimPlot(sample = sample,
                       plot.title = "My object",
                       reduction = "umap",
                       legend.position = "top",
                       legend.ncol = 2,
                       dims = c(2, 1))
p4+p5+p6
image.png

换个展示形式(细胞反倒没那么好看了):

#使用标签而不是图例
p4<-do_DimPlot(sample = sample,
                       plot.title = "My object",
                       reduction = "pca",
                       legend.position = "top",
                       legend.ncol = 2,
                       dims = c(2, 1),
                       label = TRUE,
                       legend = FALSE)
p5<-do_DimPlot(sample = sample,
                       plot.title = "My object",
                       reduction = "tsne",
                       legend.position = "top",
                       legend.ncol = 2,
                       dims = c(2, 1),
                       label = TRUE,
                       legend = FALSE)
p6<-do_DimPlot(sample = sample,
                       plot.title = "My object",
                       reduction = "umap",
                       legend.position = "top",
                       legend.ncol = 2,
                       dims = c(2, 1),
                       label = TRUE,
                       legend = FALSE)
p4+p5+p6
image.png

换个颜色吧(配色鬼才):

# colors.use换个颜色吧,红黄蓝绿橙紫(配色鬼才)
colors <- c("Chondrocytes" = "red",
            "Endothelial_cells" = "yellow",
            "Tissue_stem_cells" = "blue",
            "Monocyte" = "green",
            "T_cells" = "Orange",
            "NK_cell" = "Purple"
            )
p4<-do_DimPlot(sample = sample,
                       plot.title = "My object",
                       reduction = "pca",
                       legend.position = "top",
                       legend.ncol = 2,
                       dims = c(2, 1),
                       label = TRUE,
                       legend = FALSE,
                       colors.use = colors)
p5<-do_DimPlot(sample = sample,
                       plot.title = "My object",
                       reduction = "tsne",
                       legend.position = "top",
                       legend.ncol = 2,
                       dims = c(2, 1),
                       label = TRUE,
                       legend = FALSE,
                       colors.use = colors)
p6<-do_DimPlot(sample = sample,
                       plot.title = "My object",
                       reduction = "umap",
                       legend.position = "top",
                       legend.ncol = 2,
                       dims = c(2, 1),
                       label = TRUE,
                       legend = FALSE,
                       colors.use = colors)
p4+p5+p6
image.png

看看多个特征(如基因,线粒体含量等)的分布:

#单个特征基因的展示
do_FeaturePlot(sample,
      features = "CD14",
        plot.title = "CD14",
        ncol = 1,
        dims = c(2, 1))
#多个特征基因查询
do_FeaturePlot(sample,
           features = c("percent.mt","percent.rb", "CD14"),
           plot.title = "A collection of features",
           ncol = 3,
           dims = c(2, 1))
单个基因
多个基因或特征

**弱化某些细胞亚群的展示,即标成灰色,只看我们关注的细胞群之间的差异

#最后一行输入想弱化展示的细胞名
do_FeaturePlot(sample,
                       features = "CD14",
                       plot.title = "CD14",
                       ncol = 3,
                       dims = c(2, 1),
                       idents.highlight = levels(sample)[!(levels(sample) %in% c("Monocyte","Tissue_stem_cells","T_cells","NK_cell" ))])
image.png

换个配色:

do_FeaturePlot(sample,
                       features = "percent.mt",
                       plot.title = "percent.mt",
                       ncol = 1,
                       dims = c(2, 1),
                       viridis_color_map = "A")

SCpubr包 ****viridis_color_map****参数支持8种连续变量配色:

  • A - 岩浆颜色图。
  • B - 地狱色图。
  • C - 等离子颜色图。
  • D - viridis 颜色图。
  • E - cividis 彩色地图。
  • F——火箭彩图。
  • G - mako 彩色地图。
  • H - 涡轮彩色图。
    image.png

小提琴图

do_VlnPlot(sample = sample,
                   features = "ACTB",
                   boxplot_width = 0.5) #箱子的宽度
image.png

换个配色(配色鬼才)

# colors.use换个颜色吧,红黄蓝绿橙紫(配色鬼才)
colors <- c("Chondrocytes" = "red",
            "Endothelial_cells" = "yellow",
            "Tissue_stem_cells" = "blue",
            "Monocyte" = "green",
            "T_cells" = "Orange",
            "NK_cell" = "Purple"
)
do_VlnPlot(sample = sample,
                   features = "ACTB",
                   boxplot_width = 0.5,
                   colors.use = colors)

image.png

蜂群图

#蜂群图,看看某个基因的含量吧
do_BeeSwarmPlot(sample = sample,
               feature_to_rank = "ACTB",
               group.by = "celltype", #按什么分组比较
                continuous_feature = T)
image.png

同样可以使用viridis_color_map参数更换魔鬼配色

#魔鬼配色
do_BeeSwarmPlot(sample = sample,
                feature_to_rank = "ACTB",
                group.by = "celltype",
                continuous_feature = T, viridis_color_map = "A")
image.png

**画个点图吧家人们

#点图,将需要展示的基因复制为
genesgenes <- c("IL7R", "CCR7", "CD14", "LYZ", "S100A4", "MS4A1", "CD8A", "FCGR3A", "MS4A7", "GNLY", "NKG7", "FCER1A", "CST3", "PPBP")
do_DotPlot(sample = sample,
           features = genes,
           flip = T) #翻转坐标轴
image.png

当然也可以分区块进行细胞注释

#当然也可以分区块,这个时候genes就得是列表了
genes <- list("Chondrocytes" = c("IL7R", "CCR7"),
             "Endothelial_cells" = c("CD14", "LYZ"),
             "Monocyte" = c("CD8A"),
            "T_cells" = c("FCGR3A", "MS4A7"),
             "NK_cell" = c("GNLY", "NKG7"))
             
do_DotPlot(sample = sample,features = genes)
image.png

换个配色

#换个配色
do_DotPlot(sample = sample,
                   features = genes,
                   colors.use = c("blue","red"))
image.png

柱状图展示一下各细胞群的cluster含量

#柱状图
do_BarPlot(sample = sample,
           features = "celltype",
           group.by = "seurat_clusters",
           legend = T,
           horizontal = T,
           add.summary_labels = T,
           add.subgroup_labels = T,
           repel.summary_labels = T,
           repel.subgroup_labels = T)
image.png

只有一个样本展示不了样本中细胞亚群的比例了,这里放一下官方文档的示例:

image.png

单细胞的基因集富集展示

#基因集富集
GS <- list("MAPK single" = c("MAPK1","MAPK2","MAPK4","IL1B","AKT","IL7R", "CCR7"),
              "P53 single" = c("BAX","AKR", "BCL2","ACTB","TP53"),
              "JAK-STAT single" = c("MAPK2","MAPK4","IL1B","AKT","IL7R", "CCR7"),
              "cell cycle" = c("FCGR3A", "MS4A7","GNLY", "NKG7","CD8A"),
              "Death" = c("BAX","AKR", "BCL2","MAPK1","MAPK2"))
do_EnrichmentHeatmap(sample = sample,
                     list_genes = GS,
                     group.by = "celltype",
                     transpose = T, #是否装置
                     column_names_rot = 90,row_names_rot = 0, #行列的宽度
                     cell_size = 5        #格子大小
                     )
image.png

关注”生信碱移“公众号后台回复:newafdata,即可获得示例文件与代码
说这么多了,快去实操一下吧

©著作权归作者所有,转载或内容合作请联系作者
  • 序言:七十年代末,一起剥皮案震惊了整个滨河市,随后出现的几起案子,更是在滨河造成了极大的恐慌,老刑警刘岩,带你破解...
    沈念sama阅读 204,684评论 6 478
  • 序言:滨河连续发生了三起死亡事件,死亡现场离奇诡异,居然都是意外死亡,警方通过查阅死者的电脑和手机,发现死者居然都...
    沈念sama阅读 87,143评论 2 381
  • 文/潘晓璐 我一进店门,熙熙楼的掌柜王于贵愁眉苦脸地迎上来,“玉大人,你说我怎么就摊上这事。” “怎么了?”我有些...
    开封第一讲书人阅读 151,214评论 0 337
  • 文/不坏的土叔 我叫张陵,是天一观的道长。 经常有香客问我,道长,这世上最难降的妖魔是什么? 我笑而不...
    开封第一讲书人阅读 54,788评论 1 277
  • 正文 为了忘掉前任,我火速办了婚礼,结果婚礼上,老公的妹妹穿的比我还像新娘。我一直安慰自己,他们只是感情好,可当我...
    茶点故事阅读 63,796评论 5 368
  • 文/花漫 我一把揭开白布。 她就那样静静地躺着,像睡着了一般。 火红的嫁衣衬着肌肤如雪。 梳的纹丝不乱的头发上,一...
    开封第一讲书人阅读 48,665评论 1 281
  • 那天,我揣着相机与录音,去河边找鬼。 笑死,一个胖子当着我的面吹牛,可吹牛的内容都是我干的。 我是一名探鬼主播,决...
    沈念sama阅读 38,027评论 3 399
  • 文/苍兰香墨 我猛地睁开眼,长吁一口气:“原来是场噩梦啊……” “哼!你这毒妇竟也来了?” 一声冷哼从身侧响起,我...
    开封第一讲书人阅读 36,679评论 0 258
  • 序言:老挝万荣一对情侣失踪,失踪者是张志新(化名)和其女友刘颖,没想到半个月后,有当地人在树林里发现了一具尸体,经...
    沈念sama阅读 41,346评论 1 299
  • 正文 独居荒郊野岭守林人离奇死亡,尸身上长有42处带血的脓包…… 初始之章·张勋 以下内容为张勋视角 年9月15日...
    茶点故事阅读 35,664评论 2 321
  • 正文 我和宋清朗相恋三年,在试婚纱的时候发现自己被绿了。 大学时的朋友给我发了我未婚夫和他白月光在一起吃饭的照片。...
    茶点故事阅读 37,766评论 1 331
  • 序言:一个原本活蹦乱跳的男人离奇死亡,死状恐怖,灵堂内的尸体忽然破棺而出,到底是诈尸还是另有隐情,我是刑警宁泽,带...
    沈念sama阅读 33,412评论 4 321
  • 正文 年R本政府宣布,位于F岛的核电站,受9级特大地震影响,放射性物质发生泄漏。R本人自食恶果不足惜,却给世界环境...
    茶点故事阅读 39,015评论 3 307
  • 文/蒙蒙 一、第九天 我趴在偏房一处隐蔽的房顶上张望。 院中可真热闹,春花似锦、人声如沸。这庄子的主人今日做“春日...
    开封第一讲书人阅读 29,974评论 0 19
  • 文/苍兰香墨 我抬头看了看天上的太阳。三九已至,却和暖如春,着一层夹袄步出监牢的瞬间,已是汗流浃背。 一阵脚步声响...
    开封第一讲书人阅读 31,203评论 1 260
  • 我被黑心中介骗来泰国打工, 没想到刚下飞机就差点儿被人妖公主榨干…… 1. 我叫王不留,地道东北人。 一个月前我还...
    沈念sama阅读 45,073评论 2 350
  • 正文 我出身青楼,却偏偏与公主长得像,于是被迫代替她去往敌国和亲。 传闻我的和亲对象是个残疾皇子,可洞房花烛夜当晚...
    茶点故事阅读 42,501评论 2 343

推荐阅读更多精彩内容