muscat代码实操(二):scRNA-seq数据的差异状态分析

前言

我们在前两期的推文:muscat:专注于多样本多分组的单细胞差异分析muscat代码实操(一):模拟复杂的 scRNA-seq 数据以及评估不同的差异表达分析方法的性能中,分别介绍了muscat的功能框架以及如何使用muscat模拟复杂的scRNA-seq数据和评估不同的差异表达分析方法的性能。在本期的推文中,我们将深入探讨muscat包的核心功能——差异状态分析(DS分析)。DS分析的目标是揭示细胞在不同条件或时间点下的功能状态及其行为的变化。

为了让大家更系统地理解,我们将按照以下五个步骤进行介绍:

  1. 单细胞数据的质控
  2. 将数据调整为muscat包所需的格式
  3. DS分析
  4. 结果的筛选和过滤
  5. 结果可视化

希望通过这样的步骤,大家能够更加清晰地掌握DS分析的全过程,并能够在实际研究中进行有效应用。接下来,让我们来一起学习一下这项分析吧。


代码流程

0. 加载R包和数据

数据来源:GSE96583;包含8名狼疮患者在IFN-β治疗前后获得的scRNA-seq PBCM数据,数据集包含大约35000个基因和29000个细胞。

library(dplyr)
library(ggplot2)
library(limma)
library(muscat)
library(purrr)
library(ExperimentHub)
eh <- ExperimentHub()
query(eh, "Kang")
(sce <- eh[["EH2259"]])

1. 数据质控和格式准备

数据质控

# remove undetected genes
sce <- sce[rowSums(counts(sce) > 0) > 0, ]
dim(sce)
## [1] 18890 29065
# calculate per-cell quality control (QC) metrics
library(scater)
qc <- perCellQCMetrics(sce)
# remove cells with few or many detected genes
ol <- isOutlier(metric = qc$detected, nmads = 2, log = TRUE)
sce <- sce[, !ol]
dim(sce)
## [1] 18890 26820
# remove lowly expressed genes
sce <- sce[rowSums(counts(sce) > 1) >= 10, ]
dim(sce)
## [1]  7118 26820
# compute sum-factors & normalize
sce <- computeLibraryFactors(sce)
sce <- logNormCounts(sce)
library(sctransform)
assays(sce)$vstresiduals <- vst(counts(sce), verbosity = FALSE)$y

接下来,我们来看一下muscat要求输入的数据格式:

  • sample_id: 唯一的样本标识符,例如PeterPan_ref1、Nautilus_trt3等。
  • cluster_id: 子群体(或称为簇)的分配,例如T cells、monocytes等。
  • group_id: 实验组/条件,例如control/treatment、healthy/diseased等。
sce$id <- paste0(sce$stim, sce$ind)
(sce <- prepSCE(sce, 
    kid = "cell", # subpopulation assignments
    gid = "stim",  # group IDs (ctrl/stim)
    sid = "id",   # sample IDs (ctrl/stim.1234)
    drop = TRUE))  # drop all other colData columns

存储簇和样本ID以及它们的数量

nk <- length(kids <- levels(sce$cluster_id))
ns <- length(sids <- levels(sce$sample_id))
names(kids) <- kids
names(sids) <- sids

2. 数据概览

2.1 簇-样本大小

计算每个簇-样本组合中的细胞数量,并将结果转置。

# nb. of cells per cluster-sample
t(table(sce$cluster_id, sce$sample_id))
2.2 降维
# compute UMAP using 1st 20 PCs
sce <- runUMAP(sce, pca = 20)
接下来,定义了一个简单的包装函数.plot_dr()来美化降维图的输出。
.plot_dr <- function(sce, dr, col)
  plotReducedDim(sce, dimred = dr, colour_by = col) +
    guides(fill = guide_legend(override.aes = list(alpha = 1, size = 3))) +
theme_minimal() + theme(aspect.ratio = 1)
# downsample to max. 100 cells per cluster
cs_by_k <- split(colnames(sce), sce$cluster_id)
cs100 <- unlist(sapply(cs_by_k, function(u) 
  sample(u, min(length(u), 100))))
# plot t-SNE & UMAP colored by cluster & group ID
for (dr in c("TSNE", "UMAP"))
  for (col in c("cluster_id", "group_id"))
.plot_dr(sce[, cs100], dr, col)

对每个簇进行下采样,最多选择100个细胞。然后,它使用前面定义的.plot_dr()函数绘制t-SNE和UMAP图,这些图由簇ID和组ID分别着色。

image.png

3. 差异状态分析

作者主要考虑两种方法进行差异状态(DS)分析:

  • 直接作用于细胞水平的混合模型进行DS分析;
  • 基于聚合的方法对伪批量数据进行DS分析。
3.1 聚合单细胞数据为伪批量数据

为了利用现有的稳健的批量RNA-seq DE框架,如edgeR、DESeq2和limma,作者首先聚合每个样本(在每个簇中)的测量值以获得伪批量数据。

pb <- aggregateData(sce,
    assay = "counts", fun = "sum",
by = c("cluster_id", "sample_id"))
#使用aggregateData函数将数据聚合为伪批量数据。
# one sheet per subpopulation
assayNames(pb)
# pseudobulks for 1st subpopulation
t(head(assay(pb))) 
3.2 伪批量级别的MDS图

在进行任何正式的测试之前,我们可以计算聚合信号的多维缩放(MDS)图来探索样本之间的整体相似性。

(pb_mds <- pbMDS(pb))
#使用pbMDS函数计算伪批量数据的MDS图。
image.png

对上图进行美化

# use very distinctive shaping of groups & change cluster colors
pb_mds <- pb_mds + 
  scale_shape_manual(values = c(17, 4)) +
  scale_color_manual(values = RColorBrewer::brewer.pal(8, "Set2"))
# change point size & alpha
pb_mds$layers[[1]]$aes_params$size <- 5
pb_mds$layers[[1]]$aes_params$alpha <- 0.6
pb_mds
image.png
3.3 样本级分析:伪批量方法
# run DS analysis
res <- pbDS(pb, verbose = FALSE)
# access results table for 1st comparison
tbl <- res$table[[1]]
# one data.frame per cluster
names(tbl)
# view results for 1st cluster
k1 <- tbl[[1]]
head(format(k1[, -ncol(k1)], digits = 2))

考虑到实验设计的复杂性(例如,当存在两个以上的组时),可能需要明确指定感兴趣的比较。在这里作者提供了model.matrix函数为pbDS提供一个捕获实验设计的设计矩阵和limma包中的makeContrasts函数指定我们感兴趣的比较。

# construct design & contrast matrix
ei <- metadata(sce)$experiment_info
mm <- model.matrix(~ 0 + ei$group_id)
dimnames(mm) <- list(ei$sample_id, levels(ei$group_id))
library(limma)
contrast <- makeContrasts("stim-ctrl", levels = mm)
# run DS analysis
pbDS(pb, design = mm, contrast = contrast)
3.4 细胞级分析:混合模型

muscat提供了使用3种MM方法的实现。

# 1st approach
mm <- mmDS(sce, method = "dream",
  n_cells = 10, n_samples = 2,
  min_counts = 1, min_cells = 20)
# 2nd & 3rd approach
mm <- mmDS(sce, method = "vst", vst = "sctransform")
mm <- mmDS(sce, method = "nbinom")

4. 结果

接下来,我们介绍一下如何查看差异测试结果,以及计算和使用基因的表达频率进行进一步的结果过滤。

4.1 结果过滤
tbl_fil <- lapply(tbl, function(u) {
  u <- dplyr::filter(u, p_adj.loc < 0.05, abs(logFC) > 1)
  dplyr::arrange(u, p_adj.loc)
})

首先过滤出FDR小于5%和logFC大于1的结果,并按调整后的p值排序。

4.2 计算每个簇的DS基因数量和百分比
n_de <- vapply(tbl_fil, nrow, numeric(1))
p_de <- format(n_de / nrow(sce) * 100, digits = 3)
data.frame("#DS" = n_de, "%DS" = p_de, check.names = FALSE)
4.3 查看每个簇的前两个结果
top2 <- bind_rows(lapply(tbl_fil, top_n, 2, p_adj.loc))
format(top2[, -ncol(top2)], digits = 2)
4.4 计算表达频率

每个基因的表达频率,即每个样品和/或组中表达给定基因的细胞比例。frq <- calcExprFreqs(sce, assay = "counts", th = 0) 使用calcExprFreqs函数计算每个基因在每个样本和/或组中的表达频率。

# one sheet per cluster
assayNames(frq)
## [1] "B cells"           "CD14+ Monocytes"   "CD4 T cells"      
## [4] "CD8 T cells"       "Dendritic cells"   "FCGR3A+ Monocytes"
## [7] "Megakaryocytes"    "NK cells"
# expression frequencies in each
# sample & group; 1st cluster
t(head(assay(frq), 5))
##               NOC2L        HES4      ISG15    TNFRSF18     TNFRSF4
## ctrl101  0.09734513 0.000000000 0.08849558 0.061946903 0.008849558
## ctrl1015 0.07773109 0.008403361 0.18067227 0.090336134 0.021008403
## ctrl1016 0.08333333 0.013888889 0.20833333 0.048611111 0.000000000
## ctrl1039 0.06666667 0.033333333 0.33333333 0.100000000 0.033333333
## ctrl107  0.09803922 0.000000000 0.07843137 0.058823529 0.019607843
## ctrl1244 0.12686567 0.037313433 0.10447761 0.126865672 0.029850746
## ctrl1256 0.08750000 0.004166667 0.18750000 0.091666667 0.025000000
## ctrl1488 0.06837607 0.004273504 0.11965812 0.076923077 0.012820513
## stim101  0.08333333 0.055555556 0.98611111 0.020833333 0.006944444
## stim1015 0.08963585 0.072829132 0.99719888 0.044817927 0.005602241
## stim1016 0.03875969 0.054263566 1.00000000 0.007751938 0.023255814
## stim1039 0.05128205 0.051282051 1.00000000 0.025641026 0.025641026
## stim107  0.05357143 0.035714286 1.00000000 0.017857143 0.000000000
## stim1244 0.11702128 0.095744681 0.98936170 0.053191489 0.021276596
## stim1256 0.06635071 0.037914692 0.99526066 0.037914692 0.004739336
## stim1488 0.05653710 0.014134276 0.99646643 0.031802120 0.003533569
## ctrl     0.08509142 0.009845288 0.15963432 0.084388186 0.018284107
## stim     0.07235339 0.050266565 0.99543031 0.033511043 0.008377761
4.5 基于表达频率过滤结果
gids <- levels(sce$group_id)
frq10 <- vapply(as.list(assays(frq)), 
  function(u) apply(u[, gids] > 0.1, 1, any), 
  logical(nrow(sce)))
t(head(frq10))
##                   NOC2L  HES4 ISG15 TNFRSF18 TNFRSF4  SDF4
## B cells           FALSE FALSE  TRUE    FALSE   FALSE FALSE
## CD14+ Monocytes   FALSE  TRUE  TRUE    FALSE   FALSE  TRUE
## CD4 T cells       FALSE FALSE  TRUE    FALSE   FALSE FALSE
## CD8 T cells       FALSE FALSE  TRUE    FALSE   FALSE FALSE
## Dendritic cells   FALSE  TRUE  TRUE    FALSE    TRUE  TRUE
## FCGR3A+ Monocytes FALSE  TRUE  TRUE    FALSE   FALSE FALSE
## Megakaryocytes    FALSE FALSE  TRUE    FALSE   FALSE FALSE
## NK cells          FALSE FALSE  TRUE     TRUE   FALSE  TRUE
tbl_fil2 <- lapply(kids, function(k)
  dplyr::filter(tbl_fil[[k]], 
    gene %in% names(which(frq10[, k]))))
#首先确定哪些基因在至少一个组中的平均表达频率超过10%。随后过滤出这些基因的DS结果。
4.6 再次计算每个簇的DS基因数量和百分比
n_de <- vapply(tbl_fil2, nrow, numeric(1))
p_de <- format(n_de / nrow(sce) * 100, digits = 3)
data.frame("#DS" = n_de, "%DS" = p_de, check.names = FALSE)
##                   #DS   %DS
## B cells           226 3.175
## CD14+ Monocytes   622 8.738
## CD4 T cells       154 2.164
## CD8 T cells        94 1.321
## Dendritic cells   117 1.644
## FCGR3A+ Monocytes 382 5.367
## Megakaryocytes     28 0.393
## NK cells          160 2.248
再次计算每个簇中DS基因的数量和百分比,但这次是基于表达频率过滤后的结果。
4.7 结果格式化

当进行多个对比或系数测试时,runDS返回的结果可能会变得非常复杂,不便于探索或导出。resDS函数可以用来格式化这些结果,并提供了两种不同的格式化模式:bind = "row" 或 bind = "col"。

resDS(sce, res, bind = "row", frq = frq)
#所有比较的结果都会垂直合并(类似于do.call("rbind", ...))成一个整洁格式的表格,其中contrast/coef列指定了比较。这里还附加了预先计算的表达频率。
resDS(sce, res, bind = "col", cpm = TRUE)
#结果会水平合并成一个单一的宽表,其中给定基因和簇的所有结果都保留在一行中。相应的对比或系数的标识符会追加到列名中。这种格式在想要查看特定基因在多种处理中的行为时很有用,但在包含许多比较时会变得混乱。
4.8 直接计算表达频率

如果表达频率尚未使用calcExprFreqs预先计算,可以通过指定frq = TRUE直接将其添加到结果表中:

resDS(sce, res, frq = TRUE)

5. 可视化结果

差异性分析的目的是在不同条件下识别特定细胞群体的状态(或表达)的变化。在这种情境下,关键的问题是:哪些基因只在一个(或很少)细胞群体中显示差异表达?有多少差异表达的基因在细胞群体之间是共享的?也就是不同细胞群体之间的差异性发现的一致性是怎样的?

5.1 UpSet图

为了了解不同细胞群体之间关于差异表达基因的一致性,作者使用UpSet图(UpSet图是一种可视化集合交集的方法)可视化了在某些细胞群体中共享或独特的差异表达基因的数量。

library(UpSetR)
de_gs_by_k <- map(tbl_fil, "gene")
upset(fromList(de_gs_by_k))
image.png
5.2 DR colored by expression

一组由基因表达着色的t-SNE图,这些基因是所有细胞群体中的前8个DS基因。

top8 <- bind_rows(tbl_fil) %>% 
  top_n(8, dplyr::desc(p_adj.loc)) %>% 
  pull("gene")
#这里使用dplyr包的函数来提取所有细胞群体中的前8个DS基因。
ps <- lapply(top8, function(g)
  .plot_dr(sce[, cs100], "TSNE", g) + 
    ggtitle(g) + theme(legend.position = "none"))
#对于top8中的每个基因,都会生成一个由该基因的表达着色的t-SNE图。
plot_grid(plotlist = ps, ncol = 4, align = "vh")#排列并显示图形
image.png
5.3 细胞水平的小提琴图
plotExpression(sce[, sce$cluster_id == "B cells"],
  features = tbl_fil$`B cells`$gene[seq_len(6)],
  x = "sample_id", colour_by = "group_id", ncol = 3) +
  guides(fill = guide_legend(override.aes = list(size = 5, alpha = 1))) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))
image.png
5.4 Pseudobulk 热图
pbHeatmap(sce, res, top_n = 5)#展示每个细胞群体的前5个DS基因。
image.png

为单个细胞群体生成热图:

pbHeatmap(sce, res, k = "B cells")#这里展示了B细胞群体的前20个DS基因。
image.png

为所有细胞群体生成单个基因的热图:

pbHeatmap(sce, res, g = "ISG20")
image.png

小结

截止到目前,有关muscat的使用方法就都介绍完了。muscat在样本级别上对scRNA-seq进行差异分析,在一定程度上克服的scRNA-seq数据高噪声和稀疏性导致的差异基因表达分析的假阳性,有利于我们在研究中得到更为可靠的结论。在实际使用muscat的过程中,我们不难发现,该R包的设计非常全面和细致。它涵盖了从数据的质量控制到结果的可视化的整个流程,为科研工作者提供了极大的便利。感兴趣的小伙伴赶紧用起来吧。

好啦,本期的分享到这里就结束了,我们下期再会~~

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

推荐阅读更多精彩内容