單細胞交響樂26-實戰九 胰腺細胞數據整合

劉小澤寫於2020.7.21
爲何取名叫“交響樂”？因爲單細胞分析就像一個大樂團，需要各個流程的協同配合
單細胞交響樂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
單細胞交響樂23-實戰六 CEL-seq
單細胞交響樂24-實戰七 SMARTer 胰腺細胞
單細胞交響樂25-實戰八 Smart-seq2 胰腺細胞

1 前言

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

2016年很多研究都對人類胰腺細胞的scRNA很感興趣，也因此發表了很多文章：(Muraro et al. 2016; Grun et al. 2016; Lawlor et al. 2017; Segerstolpe et al. 2016)。這些不同作者不同技術手段得到的數據，也給數據整合帶來了不小的挑戰。相比於之前的PBMC數據整合，這裏更爲複雜，因爲包含的建庫、測序方法多樣，供體的類型、數量更是不一致。

2 簡單一點的試驗

首先拿技術相似的兩套數據來做：分別是Muraro et al. (2016) and Grun et al. (2016)，採用了CEL-seq 和 CEL-seq2

sce.grun數據鏈接：https://share.weiyun.com/iO5BCEc9
sce.muraro數據鏈接：https://share.weiyun.com/gvnArtAf

load('final.sce.grun.Rdata')
load('final.sce.muraro.RData')
final.sce.grun
# class: SingleCellExperiment 
# dim: 17548 1063 
# metadata(0):
#   assays(2): counts logcounts
# rownames(17548): ENSG00000268895 ENSG00000121410 ...
# ENSG00000074755 ENSG00000036549
# rowData names(2): symbol chr
# colnames(1063): D2ex_1 D2ex_2 ... D17TGFB_94
# D17TGFB_95
# colData names(3): donor sample sizeFactor
# reducedDimNames(0):
#   altExpNames(1): ERCC

final.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

2.1 取兩個數據的交集子集

首先獲得交集基因

universe <- intersect(rownames(final.sce.grun), rownames(final.sce.muraro))

> nrow(final.sce.grun);nrow(final.sce.muraro);length(universe)
[1] 17548
[1] 16940
[1] 15974

對數據集取子集

sce.grun2 <- final.sce.grun[universe,]
sce.muraro2 <- final.sce.muraro[universe,]

既然是經過處理後的數據，那麼就略過了之前介紹的質控步驟

2.2 數據整合後的歸一化

首先測序深度導致的文庫大小差異是批次效應的一個重要來源，因此可以先對不同的批次進行文庫矯正。會以文庫最小的批次爲基準，對其他批次進行文庫歸一化。最後返回一個列表

使用一個歸一化函數：multiBatchNorm ，它應用的就是最簡單的library size normalization歸一化方法
Perform scaling normalization within each batch to provide comparable results to the lowest-coverage batch.

既然是要處理文庫差異，那就先看看各自原本的文庫大小

summary(colSums(logcounts(sce.muraro2)))
# Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
# 4433    8041    8680    8558    9193   10594 
summary(colSums(logcounts(sce.grun2)))
# Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
# 2347    4141    4565    4538    4969    5992 

然後進行處理，可以看看前後的變化，就明白了這個函數做了什麼事情

library(batchelor)
normed.pancreas <- multiBatchNorm(sce.grun2, sce.muraro2)
sce.grun3 <- normed.pancreas[[1]]
sce.muraro3 <- normed.pancreas[[2]]

summary(colSums(logcounts(sce.muraro3)))
# Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
# 3072    4735    4994    4954    5204    5864 
summary(colSums(logcounts(sce.grun3)))
# Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
# 2347    4141    4565    4538    4969    5992

看到混合以後的sce.muraro3相對於之前獨立的sce.muraro2的變化了吧

2.3 數據整合後找高變異基因

首先對錶達量變化模型取子集

## 原來的sce.grun模型
library(scran)
block1 <- paste0(final.sce.grun$sample, "_", final.sce.grun$donor)
dec.grun <- modelGeneVarWithSpikes(final.sce.grun, spikes="ERCC", block=block1)
# 取子集
dec.grun2 <- dec.grun[universe,]

## 原來的sce.muraro模型
block2 <- paste0(final.sce.muraro$plate, "_", final.sce.muraro$donor)
dec.muraro <- modelGeneVarWithSpikes(final.sce.muraro, "ERCC", block=block2)
# 取子集
dec.muraro2 <- dec.muraro[universe,]

之後組合兩組的結果

使用combineVar ，它的作用是：

Combine the results of multiple variance decompositions, usually generated for the same genes across separate batches of cells.

library(scran)
combined.pan <- combineVar(dec.grun2, dec.muraro2)
# 把更有可能代表生物差異的基因選出來，用於下游的PCA和聚類
chosen.genes <- rownames(combined.pan)[combined.pan$bio > 0]

2.4 矯正批次效應

之前在：單細胞交響樂10-數據集整合後的批次矯正中介紹過：

bulk mRNA轉錄組中常用的矯正批次效應方法就是線性迴歸，對每個基因表達量擬合一個線性模型。例如limma的removeBatchEffect() (Ritchie et al. 2015) 、sva的comBat() (Leek et al. 2012)。如果要使用這類方法，就需要假設：批次間的細胞組成相同。另外的一個假設是：批次效應的累積的，對於任何給定的基因，在不同亞羣中經過任何因素誘導的表達變化倍數是相同的。（其實，從這兩個假設就看出來，這個線性迴歸方法不適合我們的單細胞數據，但還是要繼續瞭解下去）

先來看看基於線性迴歸的rescaleBatches()

它也是對每個基因的log表達量進行了線性迴歸，並提高了一些運行性能。另外與removeBatchEffect()不同的是，rescaleBatches()保持了數據的稀疏性，而removeBatchEffect()會破壞稀疏性

library(scater)
rescaled.pancreas <- rescaleBatches(sce.grun2, sce.muraro2)

set.seed(100101)
rescaled.pancreas <- runPCA(rescaled.pancreas, subset_row=chosen.genes,
    exprs_values="corrected")

rescaled.pancreas <- runTSNE(rescaled.pancreas, dimred="PCA")
plotTSNE(rescaled.pancreas, colour_by="batch")

不過結果並不盡如人意，兩個批次還是分得很開，表明處理有效果但不徹底 。影響效果的原因是：我們的數據違背了這個方法的假設

再來使用fastMNN()

與線性迴歸方法相比，MNN方法不會假設細胞羣組成相同或者事先已知。MNN會自己學習細胞羣的結構並進行估計.

可能之前聽過：mnnCorrect()這個方法，它是Haghverdi et al. (2018) 提出來的，之前也介紹過：單細胞轉錄組數據校正批次效應實戰

它和fastMNN()原理類似，但速度會慢很多，總之它們的不同可以概括爲：

For scRNA-seq data, fastMNN() tends to be both faster and better at achieving a satisfactory merge. mnnCorrect() is mainly provided here for posterity’s sake, though it is more robust than fastMNN() to certain violations of the orthogonality assumptions.

set.seed(1011011)
mnn.pancreas <- fastMNN(sce.grun2, sce.muraro2, subset.row=chosen.genes)

snn.gr <- buildSNNGraph(mnn.pancreas, use.dimred="corrected")
clusters <- igraph::cluster_walktrap(snn.gr)$membership
tab <- table(Cluster=clusters, Batch=mnn.pancreas$batch)
tab
##        Batch
## Cluster   1   2
##      1  239 281
##      2  312 257
##      3  200 837
##      4   56 193
##      5   37   1
##      6   24 108
##      7  109 391
##      8   63  80
##      9   18 115
##      10   0  17
##      11   5  19

再做個圖

mnn.pancreas <- runTSNE(mnn.pancreas, dimred="corrected")
plotTSNE(mnn.pancreas, colour_by="batch")

效果有明顯改進

3 更具挑戰性的操作

前面是將一個CEL-seq和一個CEL-seq2數據整合，總的說來還不是很複雜

但這裏，會再加上兩個數據，分別來自Lawlor et al. (2017) 和 Segerstolpe et al. (2016)的數據進行整合，這樣四個數據就會包括不同的技術、不同的UMI、不同的表達量、更加不同的供體

sce.lawlor數據鏈接：https://share.weiyun.com/mic3m90k
sce.seger數據鏈接：https://share.weiyun.com/7w2vBGdC

rm(list = ls())
load('final.sce.grun.RData')
load('final.sce.muraro.RData')
load('final.sce.lawlor.RData')
load('final.sce.seger.RData')
sce.grun=final.sce.grun
sce.muraro=final.sce.muraro

sce.grun
# class: SingleCellExperiment 
# dim: 17548 1063 
# metadata(0):
#   assays(2): counts logcounts
# rownames(17548): ENSG00000268895 ENSG00000121410 ...
# ENSG00000074755 ENSG00000036549
# rowData names(2): symbol chr
# colnames(1063): D2ex_1 D2ex_2 ... D17TGFB_94
# D17TGFB_95
# colData names(3): donor sample sizeFactor
# reducedDimNames(0):
#   altExpNames(1): ERCC

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

sce.lawlor
# class: SingleCellExperiment 
# dim: 26616 604 
# metadata(0):
#   assays(2): counts logcounts
# rownames(26616): ENSG00000229483 ENSG00000232849 ...
# ENSG00000251576 ENSG00000082898
# rowData names(2): SYMBOL SEQNAME
# colnames(604): 10th_C11_S96 10th_C13_S61 ...
# 9th-C96_S81 9th-C9_S13
# colData names(9): title age ... Sex sizeFactor
# reducedDimNames(0):
#   altExpNames(0):

sce.seger
# class: SingleCellExperiment 
# dim: 25454 2090 
# metadata(0):
#   assays(2): counts logcounts
# rownames(25454): ENSG00000118473 ENSG00000142920 ...
# ENSG00000278306 eGFP
# rowData names(2): symbol refseq
# colnames(2090): HP1502401_H13 HP1502401_J14 ...
# HP1526901T2D_N8 HP1526901T2D_A8
# colData names(4): CellType Donor Quality sizeFactor
# reducedDimNames(0):
#   altExpNames(1): ERCC

3.1 取四個數據的子集

首先獲得交集基因

all.sce <- list(Grun=sce.grun, Muraro=sce.muraro, 
    Lawlor=sce.lawlor, Seger=sce.seger)
universe <- Reduce(intersect, lapply(all.sce, rownames))

nrow(sce.grun);nrow(sce.muraro);nrow(sce.lawlor);nrow(sce.seger);length(universe)
# [1] 17548
# [1] 16940
# [1] 26616
# [1] 25454
# [1] 15231 #共有基因

再分別取子集

all.sce <- lapply(all.sce, "[", i=universe,)

3.2 數據整合後的歸一化

normed.pancreas <- do.call(multiBatchNorm, all.sce)

3.3 數據整合後找高變異基因

首先獲得各個數據集的表達量變化模型

library(scran)
# sce.grun
block1 <- paste0(sce.grun$sample, "_", sce.grun$donor)
dec.grun <- modelGeneVarWithSpikes(sce.grun, spikes="ERCC", block=block1)

# sce.muraro
block2 <- paste0(sce.muraro$sample, "_", sce.muraro$donor)
dec.muraro <- modelGeneVarWithSpikes(sce.muraro, spikes="ERCC", block=block2)

# sce.lawlor：沒有ERCC信息，就用modelGeneVar()
dec.lawlor <- modelGeneVar(sce.lawlor, block=sce.lawlor$`islet unos id`)

# sce.seger
for.hvg <- sce.seger[,librarySizeFactors(altExp(sce.seger)) > 0
                     & sce.seger$Donor!="AZ"]
dec.seger <- modelGeneVarWithSpikes(for.hvg, "ERCC", block=for.hvg$Donor)

# 整合起來
all.dec <- list(Grun=dec.grun, Muraro=dec.muraro, 
                Lawlor=dec.lawlor, Seger=dec.seger)

再取子集

all.dec <- lapply(all.dec, "[", i=universe,)

再組合四組的結果

combined.pan <- do.call(combineVar, all.dec)
# 把更有可能代表生物差異的基因選出來，用於下游的PCA和聚類
chosen.genes <- rownames(combined.pan)[combined.pan$bio > 0]

3.4 矯正批次效應

fastMNN也包含了PCA的操作

set.seed(1011110)
mnn.pancreas <- fastMNN(normed.pancreas)

3.5 聚類

snn.gr <- buildSNNGraph(mnn.pancreas, use.dimred="corrected", k=20)
clusters <- igraph::cluster_walktrap(snn.gr)$membership
clusters <- factor(clusters)
tab <- table(Cluster=clusters, Batch=mnn.pancreas$batch)

tab
##        Batch
## Cluster Grun Lawlor Muraro Seger
##      1    77     33    677   211
##      2   311     26    254   383
##      3   104    244    390   180
##      4   225     16    246   138
##      5   125    203    158   108
##      6    56     17    196   109
##      7     0      0      0    43
##      8     0      0      0    42
##      9     0      2     17     4
##      10   69     12     82    16
##      11   24     19    108    55
##      12    0      0      0    50
##      13   27      0      1     0
##      14   22      6     34    49
##      15   18     18    117   157
##      16    0      0      0   208
##      17    0      0      0    26
##      18    0      0      0   108
##      19    0      0      0   186
##      20    5      8     19    17

看到一個批次中都包含了很多clusters，說明數據整合的效果還不錯，批次效應沒有很強；當然有些clusters只顯示在了seger批次中（比如7、8、12、16、17、18、19），那究竟這些clusters到底是不是seger數據特有的細胞類型呢？這個還有待考證

作圖

注意其中使用到了一個很有趣的函數I() ，簡單的一個字母，它是base包裏的函數

因爲我們是根據mnn.pancreas進行作圖的，但clusters這個向量是根據mnn.pancreas創建的，但又不直接存在於mnn.pancreas（不像batch一樣存在於mnn.pancreas中）。

因此要從外部把它導入到作圖函數中，就可以用這個I()

mnn.pancreas <- runTSNE(mnn.pancreas, dimred="corrected")
gridExtra::grid.arrange(
    plotTSNE(mnn.pancreas, colour_by="batch", text_by=I(clusters)),
    plotTSNE(mnn.pancreas, colour_by=I(clusters), text_by=I(clusters)),
    ncol=2
)

上面我們粗略根據四個數據集看了下批次效應，發現Seger這個數據還有點特殊，因爲很多clusters只存在於Seger中

批次效應的來源除了表面上的4個數據集整合，還有一個重點考慮對象是：供體的種類

3.6 對批次效應的檢查

看一下來自各個數據中供體的批次效應

首先檢查一下各個數據的供體信息，看到Seger最多，因此它的風險也最大。但這個懷疑到底對不對，還要做個圖看看

seger.donors <- donors
seger.donors[mnn.pancreas$batch!="Seger"] <- NA

grun.donors <- donors
grun.donors[mnn.pancreas$batch!="Grun"] <- NA

lawlor.donors <- donors
lawlor.donors[mnn.pancreas$batch!="Lawlor"] <- NA

muraro.donors <- donors
muraro.donors[mnn.pancreas$batch!="Muraro"] <- NA

gridExtra::grid.arrange(
  plotTSNE(mnn.pancreas, colour_by=I(muraro.donors))+ ggtitle('muraro.donors'),
  plotTSNE(mnn.pancreas, colour_by=I(lawlor.donors))+ ggtitle('lawlor.donors'),
  plotTSNE(mnn.pancreas, colour_by=I(grun.donors))+ ggtitle('grun.donors'),
  plotTSNE(mnn.pancreas, colour_by=I(seger.donors))+ ggtitle('seger.donors'),
  ncol=2
)

看到圖中Seger的供體各個細胞最爲分散，因此它的供體批次效應是最強的

雖說供體也是生物信息，但它對於後續的細胞類型註釋沒有直接的幫助，相反還會產生混淆的作用（比如前面看到很多clusters只存在於Seger中，說不定就是由於Seger的供體批次效應導致的）

因此，一個更爲謹慎的操作是：除了去除數據集之間的批次效應以外，還要將每個數據內部的供體信息作爲另一個批次效應，分別處理掉

3.7 進行一次更嚴格的批次矯正

將原來的4個分開的數據聚合在一起，使用noCorrect 進行簡單的聚合

它的含義是：This function is effectively equivalent to cbinding the matrices together without any correction.

combined <- noCorrect(normed.pancreas)
assayNames(combined) <- "logcounts"
combined$donor <- donors

對這個數據進行批次矯正，但首先要把數據批次和供體批次分開

donors.per.batch <- split(combined$donor, combined$batch)

# 獲得每個數據批次下的供體批次
donors.per.batch <- lapply(donors.per.batch, unique)
donors.per.batch
## $Grun
## [1] "D2"  "D3"  "D7"  "D10" "D17"
## 
## $Lawlor
## [1] "ACIW009"  "ACJV399"  "ACCG268"  "ACCR015A" "ACEK420A" "ACEL337"  "ACHY057" 
## [8] "ACIB065" 
## 
## $Muraro
## [1] "D28" "D29" "D31" "D30"
## 
## $Seger
##  [1] "HP1502401"    "HP1504101T2D" "AZ"           "HP1508501T2D" "HP1506401"   
##  [6] "HP1507101"    "HP1509101"    "HP1504901"    "HP1525301T2D" "HP1526901T2D"

依然是使用fastMNN

set.seed(1010100)
# batch信息使用全部的供體
# 增加一步指定weights：可以理解爲哪些供體屬於哪個數據集
multiout <- fastMNN(combined, batch=combined$donor, 
    subset.row=chosen.genes, weights=donors.per.batch)

# 將兩大批次信息記錄在新的矯正結果multiout中
multiout$dataset <- combined$batch
multiout$donor <- multiout$batch

檢查一下聚類結果

從下面的結果中可以看到單獨屬於Seger的cluster沒有了

library(scater)
g <- buildSNNGraph(multiout, use.dimred=1, k=20)
clusters <- igraph::cluster_walktrap(g)$membership
tab <- table(clusters, multiout$dataset)
tab
##         
## clusters Grun Lawlor Muraro Seger
##       1   246     20    278   187
##       2   200    239    835   862
##       3   171    254    473   294
##       4   315     27    260   387
##       5    57     17    193   108
##       6    24     18    107    55
##       7    26      0      0     0
##       8     5      9     19    17
##       9    19     19    118   176
##       10    0      1     16     4

作圖結果也發現數據混合更理想了

multiout <- runTSNE(multiout, dimred="corrected")
gridExtra::grid.arrange(
    plotTSNE(multiout, colour_by="dataset", text_by=I(clusters)),
    plotTSNE(multiout, colour_by=I(seger.donors)),
    ncol=2
)

最後，和已發表的細胞類型做對比

由於這些數據都已發表，數據集中也包含了最後作者註釋的細胞類型（sce.grun除外）

因此，可以將我們自己整合後又矯正的分羣，與發表的細胞分羣對比，來說明批次處理質量

# 獲得已發表的細胞類型信息
proposed <- c(rep(NA, ncol(sce.grun)), 
    sce.muraro$label,
    sce.lawlor$`cell type`,
    sce.seger$CellType)

看到其中大小寫參差不齊，可以全變成小寫

proposed <- tolower(proposed)
# 並根據原文章修改一下細胞類型名稱
proposed[proposed=="gamma/pp"] <- "gamma"
proposed[proposed=="pp"] <- "gamma"
proposed[proposed=="duct"] <- "ductal"
proposed[proposed=="psc"] <- "stellate"

最後檢查一下

table(proposed, clusters)

看到，我們處理完批次效應後的分羣結果可以比較好的匹配到真實的細胞類型，因此說明了這裏使用的批次矯正的方法的力度剛剛好

---

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