劉小澤寫於2020.7.20
爲何取名叫“交響樂”？因爲單細胞分析就像一個大樂團，需要各個流程的協同配合
單細胞交響樂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
單細胞交響樂20-實戰三 10X 未過濾的PBMC數據
單細胞交響樂21-實戰三 批量處理並整合多個10X PBMC數據
1 前言
前面的種種都是作爲知識儲備，但是不實戰還是記不住前面的知識
這是第五個實戰練習
第一代CEL-Seq由以色列理工學院研究團隊於2012發表在Cell Reports
CEL-Seq的全稱是：Cell expression by linear amplification and sequencing，採用線性擴增的測序方法，其主要優勢在於錯誤率比較低，但是和PCR一樣都存在序列偏向性。另外還具有以下優點：
- 使用barcode允許多種類型的細胞同時分析；
- 每個細胞在一個管中進行處理，避免了樣本之間的污染
後來在2016年，CEL-seq2誕生，與早期版本相比具有低成本、高靈敏度，並縮短了實驗操作實驗時間
數據準備
這裏使用的數據是： Grun et al. (2016) 中不同人類供體的胰腺細胞
library(scRNAseq)
sce.grun <- GrunPancreasData()
sce.grun
# class: SingleCellExperiment
# dim: 20064 1728
# metadata(0):
# assays(1): counts
# rownames(20064): A1BG-AS1__chr19 A1BG__chr19 ...
# ZZEF1__chr17 ZZZ3__chr1
# rowData names(2): symbol chr
# colnames(1728): D2ex_1 D2ex_2 ... D17TGFB_95
# D17TGFB_96
# colData names(2): donor sample
# reducedDimNames(0):
# altExpNames(1): ERCC
rowData(sce.grun)
# DataFrame with 20064 rows and 2 columns
# symbol chr
# <character> <character>
# A1BG-AS1__chr19 A1BG-AS1 chr19
# A1BG__chr19 A1BG chr19
# A1CF__chr10 A1CF chr10
# A2M-AS1__chr12 A2M-AS1 chr12
# A2ML1__chr12 A2ML1 chr12
# ... ... ...
# ZYG11A__chr1 ZYG11A chr1
# ZYG11B__chr1 ZYG11B chr1
# ZYX__chr7 ZYX chr7
# ZZEF1__chr17 ZZEF1 chr17
# ZZZ3__chr1 ZZZ3 chr1
ID轉換
先將symbol轉爲Ensembl ID
library(org.Hs.eg.db)
gene.ids <- mapIds(org.Hs.eg.db, keys=rowData(sce.grun)$symbol,
keytype="SYMBOL", column="ENSEMBL")
接下來有兩種處理方式：
第一種：將Ensembl ID加到原來數據中
library(scater)
rowData(sce.grun)$ensembl <- uniquifyFeatureNames(
rowData(sce.grun)$symbol, gene.ids)
rowData(sce.grun)
# DataFrame with 20064 rows and 3 columns
# symbol chr ensembl
# <character> <character> <character>
# A1BG-AS1__chr19 A1BG-AS1 chr19 ENSG00000268895
# A1BG__chr19 A1BG chr19 ENSG00000121410
# A1CF__chr10 A1CF chr10 ENSG00000148584
# A2M-AS1__chr12 A2M-AS1 chr12 ENSG00000245105
# A2ML1__chr12 A2ML1 chr12 ENSG00000166535
# ... ... ... ...
# ZYG11A__chr1 ZYG11A chr1 ENSG00000203995
# ZYG11B__chr1 ZYG11B chr1 ENSG00000162378
# ZYX__chr7 ZYX chr7 ENSG00000159840
# ZZEF1__chr17 ZZEF1 chr17 ENSG00000074755
# ZZZ3__chr1 ZZZ3 chr1 ENSG00000036549
第二種：將沒有匹配的NA去掉，並且去掉重複的行（因爲可能存在一個symbol對應多個Ensembl ID的情況）【這裏就試一下這種方法】
keep <- !is.na(gene.ids) & !duplicated(gene.ids)
> sum(is.na(gene.ids));sum(duplicated(gene.ids))
[1] 2487
[1] 2515
sce.grun <- sce.grun[keep,]
rownames(sce.grun) <- gene.ids[keep]
> dim(sce.grun) # 過濾掉2000多基因
[1] 17548 1728
2 質控
前幾次實戰的質控都很順利，但並不意味着實際操作中這一步就可以跑跑代碼解決
這一次，就遇到了一個常規代碼解決不了的問題，需要思考+調整
依然是備份一下，把unfiltered數據主要用在質控的探索上
unfiltered <- sce.grun
看到這裏的數據中沒有線粒體基因
table(rowData(sce.grun)$chr)
#
# chr1 chr10 chr11 chr12 chr13 chr14 chr15 chr16 chr17 chr18
# 1766 672 1071 947 328 551 532 740 1050 256
# chr19 chr2 chr20 chr21 chr22 chr3 chr4 chr5 chr6 chr7
# 1245 1142 484 188 400 1014 693 791 907 825
# chr8 chr9 chrX chrY
# 604 664 658 20
倒是有幾個donor的批次信息
table(colData(sce.grun)$donor)
#
# D10 D17 D2 D3 D7
# 288 480 96 480 384
我們之前進行質控的時候，一般採用的先使用perCellQCMetrics 指定線粒體計算，然後用 quickPerCellQC 指定ERCC+線粒體進行過濾的策略。現在既然沒有線粒體的信息，那麼在第一步的perCellQCMetrics就不需要加subset參數了
stats <- perCellQCMetrics(sce.grun)
# 參數subsets的含義: used to identify interesting feature subsets such as ERCC spike-in transcripts or mitochondrial genes.
# > colnames(stats)
# [1] "sum" "detected"
# [3] "percent_top_50" "percent_top_100"
# [5] "percent_top_200" "percent_top_500"
# [7] "altexps_ERCC_sum" "altexps_ERCC_detected"
# [9] "altexps_ERCC_percent" "total"
然後進行過濾，並讓函數注意批次信息
qc <- quickPerCellQC(stats, percent_subsets="altexps_ERCC_percent",
batch=sce.grun$donor)
colSums(as.matrix(qc), na.rm=TRUE)
# low_lib_size low_n_features high_altexps_ERCC_percent
# 85 93 88
# discard
# 129
作圖
colData(unfiltered) <- cbind(colData(unfiltered), stats)
unfiltered$discard <- qc$discard
gridExtra::grid.arrange(
plotColData(unfiltered, x="donor", y="sum", colour_by="discard") +
scale_y_log10() + ggtitle("Total count"),
plotColData(unfiltered, x="donor", y="detected", colour_by="discard") +
scale_y_log10() + ggtitle("Detected features"),
plotColData(unfiltered, x="donor", y="altexps_ERCC_percent",
colour_by="discard") + ggtitle("ERCC percent"),
ncol=3
)
【重點】發現了問題
質控並非是一帆風順的，遇到問題應該知道如何探索解決
看到ERCC那個圖，很明顯D10和D3沒有被正確過濾，它們中高ERCC的細胞還是沒有被去掉
質控過濾有一個前提條件：大部分的細胞都是高質量的，但顯然這裏的D10、D3不符合這個要求，因此我們需要再次只根據D17、D2、D7這三個“好一點的樣本”進行過濾
# 重新計算過濾條件
qc2 <- quickPerCellQC(stats, percent_subsets="altexps_ERCC_percent",
batch=sce.grun$donor,
subset=sce.grun$donor %in% c("D17", "D7", "D2"))
colSums(as.matrix(qc2), na.rm=TRUE)
# low_lib_size low_n_features high_altexps_ERCC_percent discard
# 450 511 606 665
這次再作圖看看
colData(unfiltered) <- cbind(colData(unfiltered), stats)
unfiltered$discard <- qc2$discard
gridExtra::grid.arrange(
plotColData(unfiltered, x="donor", y="sum", colour_by="discard") +
scale_y_log10() + ggtitle("Total count"),
plotColData(unfiltered, x="donor", y="detected", colour_by="discard") +
scale_y_log10() + ggtitle("Detected features"),
plotColData(unfiltered, x="donor", y="altexps_ERCC_percent",
colour_by="discard") + ggtitle("ERCC percent"),
ncol=3
)
看到這次對D10、D3的過濾力度大了很多，基本滿意
最後把過濾條件應用在原數據
sce.grun <- sce.grun[,!qc$discard]
3 歸一化
也是使用預分羣+去卷積計算size factor的方法
library(scran)
set.seed(1000)
clusters <- quickCluster(sce.grun)
sce.grun <- computeSumFactors(sce.grun, cluster=clusters)
sce.grun <- logNormCounts(sce.grun)
summary(sizeFactors(sce.grun))
# Min. 1st Qu. Median Mean 3rd Qu. Max.
# 0.09581 0.50459 0.79505 1.00000 1.22212 12.16491
看看兩種歸一化方法的差異
plot(librarySizeFactors(sce.grun), sizeFactors(sce.grun), pch=16,
col=as.integer(factor(sce.grun$donor)),
xlab="Library size factors", ylab="Deconvolution factors", log="xy")
abline(a=0, b=1, col="red")
也是再一次證明了去卷積方法比常規的方法更加精細，對批次層面也會納入考量
4 找高變異基因
既然有批次的信息，那就加到構建模型中去，而且有ERCC，就選用modelGeneVarWithSpikes這個方法
block <- paste0(sce.grun$sample, "_", sce.grun$donor)
dec.grun <- modelGeneVarWithSpikes(sce.grun, spikes="ERCC", block=block)
top.grun <- getTopHVGs(dec.grun, prop=0.1)
5 矯正批次效應
使用FastMNN方法：Correct for batch effects in single-cell expression data using a fast version of the mutual nearest neighbors (MNN) method.
library(batchelor)
set.seed(1001010)
merged.grun <- fastMNN(sce.grun, subset.row=top.grun, batch=sce.grun$donor)
merged.grun
# class: SingleCellExperiment
# dim: 1467 1063
# metadata(2): merge.info pca.info
# assays(1): reconstructed
# rownames(1467): ENSG00000172023 ENSG00000172016 ...
# ENSG00000144867 ENSG00000179820
# rowData names(1): rotation
# colnames(1063): D2ex_1 D2ex_2 ... D17TGFB_94
# D17TGFB_95
# colData names(1): batch
# reducedDimNames(2): corrected
# altExpNames(0):
檢查一下結果，使用lost.var ，值越大表示丟失的真實生物異質性越多
metadata(merged.grun)$merge.info$lost.var
# D10 D17 D2 D3 D7
# [1,] 0.030843209 0.030956515 0.000000000 0.00000000 0.00000000
# [2,] 0.007129994 0.011275730 0.036836491 0.00000000 0.00000000
# [3,] 0.003528589 0.005027722 0.006846244 0.05020422 0.00000000
# [4,] 0.012070814 0.014673302 0.013972521 0.01267586 0.05281354
- It contains a matrix of the variance lost in each batch (column) at each merge step (row).
- Large proportions of lost variance (>10%) suggest that correction is removing genuine biological heterogeneity.
6 降維 + 聚類
降維
set.seed(100111)
merged.grun <- runTSNE(merged.grun, dimred="corrected")
聚類
snn.gr <- buildSNNGraph(merged.grun, use.dimred="corrected")
colLabels(merged.grun) <- factor(igraph::cluster_walktrap(snn.gr)$membership)
# 聚類的分羣與批次之間的對比
table(Cluster=colLabels(merged.grun), Donor=merged.grun$batch)
## Donor
## Cluster D10 D17 D2 D3 D7
## 1 32 71 33 80 29
## 2 5 7 3 4 4
## 3 3 44 0 0 13
## 4 11 119 0 0 55
## 5 12 73 30 3 78
## 6 14 29 3 2 64
## 7 1 9 0 0 7
## 8 2 5 2 3 4
## 9 5 13 0 0 10
## 10 15 33 11 10 37
## 11 5 18 0 1 33
## 12 4 13 0 0 1
最後作圖看看批次效應矯正如何
gridExtra::grid.arrange(
plotTSNE(merged.grun, colour_by="label"),
plotTSNE(merged.grun, colour_by="batch"),
ncol=2
)
歡迎關注我們的公衆號～_～
我們是兩個農轉生信的小碩，打造生信星球，想讓它成爲一個不拽術語、通俗易懂的生信知識平臺。需要幫助或提出意見請後臺留言或發送郵件到[email protected]
