4.1 实战一 | Smart-seq2 | 小鼠骨髓

刘小泽写于2020.7.18

上一页4 实战篇：活学活用下一页4.2 实战二 | STRT-Seq | 小鼠大脑

最后更新于4年前

1 前言

使用的是来自永生化小鼠骨髓祖细胞系的2个96孔板的416B cells（Lun et al. 2017），并且在细胞裂解后文库制备前，在每个细胞中加入一定量的外源RNA（ERCC）

ERCC就是外源RNA对照联盟开发的人工设计好的已知序列和数量的mRNA，高ERCC占比与低质量数据相关，并且通常是排除的标准。假如看到ERCC在很多样本中占比超过了20%（假如认为20%是一个较高的比例），那就是说这些样本中有超过20%的reads都”浪费“在了这种不相关的外源序列上，而减少了自身内源转录本的量，这对下游分析是不利的

之后再进行高通量测序，得到每个基因的表达量（这个是通过计算比对到外显子区域的reads数得到的，就像featureCounts的操作）；同样，spike-in的含量也是计算有多少reads比对到了spike-in的参考序列

先简单了解一下scRNAseq数据集

早期版本中只是内置了三个数据集Fluidig、Th2、Allen：当时也写了这一篇单细胞转录组学习笔记-14-学习scRNAseq这个R包，但后来这个包进行了更新，原来的数据获取方法也发生了变化

# 原来使用
data(fluidigm)
# 现在使用
ReprocessedFluidigmData() #provides 65 cells 
ReprocessedTh2Data() #provides 96 T helper cells 
ReprocessedAllenData() #provides 379 cells from the mouse visual cortex

另外新版本的包还加入了其他很多数据集，在官网帮助文档可以看到全部

2 数据加载

我们会使用416b这个数据

library(scRNAseq)
sce.416b <- LunSpikeInData(which="416b") 

> sce.416b
# class: SingleCellExperiment 
# dim: 46604 192 
# metadata(0):
#   assays(1): counts
# rownames(46604): ENSMUSG00000102693
# ENSMUSG00000064842 ... ENSMUSG00000095742
# CBFB-MYH11-mcherry
# rowData names(1): Length
# colnames(192):
#   SLX-9555.N701_S502.C89V9ANXX.s_1.r_1
# SLX-9555.N701_S503.C89V9ANXX.s_1.r_1 ...
# SLX-11312.N712_S508.H5H5YBBXX.s_8.r_1
# SLX-11312.N712_S517.H5H5YBBXX.s_8.r_1
# colData names(9): Source Name cell line ...
# spike-in addition block
# reducedDimNames(0):
#   altExpNames(2): ERCC SIRV

> table(sce.416b$block)
# 20160113 20160325 
# 96       96 

# 设置分组信息（因为来自2个96孔板），也就是为后面的批次处理做铺垫
sce.416b$block <- factor(sce.416b$block)

# 当前关于行（基因）的信息只有基因长度
> rowData(sce.416b)
# DataFrame with 46604 rows and 1 column
# Length
# <integer>
#   ENSMUSG00000102693      1070
# ENSMUSG00000064842       110
# ENSMUSG00000051951      6094
# ENSMUSG00000102851       480
# ENSMUSG00000103377      2819
# ...                      ...
# ENSMUSG00000094621       121
# ENSMUSG00000098647        99
# ENSMUSG00000096730      3077
# ENSMUSG00000095742       243
# CBFB-MYH11-mcherry      2998

增加基因的信息（symbol ID、染色体位置）

首先是基因ID转换

这个函数是我非常喜欢的，方便了基因ID转换

将Ensembl ID转为Symbol，使用uniquifyFeatureNames，参数很简单，第一个是ID，第二是names

This function will attempt to use names if it is unique. If not, it will append the _ID to any non-unique value of names. Missing names will be replaced entirely by ID.
含义就是：
如果有symbol name的，它会将Ensembl ID替换为symbol name，没有name的仍然使用ID；
如果name相同、ID不同（即两个Ensembl ID对应同一个Symbol name），它会将ID与name组合（name_id）保证特异性

library(AnnotationHub)
ens.mm.v97 <- AnnotationHub()[["AH73905"]]
columns(ens.mm.v97)
# [1] "DESCRIPTION"         "ENTREZID"            "EXONID"              "EXONIDX"             "EXONSEQEND"         
# [6] "EXONSEQSTART"        "GENEBIOTYPE"         "GENEID"              "GENEIDVERSION"       "GENENAME"           
# [11] "GENESEQEND"          "GENESEQSTART"        "INTERPROACCESSION"   "ISCIRCULAR"          "PROTDOMEND"         
# [16] "PROTDOMSTART"        "PROTEINDOMAINID"     "PROTEINDOMAINSOURCE" "PROTEINID"           "PROTEINSEQUENCE"    
# [21] "SEQCOORDSYSTEM"      "SEQLENGTH"           "SEQNAME"             "SEQSTRAND"           "SYMBOL"             
# [26] "TXBIOTYPE"           "TXCDSSEQEND"         "TXCDSSEQSTART"       "TXID"                "TXIDVERSION"        
# [31] "TXNAME"              "TXSEQEND"            "TXSEQSTART"          "TXSUPPORTLEVEL"      "UNIPROTDB"          
# [36] "UNIPROTID"           "UNIPROTMAPPINGTYPE" 

rowData(sce.416b)$ENSEMBL <- rownames(sce.416b)
rowData(sce.416b)$SYMBOL <- mapIds(ens.mm.v97, keys=rownames(sce.416b),
                                   keytype="GENEID", column="SYMBOL")

如果需要把这个函数应用在日常使用中，也很简单，它只需要两个参数：一个ID，一个ID对应的名字

# 一个ID
head(rowData(sce.416b)$ENSEMBL)
# [1] "ENSMUSG00000102693" "ENSMUSG00000064842"
# [3] "ENSMUSG00000051951" "ENSMUSG00000102851"
# [5] "ENSMUSG00000103377" "ENSMUSG00000104017"
# 一个ID对应的名字(这一步是问题的根源：存在无对应NA或者一对多、多对一的问题)
head(rowData(sce.416b)$SYMBOL)
# ENSMUSG00000102693 ENSMUSG00000064842 
# "4933401J01Rik"          "Gm26206" 
# ENSMUSG00000051951 ENSMUSG00000102851 
# "Xkr4"          "Gm18956" 
# ENSMUSG00000103377 ENSMUSG00000104017 
# "Gm37180"          "Gm37363"
uniquifyFeatureNames(head(rowData(sce.416b)$ENSEMBL), 
                     head(rowData(sce.416b)$SYMBOL))

然后增加基因的染色体编号（方便后面识别线粒体基因）

rowData(sce.416b)$SEQNAME <- mapIds(ens.mm.v97, keys=rownames(sce.416b),
                                    keytype="GENEID", column="SEQNAME")
> table(rowData(sce.416b)$SEQNAME=='MT')
# FALSE  TRUE 
# 46004    37

3 质控

备份数据

unfiltered <- sce.416b

一般来说，有spike-in其实可以不需要线粒体过滤（因为它们的目的一致），但是这里还是加上了，双重保险

mito <- which(rowData(sce.416b)$SEQNAME=="MT")
# 先计算各个细胞的QC指标
stats <- perCellQCMetrics(sce.416b, subsets=list(Mt=mito))
colnames(stats)
# [1] "sum"                   "detected"             
# [3] "percent_top_50"        "percent_top_100"      
# [5] "percent_top_200"       "percent_top_500"      
# [7] "subsets_Mt_sum"        "subsets_Mt_detected"  
# [9] "subsets_Mt_percent"    "altexps_ERCC_sum"     
# [11] "altexps_ERCC_detected" "altexps_ERCC_percent" 
# [13] "altexps_SIRV_sum"      "altexps_SIRV_detected"
# [15] "altexps_SIRV_percent"  "total"  

# 再根据QC指标进行判断，哪些该去除
qc <- quickPerCellQC(stats, percent_subsets=c("subsets_Mt_percent",
    "altexps_ERCC_percent"), batch=sce.416b$block)

sce.416b <- sce.416b[,!qc$discard]

> dim(sce.416b)
[1] 46604   185
> dim(unfiltered)
[1] 46604   192

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

colData(unfiltered) <- cbind(colData(unfiltered), stats)
unfiltered$discard <- qc$discard

gridExtra::grid.arrange(
    plotColData(unfiltered, x="block", y="sum", 
        colour_by="discard") + scale_y_log10() + ggtitle("Total count"),
    plotColData(unfiltered, x="block", y="detected", 
        colour_by="discard") + scale_y_log10() + ggtitle("Detected features"),
    plotColData(unfiltered, x="block", y="subsets_Mt_percent", 
        colour_by="discard") + ggtitle("Mito percent"),
    plotColData(unfiltered, x="block", y="altexps_ERCC_percent", 
        colour_by="discard") + ggtitle("ERCC percent"),
    nrow=2,
    ncol=2
)

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

gridExtra::grid.arrange(
    plotColData(unfiltered, x="sum", y="subsets_Mt_percent", 
        colour_by="discard") + scale_x_log10(),
    plotColData(unfiltered, x="altexps_ERCC_percent", y="subsets_Mt_percent",
        colour_by="discard"),
    ncol=2
)

然后检查一下被过滤的原因

colSums(as.matrix(qc))
##              low_lib_size            low_n_features   high_subsets_Mt_percent 
##                         5                         0                         2 
## high_altexps_ERCC_percent                   discard 
##                         2                         7

4 归一化

之前在 3.2 归一化中介绍：去卷积方法计算size factor时，操作是这样的

先混合：Pool counts from many cells to increase the size of the counts
后去卷积：Pool-based size factors are then “deconvolved” into cell-based factors for normalization of each cell’s expression profile.

set.seed(100)
# 这里一看有pre-clustering就知道是利用的去卷积的size factor
clust.zeisel <- quickCluster(sce.zeisel) 
sce.zeisel <- computeSumFactors(sce.zeisel, cluster=clust.zeisel, min.mean=0.1)
sce.zeisel <- logNormCounts(sce.zeisel)

但是这里的数据集由于细胞数量较少，并且所有的细胞都是源自一个细胞系，所以不需要提前进行聚类quickCluster操作，直接进行去卷积即可。目的只有一个，将技术因素（如测序）导致的文库大小差异降到最低

library(scran)
sce.416b <- computeSumFactors(sce.416b)
sce.416b <- logNormCounts(sce.416b)
summary(sizeFactors(sce.416b))
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   0.347   0.711   0.921   1.000   1.152   3.604

看看两种归一化方法的差异

# 常规：最简单的只考虑文库大小
summary(librarySizeFactors(sce.416b))
# Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
# 0.3996  0.7601  0.9406  1.0000  1.1207  3.6720 

plot(librarySizeFactors(sce.416b), sizeFactors(sce.416b), pch=16,
    xlab="Library size factors", ylab="Deconvolution factors",
     # 这是一个不错的主意，可以学习，直接将不同类型赋予不同颜色
     # +1操作是为了将原来的False（0）、True（1）变成1、2
     # 因此得到的black就是uninduced，red就是induced
    col=c("black", "red")[grepl("induced", sce.416b$phenotype)+1],
    log="xy")

看到去卷积的方法的确能暴露出细胞类型对文库矫正的影响，因为如果只考虑文库大小，那么常规的方法和去卷积方法应该结果一致，也不会出现红点和黑点分离的情况，但现在既然由于细胞类型不同而导致size factor出现了偏差，那么就是去卷积方法还考虑了其他因素，做的更加精细。

当然，使用常规的文库大小归一化方法对细胞分群和鉴定每群的marker基因是足够的。这里使用去卷积得到更准确的结果，虽然对分群改善不大，但对于每个基因的表达量数据估计与解释还是很重要的，因为它考虑了细胞类型组成差异的影响。

5 找表达量高变化基因

这里会使用到之前设置的批次信息，即：用spike-in来拟合更准确的技术偏差，同时考虑上批次信息【在之前 3.3 挑选高变化基因的2.4 考虑批次效应部分提到】

dec.416b <- modelGeneVarWithSpikes(sce.416b, "ERCC", block=sce.416b$block)
chosen.hvgs <- getTopHVGs(dec.416b, prop=0.1)

分别作图

par(mfrow=c(1,2))
blocked.stats <- dec.416b$per.block
for (i in colnames(blocked.stats)) {
    current <- blocked.stats[[i]]
    plot(current$mean, current$total, main=i, pch=16, cex=0.5,
        xlab="Mean of log-expression", ylab="Variance of log-expression")
    curfit <- metadata(current)
    points(curfit$mean, curfit$var, col="red", pch=16)
    curve(curfit$trend(x), col='dodgerblue', add=TRUE, lwd=2)
}

黑点是基因，红点是spike-in，蓝线是根据红点画的拟合线。看到这里的两个批次之间差异很小，表示重复效果不错

6 批次矫正

从上面的效果看，这两个细胞板之间的细胞细胞组成应该是差不多的，因此使用简单的批次处理即可，不需要动用太复杂的方法；如果数据集比较大，需要考虑的批次效应更多，可能要动用 batchelor包的regressBatches()

library(limma)
assay(sce.416b, "corrected") <- removeBatchEffect(logcounts(sce.416b), 
    design=model.matrix(~sce.416b$phenotype), batch=sce.416b$block)

7 降维

这个小数据集我们估计也不会有太大的异质性，因此设置10个主成分即可

然后使用精确的 SVD方法，来避免 irlba包对于处理小数据可能会出现的一些warning信息

sce.416b <- runPCA(sce.416b, ncomponents=10, subset_row=chosen.hvgs,
    exprs_values="corrected", BSPARAM=BiocSingular::ExactParam())

set.seed(1010)
sce.416b <- runTSNE(sce.416b, dimred="PCA", perplexity=10)

8 聚类

# 看到这里使用了层次聚类的方法
my.dist <- dist(reducedDim(sce.416b, "PCA"))
my.tree <- hclust(my.dist, method="ward.D2")

library(dynamicTreeCut)
my.clusters <- unname(cutreeDynamic(my.tree, distM=as.matrix(my.dist),
    minClusterSize=10, verbose=0))
colLabels(sce.416b) <- factor(my.clusters)

看一下现在的分群和批次之间的联系

table(Cluster=colLabels(sce.416b), Plate=sce.416b$block)
##        Plate
## Cluster 20160113 20160325
##       1       40       38
##       2       37       32
##       3       10       14
##       4        6        8

再比较一下现在的分群和表型之间的联系

##        Oncogene
## Cluster induced CBFB-MYH11 oncogene expression wild type phenotype
##       1                                     78                   0
##       2                                      0                  69
##       3                                      1                  23
##       4                                     14                   0

作图

plotTSNE(sce.416b, colour_by="label")

可以借助”轮廓图“（silhouette width）检查分群的质量

会对每个细胞都计算一个silhouette width值，如果一个细胞的width值为正并且越大，表示相对于其他亚群的细胞，这个细胞和它所在亚群中的细胞更接近，分群效果越好；如果width为负，就表示这个亚群的这个细胞和其他亚群的细胞更接近，即分群效果不太理想。

library(cluster)
sil <- silhouette(my.clusters, dist = my.dist)
> colnames(sil)
[1] "cluster"   "neighbor"  "sil_width"

# 设置每个cluster的颜色
clust.col <- scater:::.get_palette("tableau10medium")

# 下面这一句的意思是：如果sil_width>0，就属于和自己接近，否则属于和其他亚群接近
sil.cols <- clust.col[ifelse(sil[,3] > 0, sil[,1], sil[,2])]
sil.cols <- sil.cols[order(-sil[,1], sil[,3])]

plot(sil, main = paste(length(unique(my.clusters)), "clusters"),
    border=sil.cols, col=sil.cols, do.col.sort=FALSE)

图中可以反映的问题：

这个图是对上面得到的各个cluster中的细胞做的barplot，每个cluster是一种颜色。
这里看到cluster2都是正值并且横坐标width数值还是最大的，因此说明了分群没有问题，之前t-SNE的结果的确是它本身的问题
如果发现width值较小，表示分群结果一般，还有可能是分群过度，本来属于一个群的，又被拆分成小群
利用这个图，我们就能调整之前的参数，来调整分群效果，不过也不需要太过纠结完美的分群结果。因为即使图上看似合理的分群，可能实际上也不会得到更多的生物信息

9 找marker基因并解释结果

markers <- findMarkers(sce.416b, my.clusters, block=sce.416b$block)
# 找cluster1的marker基因
marker.set <- markers[["1"]]
# cluster1 的Top10
head(marker.set, 10)

使用cluster1的Top10基因（但不一定只是10个）画热图

看到这些基因在cluster1的分布确实和其他几个clusters不同，表示差异基因找的比较可靠；另外看到，cluster 1含有致癌细胞，而且和DNA复制和细胞周期相关基因有强烈的下调，道理上也说得通，毕竟细胞衰老也是诱导癌细胞的一个因素

top.markers <- rownames(marker.set)[marker.set$Top <= 10]
> length(top.markers)
[1] 29

plotHeatmap(sce.416b, features=top.markers, order_columns_by="label",
    colour_columns_by=c("label", "block", "phenotype"),
    center=TRUE, symmetric=TRUE, zlim=c(-5, 5))

看着是不是很像pheatmap的结果，其实看一下这个函数，就是基于pheatmap做的