4.3 实战三 | 10X | 未过滤的PBMC
刘小泽写于2020.7.19

1 前言

相信学习单细胞数据分析的大家对PBMC都不陌生,虽然不是相关背景,但Seurat的PBMC数据深入人心。PBMC全称是peripheral blood mononuclear cell ,外周血单核细胞。
我们这里用的数据集来自Zheng et al. 2017,并在10X Genomics官网也可以获取,数量比Seurat使用的的2700个细胞数据更大

2 数据准备

下载

当然也可以跳过这一步,自己下载好之后读入。这里只是学习一下另一种方法
1
library(BiocFileCache)
2
bfc <- BiocFileCache("raw_data", ask = FALSE)
3
raw.path <- bfcrpath(bfc, file.path("http://cf.10xgenomics.com/samples",
4
"cell-exp/2.1.0/pbmc4k/pbmc4k_raw_gene_bc_matrices.tar.gz"))
5
untar(raw.path, exdir=file.path(tempdir(), "pbmc4k"))
6
# 最后也就是得到这三个文件:barcodes.tsv genes.tsv matrix.mtx
Copied!

读取

1
library(DropletUtils)
2
fname <- file.path(tempdir(), "pbmc4k/raw_gene_bc_matrices/GRCh38")
3
sce.pbmc <- read10xCounts(fname, col.names=TRUE)
4
# 看这里的数量惊人,但是后面还需要过滤
5
sce.pbmc
6
# class: SingleCellExperiment
7
# dim: 33694 737280
8
# metadata(1): Samples
9
# assays(1): counts
10
# rownames(33694): ENSG00000243485
11
# ENSG00000237613 ... ENSG00000277475
12
# ENSG00000268674
13
# rowData names(2): ID Symbol
14
# colnames(737280): AAACCTGAGAAACCAT-1
15
# AAACCTGAGAAACCGC-1 ... TTTGTCATCTTTAGTC-1
16
# TTTGTCATCTTTCCTC-1
17
# colData names(2): Sample Barcode
18
# reducedDimNames(0):
19
# altExpNames(0):
Copied!

转换ID,添加染色体信息

1
library(scater)
2
rownames(sce.pbmc) <- uniquifyFeatureNames(
3
rowData(sce.pbmc)$ID, rowData(sce.pbmc)$Symbol)
4
5
library(EnsDb.Hsapiens.v86)
6
location <- mapIds(EnsDb.Hsapiens.v86, keys=rowData(sce.pbmc)$ID,
7
column="SEQNAME", keytype="GENEID")
Copied!

3 质控

10X数据面临的一大问题就是空液滴,因此需要emptyDrops检验一下
1
set.seed(100)
2
# 对70多万个液滴进行检验
3
e.out <- emptyDrops(counts(sce.pbmc))
4
# > e.out
5
# DataFrame with 737280 rows and 5 columns
6
# Total LogProb PValue Limited FDR
7
# <integer> <numeric> <numeric> <logical> <numeric>
8
# AAACCTGAGAAACCAT-1 1 NA NA NA NA
9
# AAACCTGAGAAACCGC-1 0 NA NA NA NA
10
# AAACCTGAGAAACCTA-1 1 NA NA NA NA
11
# AAACCTGAGAAACGAG-1 0 NA NA NA NA
12
# AAACCTGAGAAACGCC-1 1 NA NA NA NA
13
# ... ... ... ... ... ...
14
# TTTGTCATCTTTACAC-1 2 NA NA NA NA
15
# TTTGTCATCTTTACGT-1 33 NA NA NA NA
16
# TTTGTCATCTTTAGGG-1 0 NA NA NA NA
17
# TTTGTCATCTTTAGTC-1 0 NA NA NA NA
18
# TTTGTCATCTTTCCTC-1 1 NA NA NA NA
19
20
# 最后过滤,剩下4000多
21
sce.pbmc <- sce.pbmc[,which(e.out$FDR <= 0.001)]
22
sce.pbmc
23
# class: SingleCellExperiment
24
# dim: 33694 4233
25
# metadata(1): Samples
26
# assays(1): counts
27
# rownames(33694): RP11-34P13.3 FAM138A ...
28
# AC213203.1 FAM231B
29
# rowData names(2): ID Symbol
30
# colnames(4233): AAACCTGAGAAGGCCT-1
31
# AAACCTGAGACAGACC-1 ... TTTGTCACAGGTCCAC-1
32
# TTTGTCATCCCAAGAT-1
33
# colData names(2): Sample Barcode
34
# reducedDimNames(0):
35
# altExpNames(0):
Copied!

数据备份

把unfiltered数据主要用在质控的探索上
1
unfiltered <- sce.pbmc
Copied!
这里过滤的条件不需要太严苛,只需要去除线粒体含量太高的细胞即可
成熟的mRNA会通过核孔来到细胞质。如果细胞遭到破坏,大量细胞质中mRNA流失,而线粒体体积比较大,流不出去,含量基本不变,最后导致细胞质中捕获的线粒体RNA占比升高
1
stats <- perCellQCMetrics(sce.pbmc, subsets=list(Mito=which(location=="MT")))
2
high.mito <- isOutlier(stats$subsets_Mito_percent, type="higher")
3
sce.pbmc <- sce.pbmc[,!high.mito]
4
5
summary(high.mito)
6
## Mode FALSE TRUE
7
## logical 3922 311
Copied!

根据原来的数据,加上质控标准作图

1
colData(unfiltered) <- cbind(colData(unfiltered), stats)
2
unfiltered$discard <- high.mito
3
4
gridExtra::grid.arrange(
5
plotColData(unfiltered, y="sum", colour_by="discard") +
6
scale_y_log10() + ggtitle("Total count"),
7
plotColData(unfiltered, y="detected", colour_by="discard") +
8
scale_y_log10() + ggtitle("Detected features"),
9
plotColData(unfiltered, y="subsets_Mito_percent",
10
colour_by="discard") + ggtitle("Mito percent"),
11
ncol=3
12
)
Copied!

再看下文库大小分别和线粒体含量的关系

1
plotColData(unfiltered, x="sum", y="subsets_Mito_percent",
2
colour_by="discard") + scale_x_log10()
Copied!

4 归一化

也是使用预分群+去卷积计算size factor的方法
1
library(scran)
2
set.seed(1000)
3
clusters <- quickCluster(sce.pbmc)
4
sce.pbmc <- computeSumFactors(sce.pbmc, cluster=clusters)
5
sce.pbmc <- logNormCounts(sce.pbmc)
6
7
summary(sizeFactors(sce.pbmc))
8
## Min. 1st Qu. Median Mean 3rd Qu. Max.
9
## 0.009 0.710 0.871 1.000 1.094 13.948
Copied!
看看两种归一化方法的差异
1
plot(librarySizeFactors(sce.pbmc), sizeFactors(sce.pbmc), pch=16,
2
xlab="Library size factors", ylab="Deconvolution factors", log="xy")
3
abline(a=0, b=1, col="red")
Copied!

5 找表达量高变化基因

既然有UMI,就可以用第三种方法【在之前 3.3 挑选高变化基因 的 2.3 考虑技术噪音中介绍过,如果没有spike-in】:可以考虑利用数据分布来表示技术噪音,例如只考虑技术噪音的话,UMI counts通常会呈现近似泊松分布
1
set.seed(1001)
2
dec.pbmc <- modelGeneVarByPoisson(sce.pbmc)
3
top.pbmc <- getTopHVGs(dec.pbmc, prop=0.1)
4
5
# 作图
6
plot(dec.pbmc$mean, dec.pbmc$total, pch=16, cex=0.5,
7
xlab="Mean of log-expression", ylab="Variance of log-expression")
8
curfit <- metadata(dec.pbmc)
9
# 可视化一条线(下图的蓝线),这条线指所有的基因都会存在的一种偏差
10
curve(curfit$trend(x), col='dodgerblue', add=TRUE, lwd=2)
Copied!

6 降维

1
set.seed(10000)
2
sce.pbmc <- denoisePCA(sce.pbmc, subset.row=top.pbmc, technical=dec.pbmc)
3
4
set.seed(100000)
5
sce.pbmc <- runTSNE(sce.pbmc, dimred="PCA")
6
7
set.seed(1000000)
8
sce.pbmc <- runUMAP(sce.pbmc, dimred="PCA")
Copied!
看看保留了几个PC
1
ncol(reducedDim(sce.pbmc, "PCA"))
2
## [1] 8
Copied!

7 聚类

1
g <- buildSNNGraph(sce.pbmc, k=10, use.dimred = 'PCA')
2
clust <- igraph::cluster_walktrap(g)$membership
3
colLabels(sce.pbmc) <- factor(clust)
4
5
table(colLabels(sce.pbmc))
6
##
7
## 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18
8
## 585 518 364 458 170 791 295 107 45 46 152 84 40 60 142 16 28 21
9
10
plotTSNE(sce.pbmc, colour_by="label")
Copied!

8 找marker基因并解释结果

1
markers <- findMarkers(sce.pbmc, pval.type="some", direction="up")
Copied!
这次看看cluster 7的marker基因
1
marker.set <- markers[["7"]]
2
as.data.frame(marker.set[1:30,1:3])
3
# p.value FDR summary.logFC
4
# FCN1 4.881588e-137 1.644802e-132 2.715872
5
# LGALS2 3.729029e-133 6.282295e-129 2.191398
6
# CSTA 1.426854e-131 1.602548e-127 2.123738
7
# CFD 1.207067e-102 1.016773e-98 1.503274
8
# FGL2 8.567117e-93 5.773209e-89 1.358891
9
# IFI30 7.822561e-80 4.392889e-76 1.276366
10
# CLEC7A 6.052032e-79 2.913102e-75 1.109366
11
# MS4A6A 1.958033e-78 8.246744e-75 1.419465
12
# CFP 8.802407e-73 3.295426e-69 1.312191
13
# S100A8 6.193215e-70 2.086742e-66 3.431603
Copied!
再和其他clusters对比
1
plotExpression(sce.pbmc, features=c("CD14", "CD68",
2
"MNDA", "FCGR3A"), x="label", colour_by="label")
Copied!
其实最后还是考验的背景知识:根据cluster7中CD14、CD68、MNDA表达量升高,同时又检查了CD16基因下调,推测cluster7是单核细胞
最近更新 1yr ago