4.10 实战十 | CEL-seq | 小鼠造血干细胞
刘小泽写于2020.7.21

1 前言

数据来自Grun et al. 2016的小鼠造血干细胞 haematopoietic stem cell (HSC) ,使用的技术是CEL-seq

数据准备

1
library(scRNAseq)
2
sce.grun.hsc <- GrunHSCData(ensembl=TRUE)
3
sce.grun.hsc
4
# class: SingleCellExperiment
5
# dim: 21817 1915
6
# metadata(0):
7
# assays(1): counts
8
# rownames(21817): ENSMUSG00000109644
9
# ENSMUSG00000007777 ... ENSMUSG00000055670
10
# ENSMUSG00000039068
11
# rowData names(3): symbol chr originalName
12
# colnames(1915): JC4_349_HSC_FE_S13_
13
# JC4_350_HSC_FE_S13_ ...
14
# JC48P6_1203_HSC_FE_S8_
15
# JC48P6_1204_HSC_FE_S8_
16
# colData names(2): sample protocol
17
# reducedDimNames(0):
18
# altExpNames(0):
19
20
table(sce.grun.hsc$sample)
21
#
22
# JC20 JC21 JC26 JC27 JC28 JC30 JC32
23
# 87 96 85 91 80 96 93
24
# JC35 JC36 JC37 JC39 JC4 JC40 JC41
25
# 96 80 87 93 84 96 94
26
# JC43 JC44 JC45 JC46 JC48P4 JC48P6 JC48P7
27
# 92 94 90 96 95 96 94
Copied!

ID转换

1
library(AnnotationHub)
2
ens.mm.v97 <- AnnotationHub()[["AH73905"]]
3
anno <- select(ens.mm.v97, keys=rownames(sce.grun.hsc),
4
keytype="GENEID", columns=c("SYMBOL", "SEQNAME"))
5
6
# 这里全部对应
7
> sum(is.na(anno$SYMBOL))
8
[1] 0
9
> sum(is.na(anno$SEQNAME))
10
[1] 0
11
12
# 接下来只需要匹配顺序即可
13
rowData(sce.grun.hsc) <- anno[match(rownames(sce.grun.hsc), anno$GENEID),]
14
15
sce.grun.hsc
16
## class: SingleCellExperiment
17
## dim: 21817 1915
18
## metadata(0):
19
## assays(1): counts
20
## rownames(21817): ENSMUSG00000109644 ENSMUSG00000007777 ...
21
## ENSMUSG00000055670 ENSMUSG00000039068
22
## rowData names(3): GENEID SYMBOL SEQNAME
23
## colnames(1915): JC4_349_HSC_FE_S13_ JC4_350_HSC_FE_S13_ ...
24
## JC48P6_1203_HSC_FE_S8_ JC48P6_1204_HSC_FE_S8_
25
## colData names(2): sample protocol
26
## reducedDimNames(0):
27
## altExpNames(0):
Copied!

2 质控

依然是备份一下,把unfiltered数据主要用在质控的探索上
1
unfiltered <- sce.grun.hsc
Copied!
发现这个数据既没有MT也没有ERCC
1
grep('MT',rowData(sce.grun.hsc)$SEQNAME)
2
# integer(0)
Copied!
能用的数据只有其中的protocol了,它表示细胞提取方法
1
table(sce.grun.hsc$protocol)
2
#
3
# micro-dissected cells
4
# 1546
5
# sorted hematopoietic stem cells
6
# 369
7
8
# 再看一下各个样本与提取方法的对应关系
9
table(sce.grun.hsc$protocol,sce.grun.hsc$sample)
Copied!
根据背景知识,大部分显微操作(micro-dissected)得到的细胞很多质量都较低,和我们的质控假设相违背,于是这里就不把它们纳入过滤条件
1
library(scater)
2
stats <- perCellQCMetrics(sce.grun.hsc)
3
# 只用sorted hematopoietic stem cells 计算过滤条件
4
qc <- quickPerCellQC(stats, batch=sce.grun.hsc$protocol,
5
subset=grepl("sorted", sce.grun.hsc$protocol))
6
7
colSums(as.matrix(qc))
8
## low_lib_size low_n_features discard
9
## 465 482 488
10
11
sce.grun.hsc <- sce.grun.hsc[,!qc$discard]
Copied!
做个图看看
1
colData(unfiltered) <- cbind(colData(unfiltered), stats)
2
unfiltered$discard <- qc$discard
3
4
gridExtra::grid.arrange(
5
plotColData(unfiltered, y="sum", x="sample", colour_by="discard",
6
other_fields="protocol") + scale_y_log10() + ggtitle("Total count") +
7
facet_wrap(~protocol),
8
plotColData(unfiltered, y="detected", x="sample", colour_by="discard",
9
other_fields="protocol") + scale_y_log10() +
10
ggtitle("Detected features") + facet_wrap(~protocol),
11
ncol=1
12
)
Copied!
可以看到,大多数的显微操作技术得到的细胞文库都比较小,相比于细胞分选方法,它在提取过程中对细胞损伤较大

3 归一化

使用去卷积方法
1
library(scran)
2
set.seed(101000110)
3
clusters <- quickCluster(sce.grun.hsc)
4
sce.grun.hsc <- computeSumFactors(sce.grun.hsc, clusters=clusters)
5
sce.grun.hsc <- logNormCounts(sce.grun.hsc)
Copied!

4 找表达量高变化基因

这里没有指定任何的批次,因为想保留这两种技术产生的任何差异
1
set.seed(00010101)
2
dec.grun.hsc <- modelGeneVarByPoisson(sce.grun.hsc)
3
top.grun.hsc <- getTopHVGs(dec.grun.hsc, prop=0.1)
Copied!
做个图
1
plot(dec.grun.hsc$mean, dec.grun.hsc$total, pch=16, cex=0.5,
2
xlab="Mean of log-expression", ylab="Variance of log-expression")
3
curfit <- metadata(dec.grun.hsc)
4
curve(curfit$trend(x), col='dodgerblue', add=TRUE, lwd=2)
Copied!
看到这个线有点“太平缓”,和之前见过的都不一样,感觉“中间少了一个峰”。这是因为细胞中的基因表达量都比较低,差别也不大【大家一起贫穷,于是贫富差距很小】,所以大部分细胞在纵坐标(衡量变化的方差)上体现不出来差距,也就导致了拟合的曲线不会有“峰”
可能会想,那为什么不是大家表达量都很高呢(大家都很富有,贫富差距不是也很小吗)?因为横坐标可以看到,从0-3.5,这个范围对于表达量来说确实很小,之前做的图有的都大于10、15

5 降维聚类

降维就采取最基础的方式:

1
set.seed(101010011)
2
sce.grun.hsc <- denoisePCA(sce.grun.hsc, technical=dec.grun.hsc, subset.row=top.grun.hsc)
3
sce.grun.hsc <- runTSNE(sce.grun.hsc, dimred="PCA")
4
5
# 检查PC的数量
6
ncol(reducedDim(sce.grun.hsc, "PCA"))
7
## [1] 9
Copied!

聚类

1
snn.gr <- buildSNNGraph(sce.grun.hsc, use.dimred="PCA")
2
colLabels(sce.grun.hsc) <- factor(igraph::cluster_walktrap(snn.gr)$membership)
3
4
table(colLabels(sce.grun.hsc))
5
##
6
## 1 2 3 4 5 6 7 8 9 10 11 12
7
## 259 148 221 103 177 108 48 122 98 63 62 18
Copied!

作图

1
short <- ifelse(grepl("micro", sce.grun.hsc$protocol), "micro", "sorted")
2
gridExtra:::grid.arrange(
3
plotTSNE(sce.grun.hsc, colour_by="label"),
4
plotTSNE(sce.grun.hsc, colour_by=I(short)),
5
ncol=2
6
)
Copied!
由于没有去除两个技术批次的差异,所以这里分的很开

6 找marker基因

1
markers <- findMarkers(sce.grun.hsc, test.type="wilcox", direction="up",
2
row.data=rowData(sce.grun.hsc)[,"SYMBOL",drop=FALSE])
Copied!
检查一下cluster6的marker基因
1
chosen <- markers[['6']]
2
best <- chosen[chosen$Top <= 10,]
3
length(best)
4
# [1] 16
5
6
# 将cluster6与其他clusters对比的AUC结果提取出来
7
aucs <- getMarkerEffects(best, prefix="AUC")
8
rownames(aucs) <- best$SYMBOL
9
10
library(pheatmap)
11
pheatmap(aucs, color=viridis::plasma(100))
Copied!
看到溶菌酶相关基因(LYZ家族)、Camp、 Lcn2、 Ltf 都上调,表明cluster6可能是神经元起源细胞
最近更新 1yr ago