單細胞交響樂20-實戰三 10X 未過濾的PBMC數據

劉小澤寫於2020.7.19
爲何取名叫“交響樂”？因爲單細胞分析就像一個大樂團，需要各個流程的協同配合
單細胞交響樂1-常用的數據結構SingleCellExperiment
單細胞交響樂2-scRNAseq從實驗到下游簡介
單細胞交響樂3-細胞質控
單細胞交響樂4-歸一化
單細胞交響樂5-挑選高變化基因
單細胞交響樂6-降維
單細胞交響樂7-聚類分羣
單細胞交響樂8-marker基因檢測
單細胞交響樂9-細胞類型註釋
單細胞交響樂9-細胞類型註釋
單細胞交響樂10-數據集整合後的批次矯正
單細胞交響樂11-多樣本間差異分析
單細胞交響樂12-檢測Doublet
單細胞交響樂13-細胞週期推斷
單細胞交響樂14-細胞軌跡推斷
單細胞交響樂15-scRNA與蛋白丰度信息結合
單細胞交響樂16-處理大型數據
單細胞交響樂17-不同單細胞R包的數據格式相互轉換
單細胞交響樂18-實戰一 Smart-seq2
單細胞交響樂19-實戰二 STRT-Seq

1 前言

前面的種種都是作爲知識儲備，但是不實戰還是記不住前面的知識
這是第三個實戰練習

相信學習單細胞數據分析的大家對PBMC都不陌生，雖然不是相關背景，但Seurat的PBMC數據深入人心。PBMC全稱是peripheral blood mononuclear cell ，外周血單核細胞。

我們這裏用的數據集來自Zheng et al. 2017，並在10X Genomics官網也可以獲取：https://support.10xgenomics.com/single-cell-gene-expression/datasets/2.1.0/pbmc4k，數量比Seurat使用的的2700細胞數據更大

2 數據準備

下載

當然也可以跳過這一步，自己下載好之後讀入。這裏只是學習一下另一種方法

library(BiocFileCache)
bfc <- BiocFileCache("raw_data", ask = FALSE)
raw.path <- bfcrpath(bfc, file.path("http://cf.10xgenomics.com/samples",
    "cell-exp/2.1.0/pbmc4k/pbmc4k_raw_gene_bc_matrices.tar.gz"))
untar(raw.path, exdir=file.path(tempdir(), "pbmc4k"))
# 最後也就是得到這三個文件：barcodes.tsv genes.tsv    matrix.mtx

讀取

library(DropletUtils)
fname <- file.path(tempdir(), "pbmc4k/raw_gene_bc_matrices/GRCh38")
sce.pbmc <- read10xCounts(fname, col.names=TRUE)
# 看這裏的數量驚人，但是後面還需要過濾
sce.pbmc
# class: SingleCellExperiment 
# dim: 33694 737280 
# metadata(1): Samples
# assays(1): counts
# rownames(33694): ENSG00000243485
# ENSG00000237613 ... ENSG00000277475
# ENSG00000268674
# rowData names(2): ID Symbol
# colnames(737280): AAACCTGAGAAACCAT-1
# AAACCTGAGAAACCGC-1 ... TTTGTCATCTTTAGTC-1
# TTTGTCATCTTTCCTC-1
# colData names(2): Sample Barcode
# reducedDimNames(0):
#   altExpNames(0):

轉換ID，添加染色體信息

library(scater)
rownames(sce.pbmc) <- uniquifyFeatureNames(
    rowData(sce.pbmc)$ID, rowData(sce.pbmc)$Symbol)

library(EnsDb.Hsapiens.v86)
location <- mapIds(EnsDb.Hsapiens.v86, keys=rowData(sce.pbmc)$ID, 
    column="SEQNAME", keytype="GENEID")

3 質控

10X數據面臨的一大問題就是空液滴，因此需要emptyDrops檢驗一下

set.seed(100)
# 對70多萬個液滴進行檢驗
e.out <- emptyDrops(counts(sce.pbmc))
# > e.out
# DataFrame with 737280 rows and 5 columns
# Total   LogProb    PValue   Limited       FDR
# <integer> <numeric> <numeric> <logical> <numeric>
#   AAACCTGAGAAACCAT-1         1        NA        NA        NA        NA
# AAACCTGAGAAACCGC-1         0        NA        NA        NA        NA
# AAACCTGAGAAACCTA-1         1        NA        NA        NA        NA
# AAACCTGAGAAACGAG-1         0        NA        NA        NA        NA
# AAACCTGAGAAACGCC-1         1        NA        NA        NA        NA
# ...                      ...       ...       ...       ...       ...
# TTTGTCATCTTTACAC-1         2        NA        NA        NA        NA
# TTTGTCATCTTTACGT-1        33        NA        NA        NA        NA
# TTTGTCATCTTTAGGG-1         0        NA        NA        NA        NA
# TTTGTCATCTTTAGTC-1         0        NA        NA        NA        NA
# TTTGTCATCTTTCCTC-1         1        NA        NA        NA        NA

# 最後過濾，剩下4000多
sce.pbmc <- sce.pbmc[,which(e.out$FDR <= 0.001)]
sce.pbmc
# class: SingleCellExperiment 
# dim: 33694 4233 
# metadata(1): Samples
# assays(1): counts
# rownames(33694): RP11-34P13.3 FAM138A ...
# AC213203.1 FAM231B
# rowData names(2): ID Symbol
# colnames(4233): AAACCTGAGAAGGCCT-1
# AAACCTGAGACAGACC-1 ... TTTGTCACAGGTCCAC-1
# TTTGTCATCCCAAGAT-1
# colData names(2): Sample Barcode
# reducedDimNames(0):
#   altExpNames(0):

依然是備份一下，把unfiltered數據主要用在質控的探索上

unfiltered <- sce.pbmc

這裏過濾的條件不需要太嚴苛，只需要去除線粒體含量太高的細胞即可

成熟的mRNA會通過核孔來到細胞質。如果細胞遭到破壞，大量細胞質中mRNA流失，而線粒體體積比較大，流不出去，含量基本不變，最後導致細胞質中捕獲的線粒體RNA佔比升高

stats <- perCellQCMetrics(sce.pbmc, subsets=list(Mito=which(location=="MT")))
high.mito <- isOutlier(stats$subsets_Mito_percent, type="higher")
sce.pbmc <- sce.pbmc[,!high.mito]

summary(high.mito)
##    Mode   FALSE    TRUE 
## logical    3922     311

根據原來的數據，加上質控標準作圖

colData(unfiltered) <- cbind(colData(unfiltered), stats)
unfiltered$discard <- high.mito

gridExtra::grid.arrange(
    plotColData(unfiltered, y="sum", colour_by="discard") +
        scale_y_log10() + ggtitle("Total count"),
    plotColData(unfiltered, y="detected", colour_by="discard") +
        scale_y_log10() + ggtitle("Detected features"),
    plotColData(unfiltered, y="subsets_Mito_percent",
        colour_by="discard") + ggtitle("Mito percent"),
    ncol=3
)

再看下文庫大小分別和線粒體含量的關係

plotColData(unfiltered, x="sum", y="subsets_Mito_percent",
    colour_by="discard") + scale_x_log10()

4 歸一化

也是使用預分羣+去卷積計算size factor的方法

library(scran)
set.seed(1000)
clusters <- quickCluster(sce.pbmc)
sce.pbmc <- computeSumFactors(sce.pbmc, cluster=clusters)
sce.pbmc <- logNormCounts(sce.pbmc)

summary(sizeFactors(sce.pbmc))
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   0.009   0.710   0.871   1.000   1.094  13.948

看看兩種歸一化方法的差異

plot(librarySizeFactors(sce.pbmc), sizeFactors(sce.pbmc), pch=16,
    xlab="Library size factors", ylab="Deconvolution factors", log="xy")
abline(a=0, b=1, col="red")

5 找高變異基因

既然有UMI，就可以用第三種方法【在之前單細胞交響樂5-挑選高變化基因的 2.3 考慮技術噪音，如果沒有spike-in】：可以考慮利用數據分佈來表示技術噪音，例如只考慮技術噪音的話，UMI counts通常會呈現近似泊松分佈

set.seed(1001)
dec.pbmc <- modelGeneVarByPoisson(sce.pbmc)
top.pbmc <- getTopHVGs(dec.pbmc, prop=0.1)

# 作圖
plot(dec.pbmc$mean, dec.pbmc$total, pch=16, cex=0.5,
    xlab="Mean of log-expression", ylab="Variance of log-expression")
curfit <- metadata(dec.pbmc)
curve(curfit$trend(x), col='dodgerblue', add=TRUE, lwd=2)

6 降維

set.seed(10000)
sce.pbmc <- denoisePCA(sce.pbmc, subset.row=top.pbmc, technical=dec.pbmc)

set.seed(100000)
sce.pbmc <- runTSNE(sce.pbmc, dimred="PCA")

set.seed(1000000)
sce.pbmc <- runUMAP(sce.pbmc, dimred="PCA")

看看保留了幾個PC

ncol(reducedDim(sce.pbmc, "PCA"))
## [1] 8

7 聚類

g <- buildSNNGraph(sce.pbmc, k=10, use.dimred = 'PCA')
clust <- igraph::cluster_walktrap(g)$membership
colLabels(sce.pbmc) <- factor(clust)

table(colLabels(sce.pbmc))
## 
##   1   2   3   4   5   6   7   8   9  10  11  12  13  14  15  16  17  18 
## 585 518 364 458 170 791 295 107  45  46 152  84  40  60 142  16  28  21

plotTSNE(sce.pbmc, colour_by="label")

8 找marker基因並解釋結果

markers <- findMarkers(sce.pbmc, pval.type="some", direction="up")

這次看看cluster 7的marker基因

marker.set <- markers[["7"]]
as.data.frame(marker.set[1:30,1:3])
# p.value           FDR summary.logFC
# FCN1   4.881588e-137 1.644802e-132      2.715872
# LGALS2 3.729029e-133 6.282295e-129      2.191398
# CSTA   1.426854e-131 1.602548e-127      2.123738
# CFD    1.207067e-102  1.016773e-98      1.503274
# FGL2    8.567117e-93  5.773209e-89      1.358891
# IFI30   7.822561e-80  4.392889e-76      1.276366
# CLEC7A  6.052032e-79  2.913102e-75      1.109366
# MS4A6A  1.958033e-78  8.246744e-75      1.419465
# CFP     8.802407e-73  3.295426e-69      1.312191
# S100A8  6.193215e-70  2.086742e-66      3.431603

再和其他clusters對比

plotExpression(sce.pbmc, features=c("CD14", "CD68",
    "MNDA", "FCGR3A"), x="label", colour_by="label")

其實最後還是考驗的背景知識：根據cluster7中CD14、CD68、MNDA表達量升高，同時又檢查了CD16基因下調，推測cluster7是單核細胞

---

歡迎關注我們的公衆號～_～　　
我們是兩個農轉生信的小碩，打造生信星球，想讓它成爲一個不拽術語、通俗易懂的生信知識平臺。需要幫助或提出意見請後臺留言或發送郵件到[email protected]