單細胞交響樂23-實戰六 CEL-seq

劉小澤寫於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數據
單細胞交響樂22-實戰五 CEL-seq2

1 前言

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

這次使用的數據是：Muraro et al. (2016) 中的不同人類供體的胰腺細胞，和上一次相比使用的是更早期的CEL-seq。整體操作和上次CEL-seq2類似

數據準備

library(scRNAseq)
sce.muraro <- MuraroPancreasData()
sce.muraro
# class: SingleCellExperiment 
# dim: 19059 3072 
# metadata(0):
#   assays(1): counts
# rownames(19059): A1BG-AS1__chr19 A1BG__chr19 ...
# ZZEF1__chr17 ZZZ3__chr1
# rowData names(2): symbol chr
# colnames(3072): D28-1_1 D28-1_2 ... D30-8_95
# D30-8_96
# colData names(3): label donor plate
# reducedDimNames(0):
#   altExpNames(1): ERCC

這次有4個供體

table(sce.muraro$donor)
# 
# D28 D29 D30 D31 
# 768 768 768 768 

不過這個基因命名很奇怪，它全部加上了染色體編號

> head(rownames(sce.muraro))
[1] "A1BG-AS1__chr19" "A1BG__chr19"     "A1CF__chr10"    
[4] "A2M-AS1__chr12"  "A2ML1__chr12"    "A2M__chr12"

ID轉換

選擇的方式是：將沒有匹配的NA去掉，並且去掉重複的行

由於基因名很奇怪，所以需要把__chr及後面的去掉

library(AnnotationHub)
edb <- AnnotationHub()[["AH73881"]]
gene.symb <- sub("__chr.*$", "", rownames(sce.muraro))
gene.ids <- mapIds(edb, keys=gene.symb, 
    keytype="SYMBOL", column="GENEID")

keep <- !is.na(gene.ids) & !duplicated(gene.ids)
# 過濾掉2000多基因
> table(keep)
keep
FALSE  TRUE 
 2119 16940 

sce.muraro <- sce.muraro[keep,]
rownames(sce.muraro) <- gene.ids[keep]

2 質控

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

unfiltered <- sce.muraro

和上一次一樣，如果只是針對ERCC和全部的批次進行質控，結果是

很明顯，這個D28個搗鬼，鑽了我們“大部分細胞都是高質量”的假設漏洞

因此，在過濾時不能考慮這個D28

library(scater)
stats <- perCellQCMetrics(sce.muraro)
qc <- quickPerCellQC(stats, percent_subsets="altexps_ERCC_percent",
    batch=sce.muraro$donor, subset=sce.muraro$donor!="D28")

看看過濾掉多少

colSums(as.matrix(qc))
# low_lib_size            low_n_features high_altexps_ERCC_percent                   discard 
# 663                       700                       738                       773 

最後把過濾條件應用在原數據

sce.muraro <- sce.muraro[,!qc$discard]

3 歸一化

繼續使用去卷積方法

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

summary(sizeFactors(sce.muraro))
# Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
# 0.08782  0.54109  0.82081  1.00000  1.21079 13.98692 

4 找高變異基因

再看一眼數據，發現其中有plate和donor信息，它們都是與批次相關的

sce.muraro
# class: SingleCellExperiment 
# dim: 16940 2299 
# metadata(0):
#   assays(2): counts logcounts
# rownames(16940): ENSG00000268895 ENSG00000121410 ...
# ENSG00000159840 ENSG00000074755
# rowData names(2): symbol chr
# colnames(2299): D28-1_1 D28-1_2 ... D30-8_93
# D30-8_94
# colData names(4): label donor plate sizeFactor
# reducedDimNames(0):
#   altExpNames(1): ERCC

table(sce.muraro$donor)
# 
# D28 D29 D30 D31 
# 333 601 676 689 
table(sce.muraro$plate)
# 
# 1   2   3   4   5   6   7   8 
# 281 292 292 295 282 285 283 289 

因此就把這二者結合作爲批次信息，依然是使用針對ERCC的構建模型方法

block <- paste0(sce.muraro$plate, "_", sce.muraro$donor)
dec.muraro <- modelGeneVarWithSpikes(sce.muraro, "ERCC", block=block)
top.muraro <- getTopHVGs(dec.muraro, prop=0.1)

5 矯正批次效應

library(batchelor)
set.seed(1001010)
merged.muraro <- fastMNN(sce.muraro, subset.row=top.muraro, 
    batch=sce.muraro$donor)

metadata(merged.muraro)$merge.info$lost.var
##           D28      D29      D30     D31
## [1,] 0.060847 0.024121 0.000000 0.00000
## [2,] 0.002646 0.003018 0.062421 0.00000
## [3,] 0.003449 0.002641 0.002598 0.08162

6 降維+聚類

降維

set.seed(100111)
merged.muraro <- runTSNE(merged.muraro, dimred="corrected")

聚類

snn.gr <- buildSNNGraph(merged.muraro, use.dimred="corrected")
colLabels(merged.muraro) <- factor(igraph::cluster_walktrap(snn.gr)$membership)

如果想看一下這裏的分羣和之前的批次之間的關係：

Tip：如果感覺批次或分羣數量太多，看着效果不好，可以用熱圖的形式展示：

tab <- table(Cluster=colLabels(merged.muraro), CellType=sce.muraro$label)
library(pheatmap)
pheatmap(log10(tab+10), color=viridis::viridis(100))

最後檢查一下供體的批次效應

gridExtra::grid.arrange(
    plotTSNE(merged.muraro, colour_by="label"),
    plotTSNE(merged.muraro, colour_by="batch"),
    ncol=2
)

---

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