Closed ixxmu closed 1 year ago
这周转录组周更憋个大招,细心的小伙伴可能也发现了,初学者暑期搞定单细胞这个专辑也是我写的,暑期磨磨蹭蹭总归也还是出来了点东西,但是开学后就没有时间搞单细胞了,和目前做的方向也不相干,一些我想做的,比如细胞通讯、拟时序分析,都还没来得及,不知道有没有朋友真的暑期实现了我立的flag“搞定”了单细胞。所以这期周更算是这个单细胞专辑的完结篇,我将系统地总结:单细胞水平样本samples间的差异分析、clusters间的差异分析鉴定marker、一些检索细胞亚型markers的数据库以及如何使用一些打分算法结合markers辅助确定细胞亚型,这四个问题。
内容很长,干货很多,小张让我分成两期推送,我想着反正最后一篇单细胞了,那就毕其功于一役吧。上期推文使用snakemake管理转录组流程,有一些小伙伴在评论区给我提出问题,这是我非常欣喜看到的,因为我本身是个生信菜狗,很多时候曾老师不一定有时间看我的推送帮我检查,我更多的时候是抱着学习的态度分享笔记,而不是教程。
主要参考:
生物学重复的不同条件下的scrna-seq数据的差异基因表达分析 (https://www.10xgenomics.com/resources/analysis-guides/differential-gene-expression-analysis-in-scrna-seq-data-between-conditions-with-biological-replicates)
需要注意的是,这部分差异表达分析不应与下一部分,计算来自两个簇的细胞之间的差异表达基因以用于标记基因鉴定或细胞类型注释混淆,它们是两种不同目的的不同分析
对于任何给定的细胞类型和条件,来自一个样本的细胞可能比来自不同样本的细胞更相似
为了获得有效的假设检验结果,已经开发了几种DGE算法来解释差异表达分析中来自同一样本的细胞的分组性质。这些算法包括拟合混合效应模型、对样本内细胞计数求和(pseudobulk)以及测试分布差异。
需要关注批次效应问题,就这个问题我们前面已经有所讨论harmony、不harmony,这是个问题
个人感觉单细胞是否需要去除批次效应比bulk更难判断,因为单细胞我们已经进入到了细胞亚型的层次,任何校正影响都很大,bulk这个时候对于case、control来说更“粗枝大叶”一些
一般来说,原始计数应用于DGE分析,而不是标准化或批量校正的数据
但是在细胞聚类鉴定亚型时往往需要将原始单细胞RNA测序数据标准化,以消除技术差异
参考 Batch Effect Correction Analysis Guide:
https://www.10xgenomics.com/resources/analysis-guides/introduction-batch-effect-correction
Mixed-effects model混合效应模型:处理相关数据的经典方法是使用混合效应模型,该模型使用随机效应来解释观测值之间的相关性。感兴趣的条件/组被建模为固定效应,并且样本特定的随机截距对来自相同样本(和细胞类型)的细胞之间的相关性进行建模。
Pseudobulk:使用标准统计软件在单细胞数据(数千次观测)的规模上拟合混合效应模型的计算量非常大。一种更简单的方法是总结每个样本的细胞类型内的UMI计数,并使用为bulk RNAseq开发的方法进行多条件DE。
Differential distribution test 差异分布测试:单细胞数据使我们能够估计和了解每个样本中相同细胞类型的细胞中基因表达的分布,而不是测试每个基因在不同条件下的平均表达差异。正如前两种方法所解决的那样,这些分布可能具有不同的手段,但差异分布测试也可以检测到更细微的差异,例如方差或模式数量的变化。我们可以测试这些分布在条件/组之间是否不同。
关于不同类型方法的介绍,参考:
各种方法代表性工具描述性总结表格
https://www.10xgenomics.com/resources/analysis-guides/differential-gene-expression-analysis-in-scrna-seq-data-between-conditions-with-biological-replicates
下面我就将挑选每种方法的代表性工具进行展示
在正式分析前,我还想提醒一个装包的问题,有的bioC的包在线安装会出现网络问题,我们往往会去bioconductor官网下载源码安装,有的时候bioC3.16 对应的R包源码无法访问,比如下面即将使用的muscat
我这里提供两种解决方法:
bioC3.17对于的R包并不是非4.3的R不能使用,只是可能会出现不能用的情况,主要还是去看看有哪些依赖
如果确实在线、bioconductor源码都无法访问,最后就是去github看看。但是github上当前托管的仓库代码应该是development的,并不是我们希望使用的stable版本,这个时候可以参考具体要使用的版本号,去仓库历史里返回之前commit的版本下载安装即可,参考:如何安装Github上特定版本号(每次提交的唯一标识)的R包?
参考:
Differential state analysis with
muscat
[http://www.bioconductor.org/packages/release/bioc/vignettes/muscat/inst/doc/analysis.html]
来自8名狼疮患者的10x基于液滴的scRNA-seq PBCM数据
数据来源:
https://www.ncbi.nlm.nih.gov/geo/query/acc.cgi?acc=GSE96583
使用官方教程提供的方法无法连接访问
去GEO查看提供的数据:
发现好像每个样本没有对应的genes信息,汇总的genes文件也不对,无法用 read10X
读取:
于是回到我的本地小电脑开启魔法,使用教程提供的方法获取数据:
# install.packages("interactiveDisplayBase_1.38.0.tar.gz",repos = NULL)
# install.packages("AnnotationHub_3.8.0.tar.gz",repos = NULL)
# install.packages("ExperimentHub_2.8.1.tar.gz",repos = NULL)
library(ExperimentHub)
eh <- ExperimentHub()
query(eh, "Kang")
options()$repos
# CRAN
# "https://cran.rstudio.com/"
# attr(,"RStudio")
# [1] TRUE
# install.packages("SingleCellExperiment_1.22.0.tar.gz",repos = NULL)
# install.packages("muscData_1.14.0.tar.gz",repos = NULL)
sce <- eh[["EH2259"]]
save(sce,file = "sce.Rdata")
保存好sce传给服务器
我这里把R的下载镜像从清华退回到了CRAN,因为我发现使用镜像会导致魔法失效
包含来自8名狼疮患者的10x基于液滴的scRNA-seq PBCM数据,这些数据在用IFN-β治疗6小时之前和之后获得
library(ExperimentHub)
eh <- ExperimentHub()
query(eh, "Kang")
ExperimentHub with 3 records
# snapshotDate(): 2022-10-31
# $dataprovider: NCI_GDC, GEO
# $species: Homo sapiens
# $rdataclass: character, SingleCellExperiment, BSseq
# additional mcols(): taxonomyid, genome, description, coordinate_1_based, maintainer,
# rdatadateadded, preparerclass, tags, rdatapath, sourceurl, sourcetype
# retrieve records with, e.g., 'object[["EH1661"]]'
title
EH1661 | Whole Genome Bisulfit Sequencing Data for 47 samples
EH1662 | Whole Genome Bisulfit Sequencing Data for 47 samples
EH2259 | Kang18_8vs8
数据集包含>35,000个基因和~29,000个细胞
EH2259 | Kang18_8vs8
sce <- eh[["EH2259"]]
load("sce.Rdata")
sce
class: SingleCellExperiment
dim: 35635 29065
metadata(0):
assays(1): counts
rownames(35635): MIR1302-10 FAM138A ... MT-ND6 MT-CYB
rowData names(2): ENSEMBL SYMBOL
colnames(29065): AAACATACAATGCC-1 AAACATACATTTCC-1 ... TTTGCATGGTTTGG-1 TTTGCATGTCTTAC-1
colData names(5): ind stim cluster cell multiplets
reducedDimNames(1): TSNE
mainExpName: NULL
altExpNames(0):
# remove undetected genes
sce <- sce[rowSums(counts(sce) > 0) > 0, ]
dim(sce)
使用perCellQCMetrics来计算各种每个细胞的质量控制指标,并如上所述继续过滤细胞和基因:
# 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)
# remove lowly expressed genes
sce <- sce[rowSums(counts(sce) > 1) >= 10, ]
dim(sce)
最后使用logNormCounts,通过将每个计数除以其大小因子、添加伪计数 1 和对数转换,来计算log2转换后的标准表达量
# compute sum-factors & normalize
sce <- computeLibraryFactors(sce)
sce <- logNormCounts(sce)
muscat期望输入 SCE 的特定格式。具体而言,必须提供以下单元格元数据 (colData) 列:
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
class: SingleCellExperiment
dim: 7118 26820
metadata(1): experiment_info
assays(2): counts logcounts
rownames(7118): NOC2L HES4 ... S100B PRMT2
rowData names(2): ENSEMBL SYMBOL
colnames(26820): AAACATACAATGCC-1 AAACATACATTTCC-1 ... TTTGCATGGTTTGG-1 TTTGCATGTCTTAC-1
colData names(3): cluster_id sample_id group_id
reducedDimNames(1): TSNE
mainExpName: NULL
altExpNames(0):
将聚类和样本 ID 以及聚类和样本的数量存储到以下简单变量中:
nk <- length(kids <- levels(sce$cluster_id))
ns <- length(sids <- levels(sce$sample_id))
names(kids) <- kids; names(sids) <- sids
nk;ns
kids;sids
[1] 8
[1] 16
B cells CD14+ Monocytes CD4 T cells CD8 T cells Dendritic cells FCGR3A+ Monocytes
"B cells" "CD14+ Monocytes" "CD4 T cells" "CD8 T cells" "Dendritic cells" "FCGR3A+ Monocytes"
Megakaryocytes NK cells
"Megakaryocytes" "NK cells"
ctrl101 ctrl1015 ctrl1016 ctrl1039 ctrl107 ctrl1244 ctrl1256 ctrl1488 stim101 stim1015 stim1016 stim1039
"ctrl101" "ctrl1015" "ctrl1016" "ctrl1039" "ctrl107" "ctrl1244" "ctrl1256" "ctrl1488" "stim101" "stim1015" "stim1016" "stim1039"
stim107 stim1244 stim1256 stim1488
"stim107" "stim1244" "stim1256" "stim1488"
# nb. of cells per cluster-sample
t(table(sce$cluster_id, sce$sample_id))
B cells CD14+ Monocytes CD4 T cells CD8 T cells Dendritic cells FCGR3A+ Monocytes Megakaryocytes NK cells
ctrl101 113 186 336 95 5 81 12 84
ctrl1015 476 783 919 226 11 232 25 208
ctrl1016 144 419 526 671 10 126 15 151
ctrl1039 30 116 202 30 5 28 5 20
ctrl107 51 222 197 31 2 29 5 49
ctrl1244 134 429 1215 82 28 53 19 131
ctrl1256 240 383 1136 156 12 50 15 275
ctrl1488 234 317 1343 78 17 99 21 120
stim101 144 222 437 121 20 126 7 120
stim1015 357 683 814 153 17 222 24 224
stim1016 129 361 426 600 10 124 12 239
stim1039 39 154 318 40 7 36 13 32
stim107 56 185 217 22 7 36 4 51
stim1244 94 318 980 46 19 35 14 136
stim1256 211 369 1047 133 16 73 21 257
stim1488 283 370 1658 73 34 139 35 187
可以发现直接提供的数据已经包含t-SNE降维坐标信息
# compute UMAP using 1st 20 PCs
sce <- runUMAP(sce, pca = 20)
使用 scat 的 plotReducedDim 函数,我们可以分别绘制由clusters和groups ID 着色的 t-SNE 和 UMAP 表示。我们还创建了一个小的包装函数 .plot_dr()以提高颜色图例的可读性并简化绘图主题:
# wrapper to prettify reduced dimension plots
.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)
对于我们的数据集,由cluster_ids着色的t-SNE和UMAP表明细胞群彼此分离良好。IFN-β刺激表现为当着色group_ids时细胞低维投影的剧烈变化,表明广泛的基因组规模发生转录变化。
# 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)
为了测试不同条件下的状态变化,我们将考虑两种类型的方法:
为了利用现有的强大的bulk RNA-seq DE框架,如edgeR,DESeq2和limma,我们首先汇总每个样本(在每个分组中)的测量值以获得伪批量数据。
通常,aggregateData() 将通过参数 by 指定的 colData 变量聚合数据,并返回包含伪批量数据的 SingleCellExperiment。
对于 DS 分析,必须在聚类样本级别聚合测量值(默认值by = c("cluster_id", "sample_id")。
在这种情况下,返回的 SingleCellExperiment 将包含每个簇的一个测定,其中行 = 基因,列 = 样本。
可以发现和bulk RNAseq的输入表达矩阵一致
参数assay和fun分别指定用于聚合的输入数据和汇总统计量。
虽然原则上可以应用输入数据(原始/(对数)标准化计数,CPM等)和汇总统计数据(总和,平均值,中位数)的各种组合,但我们在这里默认为原始计数的总和:
pb <- aggregateData(sce,
assay = "counts", fun = "sum",
by = c("cluster_id", "sample_id"))
# one sheet per subpopulation
assayNames(pb) # cluster
[1] "B cells" "CD14+ Monocytes" "CD4 T cells"
[4] "CD8 T cells" "Dendritic cells" "FCGR3A+ Monocytes"
[7] "Megakaryocytes" "NK cells"
# pseudobulks for 1st subpopulation
t(head(assay(pb))) # sample
NOC2L HES4 ISG15 TNFRSF18 TNFRSF4 SDF4
ctrl101 12 0 13 8 1 13
ctrl1015 37 4 136 55 16 42
ctrl1016 13 3 42 10 0 15
ctrl1039 2 1 16 3 1 1
ctrl107 7 0 6 3 4 5
ctrl1244 24 7 25 30 11 7
ctrl1256 22 1 65 30 11 17
ctrl1488 19 1 34 27 6 23
stim101 12 8 1362 3 1 9
stim1015 34 27 4022 21 2 19
stim1016 7 8 1271 2 4 6
stim1039 3 3 393 1 1 2
stim107 4 2 556 1 0 3
stim1244 13 10 830 8 2 5
stim1256 14 10 2235 10 2 6
stim1488 18 5 2927 13 1 19
multi-dimensional scaling (MDS) plot
在进行任何正式测试之前,我们可以计算聚合信号的多维缩放(MDS)图,以探索整体样本的相似性。
pbMDS 将 aggregateData 返回的任何包含 PB 数据的 SCE 作为输入,并使用 edgeR 计算 MDS 维度。理想情况下,数据的这种表示形式应将聚类和组彼此分开。反之亦然,来自同一聚类或组的样本应聚类在一起。
在我们的关于伪散装计数的 MDS 图中可以观察到,第一维(MDS1)清楚地分离了细胞群(簇),而第二维(MDS2)分离了对照和受刺激的样本(组)。此外,两个T细胞簇彼此靠近。
(pb_mds <- pbMDS(pb))
一旦我们组装了伪批量数据,我们就可以使用 pbDS
测试 DS。默认情况下,a∼group_id模型拟合,并且测试线性模型的最后一个系数等于零。
# run DS analysis
res <- pbDS(pb, verbose = FALSE)
res$table %>% str()
res$table %>% View()
# access results table for 1st comparison
tbl <- res$table[[1]]
# one data.frame per cluster
names(tbl)
[1] "B cells" "CD14+ Monocytes" "CD4 T cells" "CD8 T cells" "Dendritic cells" "FCGR3A+ Monocytes"
[7] "Megakaryocytes" "NK cells"
# view results for 1st cluster
k1 <- tbl[[1]] # B cells
head(format(k1[, -ncol(k1)], digits = 2))
B_deg_pseudobulk <- format(k1[, -ncol(k1)], digits = 2)
选取Bcells进行展示
pb$group_id
[1] ctrl ctrl ctrl ctrl ctrl ctrl ctrl ctrl stim stim stim stim stim stim stim stim
Levels: ctrl stim
作为上述样本水平方法的替代方案,我们将(针对每个基因)混合模型(MM)拟合到细胞水平的测量数据中。muscat提供了使用 3 种主要方法的 MM 实现:
在每种情况下,a∼1+group_id+(1|sample_id)模型适合每个基因,优化对数似然(即REML = FALSE,P 值使用参数 df(默认"Satterthwaite") 指定的自由度估计值计算。拟合、测试和适度按亚群维度被应用。对于差异分析,mmDS将仅考虑:
n_samples
个样本中至少有 n_cells
个细胞(默认为 10 个)的亚群min_count
(默认值 1)的基因至少在 min_cells
(默认值 20)中耗时占用资源过多,未跑完结果
参考:
sce_seurat <- as.Seurat(sce)
sce_seurat
View(sce_seurat)
An object of class Seurat
7118 features across 26820 samples within 1 assay
Active assay: originalexp (7118 features, 0 variable features)
2 dimensional reductions calculated: TSNE, UMAP
Bcells <- subset(sce_seurat, cluster_id=="B cells")
Bcells
An object of class Seurat
7118 features across 2735 samples within 1 assay
Active assay: originalexp (7118 features, 0 variable features)
2 dimensional reductions calculated: TSNE, UMAP
# Idents(sce_seurat) %>% head()
# sce_seurat@meta.data %>% colnames()
# sce_seurat <- SetIdent(sce_seurat,value = "cluster_id")
# Idents(sce_seurat) %>% head()
B_markers_found <- FindMarkers(Bcells,
min.pct = 0,logfc.threshold = 0,
slot = "counts",
group.by = "group_id",ident.1 = "ctrl",ident.2 = "stim")
B_deg_pseudobulk$abs_logfc <- B_deg_pseudobulk$logFC %>% as.numeric() %>% abs()
B_markers_found$abs_logfc <- B_markers_found$avg_log2FC %>% as.numeric() %>% abs()
B_deg_pseudobulk$reg <- ifelse(B_deg_pseudobulk$abs_logfc>1&as.numeric(B_deg_pseudobulk$p_val)<0.05,"deg","normal")
table(B_deg_pseudobulk$reg)
B_markers_found$reg <- ifelse(B_markers_found$abs_logfc>1&as.numeric(B_markers_found$p_val)<0.05,"deg","normal")
table(B_markers_found$reg)
deg normal
238 1729
deg normal
17 7101
Pseudobulk鉴定了更多的DEGs
看看FindMakers的结果在不在Pseudobulk的结果中:
table(rownames(B_markers_found)[B_markers_found$reg=="deg"] %in% B_deg_pseudobulk$gene[B_deg_pseudobulk$reg=="deg"])
FALSE TRUE
1 16
Using MAST with RNASeq: MAIT Analysis. (http://bioconductor.org/packages/release/bioc/vignettes/MAST/inst/doc/MAITAnalysis.html)
1、示例数据
经细胞因子刺激前后的MAITs细胞的单细胞表达数据,使用MAST包分析其差异表达基因。
data(maits, package='MAST')
dim(maits$expressionmat) #共96个细胞
# [1] 96 16302
maits$expressionmat[1:4,1:4]
head(maits$cdat) #细胞注释数据
head(maits$fdat) #基因注释数据
##整理表达矩阵,使用symbol作为基因名
idx = -which(duplicated(maits$fdat$symbolid))
maits$fdat = maits$fdat[idx,]
maits$fdat = maits$fdat[,-1]
rownames(maits$fdat) = maits$fdat$symbolid
maits$expressionmat = maits$expressionmat[,idx]
colnames(maits$expressionmat) = rownames(maits$fdat)
maits$expressionmat[1:4,1:4]
head(maits$fdat)
2、构建SingleCellAssay对象
library(MAST)
sca = FromMatrix(t(maits$expressionmat), maits$cdat, maits$fdat)
## 方便演示,随机筛选出2000个基因
sca = sca[unique(sample(rownames(sca),2000)),]
dim(sca)
# [1] 2000 96
sca
## (1) 目标分组
colData(sca)
table(colData(sca)$condition)
# Stim Unstim
# 47 49
## 将Unstim设置为参考组
cond<-factor(colData(sca)$condition)
cond<-relevel(cond,"Unstim")
cond # Levels: Unstim Stim
colData(sca)$condition<-cond
## (2) 考虑一个协变量因素
summary(colData(sca)$cngeneson)
# Min. 1st Qu. Median Mean 3rd Qu. Max.
# -0.17159 -0.02578 0.01408 0.00000 0.05943 0.15415
## (3) 模拟一个分类变量分组因素
set.seed(123)
colData(sca)$region = sample(letters[1:3], ncol(sca), replace=T)
table(colData(sca)$region)
# a b c
#32 31 33
3、回归分析
MAST做差异分析的主要优势在于可以校正多种协变量因素,如下演示几种常用的用法。
## (1) 校正cngeneson协变量:默认参数
zlmCond <- zlm(~condition + cngeneson, sca,
method="bayesglm", ebayes=TRUE)
summaryCond <- summary(zlmCond, doLRT='conditionStim')
summaryDt <- summaryCond$datatable
levels(summaryDt$contrast)
# [1] "conditionStim" "(Intercept)" "cngeneson"
## (2) 校正cngeneson与region协变量:默认参数
zlmCond <- zlm(~condition + cngeneson + region, sca,
method = "bayesglm", ebayes=TRUE)
summaryCond <- summary(zlmCond, doLRT='conditionStim')
summaryDt <- summaryCond$datatable
levels(summaryDt$contrast)
# [1] "conditionStim" "(Intercept)" "cngeneson" "regionb" "regionc"
## (3) 校正cngeneson协变量,将region认为是随机因素
zlmCond <- zlm(~condition + cngeneson + (1|region), sca,
method = "glmer", ebayes=FALSE)
summaryCond <- summary(zlmCond, doLRT='conditionStim')
summaryDt <- summaryCond$datatable
levels(summaryDt$contrast)
# [1] "conditionStim" "(Intercept)" "cngeneson"
汇总差异基因结果
df_pval = summaryDt %>%
filter(contrast=='conditionStim') %>%
filter(component=='H') %>%
select(primerid, `Pr(>Chisq)`)
df_logfc = summaryDt %>%
filter(contrast=='conditionStim') %>%
filter(component=='logFC') %>%
select(primerid, coef, ci.hi, ci.lo)
df_stat = inner_join(df_logfc, df_pval) %>%
rename("primerid"="symbol") %>%
rename("Pr(>Chisq)"="pval","coef"="logFC") %>%
mutate("fdr" = p.adjust(pval)) %>%
arrange(fdr)
dim(df_stat)
dim(na.omit(df_stat))
df_stat <- na.omit(df_stat) %>% arrange(fdr) %>% mutate("abs_logfc"=abs(logFC))
head(df_stat)
symbol logFC ci.hi ci.lo pval fdr abs_logfc
1: U1 -3.980627 -3.248247 -4.713007 1.857517e-16 3.694601e-13 3.980627
2: PSAT1 7.090388 8.553495 5.627281 8.466767e-16 1.683193e-12 7.090388
3: DUSP1 -6.513010 -5.260700 -7.765321 8.668938e-15 1.722518e-11 6.513010
4: L26953 4.839456 6.001081 3.677831 1.201518e-11 2.386214e-08 4.839456
5: PSMA5 4.989426 6.218109 3.760743 3.346791e-11 6.643381e-08 4.989426
6: JUN -4.171474 -3.213458 -5.129490 4.173966e-11 8.281148e-08 4.171474
maits$expressionmat[1:4,1:4]
counts <- maits$expressionmat %>% t()
counts[1:4,1:4]
mysce <- CreateSeuratObject(counts = counts[rownames(counts) %in% rownames(sca),])
dim(mysce)
colData(sca)$condition %>% table()
mysce$group_id <- colData(sca)$condition
mysce$group_id %>% table()
[1] 2000 96
.
Unstim Stim
49 47
.
Unstim Stim
49 47
markers_found <- FindMarkers(mysce,min.pct = 0,logfc.threshold = 0,
slot = "counts",group.by = "group_id",
ident.1 = "Unstim", ident.2 = "Stim")
|++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=03s
markers_found <- markers_found %>% arrange(p_val) %>% mutate("abs_logfc"=abs(avg_log2FC))
head(markers_found)
p_val avg_log2FC pct.1 pct.2 p_val_adj abs_logfc
DUSP1 2.478956e-14 2.2429608 0.980 0.766 4.957912e-11 2.2429608
JUND 4.125845e-14 1.1074815 0.959 0.936 8.251689e-11 1.1074815
PSMA5 1.810076e-11 -1.5517307 0.714 1.000 3.620153e-08 1.5517307
RPL34 3.458046e-11 0.2375686 1.000 1.000 6.916093e-08 0.2375686
SMS 6.266779e-11 -1.7052944 0.143 0.787 1.253356e-07 1.7052944
SRP19 1.410429e-10 -1.5377399 0.510 0.957 2.820858e-07 1.5377399
注意我们只随机取了两千个基因(MAST,MM模型,耗时)
df_stat$reg <- ifelse(df_stat$abs_logfc>1&as.numeric(df_stat$pval)<0.05,"deg","normal")
table(df_stat$reg)
markers_found$reg <- ifelse(markers_found$abs_logfc>1&as.numeric(markers_found$p_val)<0.05,"deg","normal")
table(markers_found$reg)
deg normal
381 1378
deg normal
149 1851
可以发现MAST鉴定了更多的差异表达基因
table(rownames(markers_found)[markers_found$reg=="deg"] %in% df_stat$symbol[df_stat$reg=="deg"])
FALSE TRUE
23 126
FindMarkers的大部分结果还是在MAST中的
参考:
distinct: a method for differential analyses via hierarchical permutation tests(https://github.com/SimoneTiberi/distinct) github
https://bioconductor.org/packages/release/bioc/vignettes/distinct/inst/doc/distinct.html
distinct是一种在两组或多组分布之间执行差异分析的统计方法;差异分析是通过对每个样本的累积分布函数(cdfs)进行非参数排列检验来进行的。distinct是一种通用且灵活的工具:由于其完全非参数性质,对数据的生成方式没有任何假设,因此它可以应用于各种数据集。特别适合对单细胞数据进行差异状态分析(即,细胞亚群内的差异分析),例如单细胞RNA测序(scRNA-seq)和高维流式或质谱仪(HDCyto)数据。该方法还考虑了干扰协变量(如批处理效应)。
rm(list=ls())
# BiocManager::install("distinct")
library(Seurat)
library(distinct)
1.加载示例数据
由 6 个样本的子集(在 2 个条件下观察到的 3 个个体)和从 muscData 包的 Kang18_8vs8() 对象中选择的 100 个基因组成
library(SingleCellExperiment)
data("Kang_subset", package = "distinct")
Kang_subset
class: SingleCellExperiment
dim: 100 9517
metadata(1): experiment_info
assays(2): logcounts cpm
rownames(100): ISG15 SYF2 ... MX2 PDXK
rowData names(0):
colnames: NULL
colData names(3): stim cell sample_id
reducedDimNames(0):
mainExpName: NULL
altExpNames(0):
colData的ind列和stim表示每个细胞的个体ID和实验条件(对照或处理),而sample_id列显示差异分析所需的样品ID。对每个cell聚类分别执行条件之间的差异测试。请注意,如果细胞聚类标签未知,我们需要通过某种聚类算法将细胞聚类到组中。
colData(Kang_subset)
DataFrame with 9517 rows and 3 columns
stim cell sample_id
<factor> <factor> <factor>
1 ctrl CD4 T cells ctrl_107
2 ctrl CD14+ Monocytes ctrl_1015
3 ctrl NK cells ctrl_1015
4 ctrl CD4 T cells ctrl_107
5 ctrl CD14+ Monocytes ctrl_1015
... ... ... ...
9513 stim CD14+ Monocytes stim_1015
9514 stim CD4 T cells stim_101
9515 stim CD14+ Monocytes stim_101
9516 stim CD14+ Monocytes stim_107
9517 stim CD4 T cells stim_107
实验设计比较两组(stim与ctrl),每组有3个生物学重复
Kang_subset@metadata$experiment_info
sample_id stim
1 ctrl_107 ctrl
2 ctrl_1015 ctrl
3 ctrl_101 ctrl
4 stim_101 stim
5 stim_1015 stim
6 stim_107 stim
2.设计实验
samples = Kang_subset@metadata$experiment_info$sample_id
group = Kang_subset@metadata$experiment_info$stim
design = model.matrix(~group)
# rownames of the design must indicate sample ids:
rownames(design) = samples
design
(Intercept) groupstim
ctrl_107 1 0
ctrl_1015 1 0
ctrl_101 1 0
stim_101 1 1
stim_1015 1 1
stim_107 1 1
attr(,"assign")
[1] 0 1
attr(,"contrasts")
attr(,"contrasts")$group
[1] "contr.treatment"
在条件之间执行差异分析。参数 name_assays_expression 指定assays(x)) 中的输入数据(对数counts),而name_cluster和name_sample定义包含细胞聚类(细胞)和单个样本 ID (sample_id) 的 colData(x) 的列名。我们要测试的组位于设计的第二列中,因此我们将指定:column_to_test = 2。
请注意,colData(x)$name_sample 中的样本名称必须与 rownames(design) 中的样本名称相同(尽管顺序不一定相同)。
rownames(design)
unique(colData(Kang_subset)$sample_id)
[1] "ctrl_107" "ctrl_1015" "ctrl_101" "stim_101" "stim_1015" "stim_107"
[1] ctrl_107 ctrl_1015 ctrl_101 stim_101 stim_1015 stim_107
Levels: ctrl_101 ctrl_1015 ctrl_107 stim_101 stim_1015 stim_107
3.差异分析
为了获得最重要基因的更精细排名,如果计算资源允许,我们鼓励用户增加P_4(即,原始p值<0.001时的排列数量)并设置P_4 = 20,000(默认情况下P_4 = 10,000).
强烈建议使用标准化数据,例如每百万次counts (CPM) 或 log2-CPM(例如,通过 scater::logNormCounts 创建的logcounts)).
前面的方法用的都是raw counts
set.seed(61217)
res = distinct_test(x = Kang_subset,
name_assays_expression = "logcounts",
name_cluster = "cell",
name_sample = "sample_id",
design = design,
column_to_test = 2,
min_non_zero_cells = 20,
n_cores = 2)
2 groups of samples provided
Data loaded, starting differential testing
Differential testing completed, returning results
head(res)
table(res$cluster_id)
gene cluster_id p_val p_adj.loc p_adj.glb filtered mean_ctrl mean_stim FC_ctrl/stim log2FC_ctrl/stim
1 ISG15 B cells 0.00009999 0.00139986 0.0007650398 FALSE 198.05692 8577.04339 0.02309151 -5.4364934
2 SYF2 B cells 0.41584158 0.60824590 0.6162697351 FALSE 333.73137 285.50405 1.16891993 0.2251761
3 LAPTM5 B cells 0.01349325 0.10171837 0.0551463399 FALSE 1495.39376 1185.58215 1.26131602 0.3349298
4 EIF3I B cells 0.91089109 0.94965241 0.9528876576 FALSE 259.08484 233.50382 1.10955291 0.1499785
5 PRPF38A B cells 0.04590818 0.17303854 0.1379341773 FALSE 61.89912 78.05793 0.79298948 -0.3346264
6 GTF2B B cells 0.38613861 0.59127475 0.5881463146 FALSE 98.64613 109.72591 0.89902308 -0.1535699
B cells CD14+ Monocytes CD4 T cells CD8 T cells Dendritic cells FCGR3A+ Monocytes
100 100 100 100 100 100
Megakaryocytes NK cells
100 100
结果以data.frame的形式报告,其中gene和cluster_id列包含基因和细胞簇名称,而p_val,p_adj.loc通过p_adj.glbBenjamini和Hochberg(BH)校正报告原始p值,局部和全局调整的p值。在局部调整的 p 值 (p_adj.loc) 中,BH 校正分别应用于每个聚类,而在全局调整的 p 值 (p_adj.glb) 中,对所有聚类的结果执行 BH 校正。
我们可以进一步计算组之间的倍数变化(FC)和log2-FC。要计算FCs,请使用标准化数据,例如cpm;不要使用对数转换数据(例如,logcounts)。
res = log2_FC(res = res,
x = Kang_subset,
name_assays_expression = "cpm",
name_group = "stim",
name_cluster = "cell")
FC and log2_FC computed, returning results
取出Bcells的deg结果:
bcells_distinct <- res[res$cluster_id=="B cells",]
head(bcells_distinct)
gene cluster_id p_val p_adj.loc p_adj.glb filtered mean_ctrl mean_stim FC_ctrl/stim log2FC_ctrl/stim abs_logfc reg
1 ISG15 B cells 0.00009999 0.00139986 0.0007650398 FALSE 198.05692 8577.04339 0.02309151 -5.4364934 5.4364934 deg
2 SYF2 B cells 0.41584158 0.60824590 0.6162697351 FALSE 333.73137 285.50405 1.16891993 0.2251761 0.2251761 normal
3 LAPTM5 B cells 0.01349325 0.10171837 0.0551463399 FALSE 1495.39376 1185.58215 1.26131602 0.3349298 0.3349298 normal
4 EIF3I B cells 0.91089109 0.94965241 0.9528876576 FALSE 259.08484 233.50382 1.10955291 0.1499785 0.1499785 normal
5 PRPF38A B cells 0.04590818 0.17303854 0.1379341773 FALSE 61.89912 78.05793 0.79298948 -0.3346264 0.3346264 normal
6 GTF2B B cells 0.38613861 0.59127475 0.5881463146 FALSE 98.64613 109.72591 0.89902308 -0.1535699 0.1535699 normal
此外,distinct还可以 处理协变量和批处理效应
distinct用的logcounts这里我们也用logcounts
Kang_subset
Kang_subset@assays@data$logcounts %>% colnames() %>% head()
counts <- Kang_subset@assays@data$logcounts %>% SparseM::as.matrix()
counts[1:4,1:4]
dim(counts)
table(Kang_subset$stim)
colnames(counts) <- Kang_subset$sample_id
kang_seurat <- CreateSeuratObject(counts = counts)
感觉SingleCellExperiment对象 colData
函数取出来的像是Seurat对象的metadata
colData(Kang_subset)
kang_seurat$group_id <- Kang_subset$stim
kang_seurat$celltype <- Kang_subset$cell
取出Bcells
kang_seurat_bcells <- subset(kang_seurat,celltype=="B cells")
table(kang_seurat_bcells$celltype)
B cells CD14+ Monocytes CD4 T cells CD8 T cells Dendritic cells FCGR3A+ Monocytes
1246 0 0 0 0 0
Megakaryocytes NK cells
0 0
kangB_markers_found <- FindMarkers(kang_seurat_bcells,min.pct = 0,logfc.threshold = 0,
slot = "counts",group.by = "group_id",
ident.1 = "ctrl", ident.2 = "stim")
head(kangB_markers_found)
p_val avg_log2FC pct.1 pct.2 p_val_adj abs_logfc reg
ISG15 1.768192e-216 -1.9237559 0.168 0.991 1.768192e-214 1.9237559 deg
MX2 2.722777e-62 -0.6442930 0.038 0.431 2.722777e-60 0.6442930 normal
PSME2 3.444846e-42 -0.5201504 0.497 0.812 3.444846e-40 0.5201504 normal
RPL7 7.601723e-31 0.1705121 0.994 0.969 7.601723e-29 0.1705121 normal
SPI1 2.603640e-16 0.2425778 0.165 0.026 2.603640e-14 0.2425778 normal
PRDX5 1.645329e-14 0.3127005 0.333 0.153 1.645329e-12 0.3127005 normal
bcells_distinct$abs_logfc <- abs(bcells_distinct$`log2FC_ctrl/stim`)
kangB_markers_found$abs_logfc <- abs(kangB_markers_found$avg_log2FC)
bcells_distinct$reg <- ifelse(bcells_distinct$abs_logfc>1&as.numeric(bcells_distinct$p_val)<0.05,"deg","normal")
table(bcells_distinct$reg)
kangB_markers_found$reg <- ifelse(kangB_markers_found$abs_logfc>1&as.numeric(kangB_markers_found$p_val)<0.05,"deg","normal")
table(kangB_markers_found$reg)
deg normal
16 84
deg normal
1 99
看一下是不是全部基因数量size的影响
kang_markers_found <- FindMarkers(kang_seurat,min.pct = 0,logfc.threshold = 0,
slot = "counts",group.by = "group_id",
ident.1 = "ctrl", ident.2 = "stim")
kang_markers_found$abs_logfc <- abs(kang_markers_found$avg_log2FC)
kang_markers_found$reg <- ifelse(kang_markers_found$abs_logfc>1&as.numeric(kang_markers_found$p_val)<0.05,"deg","normal")
table(kang_markers_found$reg)
deg normal
1 99
> kang_markers_found[kang_markers_found$reg=="deg",]
p_val avg_log2FC pct.1 pct.2 p_val_adj abs_logfc reg
ISG15 0 -2.008996 0.258 0.989 0 2.008996 deg
> kangB_markers_found[kangB_markers_found$reg=="deg",]
p_val avg_log2FC pct.1 pct.2 p_val_adj abs_logfc reg
ISG15 1.768192e-216 -1.923756 0.168 0.991 1.768192e-214 1.923756 deg
可以发现参与差异分析的基因数量size对结果有影响但不大
"ISG15" %in% bcells_distinct$gene
# TRUE
distinct找到了更多的差异表达基因,结果的格式类似前面的muscat
就在我写这篇推送的时候发现最近我们自己和一些其他的公众号也写了推文介绍一系列做单细胞样本间差异表达分析的方法,可惜我检索整理资料基本上是在8月中旬完成的,没有覆盖到这部分
这里贴出,作为参考:
muscat代码实操(一):模拟复杂的 scRNA-seq 数据以及评估不同的差异表达分析方法的性能
开发这个包的灵感来源于之前Seurat和Muscat包(muscat:专注于多样本多分组的单细胞差异分析),但是这两个包都是从不同的单一角度着手,虽各有所长,但适用场景有限。而Libra着手于解决一站式解决scRNA-seq差异分析,其总共集成了22种不同的差异分析算法,这些方法都可以从一个函数中访问,其中包括传统的单细胞方法以及包括pseudobulk和mixed model方法在内的所有主流算法。
区别于上一部分,我们这里第二部分是“计算来自两个簇的细胞之间的差异表达基因以用于标记基因鉴定或细胞类型注释”,所以可以用官方提供的pbmc单样本数据集
rm(list=ls())
# devtools::install_github('satijalab/seurat-data')
library(SeuratData) #加载seurat数据集
getOption('timeout')
options(timeout=10000)
InstallData("pbmc3k")
data("pbmc3k")
sce <- pbmc3k.final
library(Seurat)
DimPlot(sce,label = T,repel = T)
这里直接获取降维等处理好的数据
> sce
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
需要理解具体走了哪些处理可以参考 初探单细胞下游 ,同样也是官方的pbmc示例数据
参考:
这里开了4个线程,主要是针对 FindAllMarkers
函数
library(future)
# check the current active plan
plan()
plan("multisession", workers = 4)
plan()
start = Sys.time()
sce.markers <- FindAllMarkers(object = sce, only.pos = TRUE,
min.pct = 0.25,
thresh.use = 0.25)
end = Sys.time()
dur = end-start
dur
这里开了4个线程,主要是针对 FindAllMarkers
函数
每个单细胞亚群都有几百个左右的基因被挑选出来,9个单细胞亚群就是2885个基因,当然了,每个基因的特异性并不一样
参考:
速度上吊打FindAllMarkers的单细胞亚群特异性高表达基因查询算法
【单细胞】上下游,合体!
#remotes::install_github(repo = 'genecell/COSGR')
start = Sys.time()
library(COSG)
marker_cosg <- cosg(
sce,
groups='all',
assay='RNA',
slot='data',
mu=1,
n_genes_user=100)
end = Sys.time()
dur = end-start
dur
参数说明如下:
sce
是一个SingleCellExperiment对象,其中包含了RNA-seq数据。groups='all'
用于定义要分析的细胞组。在这里,我们使用了数据集中的所有细胞组。assay='RNA'
指定要分析的assay类型为RNA。slot='data'
表示从SingleCellExperiment对象的"data" slot中获取标准化后的数据。mu=1
是cosg函数中的一个参数,用于调整标记基因识别的准确性和灵敏度。默认值为1。n_genes_user=100
是cosg函数中的一个参数,指定在计算标记基因时要考虑的top基因数量。每个单细胞亚群默认就找到了 n_genes_user
参数指定数量单细胞亚群特异性高表达基因:
可以看到, 这个结果跟前面的Seurat包的FindAllMarkers函数结果的形式就不一样的,前面的是长数据,现在这个 cosg 函数的结果是宽数据,有点类似于前面我们提到的:基于非负矩阵分解的单细胞降维聚类分群,找各个亚群的特征基因
findG = split(sce.markers$gene,sce.markers$cluster)
str(findG)
names(findG)
tmp = do.call(rbind ,
lapply(names(findG), function(x){
table(marker_cosg$names[,x] %in% findG[[x]])
}))
rownames(tmp) = names(findG)
tmp
FALSE TRUE
Naive CD4 T 14 86
Memory CD4 T 27 73
CD14+ Mono 15 85
B 51 49
CD8 T 46 54
FCGR3A+ Mono 25 75
NK 34 66
DC 54 46
Platelet 37 63
虽然没曾老师推文中那么多,我们的结果中也是,DC和CD8 T 的表现比较差
试试看仅仅是看top10的基因,它们交集如何:
FALSE TRUE
Naive CD4 T 10 0
Memory CD4 T 5 5
CD14+ Mono 3 7
B 2 8
CD8 T 2 8
FCGR3A+ Mono 3 7
NK 1 9
DC 4 6
Platelet 5 5
这时DC也较差,Platelet的表现也不行,最主要是Naive CD4 T top10竟然一个都没有overlap
和曾老师的推文也有部分出入
翻到评论区:
查看 FindAllmarkers
和 cosg
函数的参数:
我一开始以为
FindAllmarkers
函数min.pct
参数表达该基因的细胞百分比,这个细胞是所有的细胞,经曾老师提醒,这里的细胞是当前差异对照分组细胞类型对应的细胞
添加COSG过滤参数:
#remotes::install_github(repo = 'genecell/COSGR')
start = Sys.time()
library(COSG)
marker_cosg_fit <- cosg(
sce,
groups='all',
assay='RNA',
slot='data',
mu=1,
remove_lowly_expressed = TRUE,
expressed_pct = 0.25,
n_genes_user=100)
end = Sys.time()
dur = end-start
dur
看看 cosg 函数的结果是否都在前面的 Seurat包的FindAllMarkers函数结果里面:
findG = split(sce.markers$gene,sce.markers$cluster)
str(findG)
names(findG)
tmp = do.call(rbind ,
lapply(names(findG), function(x){
table(marker_cosg_fit$names[,x] %in% findG[[x]])
}))
rownames(tmp) = names(findG)
tmp[,2]
Naive CD4 T Memory CD4 T CD14+ Mono B CD8 T FCGR3A+ Mono NK DC
100 100 100 100 99 100 100 100
Platelet
100
可以发现将过滤阈值调整为一致后,基本上所有的cosg 函数的结果是否都在前面的 Seurat包的FindAllMarkers函数结果中
上一部分是自己鉴定不同clusters之间的DEGs检查markers
这里我们也提供一些可以检索的数据资源
CELL×GENE | Datasets 可能是目前的最大的统一的单细胞数据资源中心,横跨多种单细胞技术,全部的细胞都注释清楚了亚群,以层次结构组织展示
下面第四部分,我将介绍如何使用一些打分算法结合markers辅助确定细胞亚型,这些方法大部分都用R封装好了,并且有自己使用的细胞亚型的markers
初步定义细胞亚群往往用的是通用规则,我们过去的推文也有很多介绍,如听说你还缺单细胞亚群标记基因
由于篇幅问题,第四部分“一些辅助划分细胞亚型的工具”将挪到本期推送的次版里
https://mp.weixin.qq.com/s/26xnx5NPsjqSCIVu372vTQ