單細胞交響樂27-實戰十 CEL-seq-小鼠造血幹細胞

劉小澤寫於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 胰腺細胞
單細胞交響樂26-實戰九 胰腺細胞數據整合

1 前言

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

數據來自Grun et al. 2016的小鼠造血幹細胞 haematopoietic stem cell (HSC) ，使用的技術是CEL-seq

數據準備

library(scRNAseq)
sce.grun.hsc <- GrunHSCData(ensembl=TRUE)
sce.grun.hsc
# class: SingleCellExperiment 
# dim: 21817 1915 
# metadata(0):
#   assays(1): counts
# rownames(21817): ENSMUSG00000109644
# ENSMUSG00000007777 ... ENSMUSG00000055670
# ENSMUSG00000039068
# rowData names(3): symbol chr originalName
# colnames(1915): JC4_349_HSC_FE_S13_
# JC4_350_HSC_FE_S13_ ...
# JC48P6_1203_HSC_FE_S8_
# JC48P6_1204_HSC_FE_S8_
# colData names(2): sample protocol
# reducedDimNames(0):
#   altExpNames(0):

table(sce.grun.hsc$sample)
# 
# JC20   JC21   JC26   JC27   JC28   JC30   JC32 
# 87     96     85     91     80     96     93 
# JC35   JC36   JC37   JC39    JC4   JC40   JC41 
# 96     80     87     93     84     96     94 
# JC43   JC44   JC45   JC46 JC48P4 JC48P6 JC48P7 
# 92     94     90     96     95     96     94 

ID轉換

library(AnnotationHub)
ens.mm.v97 <- AnnotationHub()[["AH73905"]]
anno <- select(ens.mm.v97, keys=rownames(sce.grun.hsc), 
               keytype="GENEID", columns=c("SYMBOL", "SEQNAME"))

# 這裏全部對應
> sum(is.na(anno$SYMBOL))
[1] 0
> sum(is.na(anno$SEQNAME))
[1] 0

# 接下來只需要匹配順序即可
rowData(sce.grun.hsc) <- anno[match(rownames(sce.grun.hsc), anno$GENEID),]

sce.grun.hsc
## class: SingleCellExperiment 
## dim: 21817 1915 
## metadata(0):
## assays(1): counts
## rownames(21817): ENSMUSG00000109644 ENSMUSG00000007777 ...
##   ENSMUSG00000055670 ENSMUSG00000039068
## rowData names(3): GENEID SYMBOL SEQNAME
## colnames(1915): JC4_349_HSC_FE_S13_ JC4_350_HSC_FE_S13_ ...
##   JC48P6_1203_HSC_FE_S8_ JC48P6_1204_HSC_FE_S8_
## colData names(2): sample protocol
## reducedDimNames(0):
## altExpNames(0):

2 質控

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

unfiltered <- sce.grun.hsc

發現這個數據既沒有MT也沒有ERCC

grep('MT',rowData(sce.grun.hsc)$SEQNAME)
# integer(0)

能用的數據只有其中的protocol了，它表示細胞提取方法

table(sce.grun.hsc$protocol)
# 
# micro-dissected cells 
# 1546 
# sorted hematopoietic stem cells 
# 369 

# 再看一下各個樣本與提取方法的對應關係
table(sce.grun.hsc$protocol,sce.grun.hsc$sample)

根據背景知識，大部分顯微操作（micro-dissected）得到的細胞很多質量都較低，和我們的質控假設相違背，於是這裏就不把它們納入過濾條件

library(scater)
stats <- perCellQCMetrics(sce.grun.hsc)
# 只用sorted hematopoietic stem cells 計算過濾條件
qc <- quickPerCellQC(stats, batch=sce.grun.hsc$protocol,
    subset=grepl("sorted", sce.grun.hsc$protocol))

colSums(as.matrix(qc))
##   low_lib_size low_n_features        discard 
##            465            482            488

sce.grun.hsc <- sce.grun.hsc[,!qc$discard]

做個圖看看

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

gridExtra::grid.arrange(
    plotColData(unfiltered, y="sum", x="sample", colour_by="discard", 
        other_fields="protocol") + scale_y_log10() + ggtitle("Total count") +
        facet_wrap(~protocol),
    plotColData(unfiltered, y="detected", x="sample", colour_by="discard",
        other_fields="protocol") + scale_y_log10() + 
        ggtitle("Detected features") + facet_wrap(~protocol),
    ncol=1
)

可以看到，大多數的顯微操作技術得到的細胞文庫都比較小，相比於細胞分選方法，它在提取過程中對細胞損傷較大

3 歸一化

使用去卷積方法

library(scran)
set.seed(101000110)
clusters <- quickCluster(sce.grun.hsc)
sce.grun.hsc <- computeSumFactors(sce.grun.hsc, clusters=clusters)
sce.grun.hsc <- logNormCounts(sce.grun.hsc)

4 找高變異基因

這裏沒有指定任何的批次，因爲想保留這兩種技術產生的任何差異

set.seed(00010101)
dec.grun.hsc <- modelGeneVarByPoisson(sce.grun.hsc) 
top.grun.hsc <- getTopHVGs(dec.grun.hsc, prop=0.1)

做個圖

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

看到這個線有點“太平緩”，和之前見過的都不一樣，感覺“中間少了一個峯”。這是因爲細胞中的基因表達量都比較低，差別也不大【大家一起貧窮，於是貧富差距很小】，所以在縱座標（衡量變化的方差）上體現不出來差距，也就導致了擬合的曲線不會有“峯”

可能會想，那爲什麼不是大家表達量都很高呢（大家都很富有，貧富差距不是也很小嗎）？因爲橫座標可以看到，從0-3.5，這個範圍對於表達量來說確實很小，之前做的圖有的都大於10、15

5 降維聚類

降維就採取最基礎的方式：

set.seed(101010011)
sce.grun.hsc <- denoisePCA(sce.grun.hsc, technical=dec.grun.hsc, subset.row=top.grun.hsc)
sce.grun.hsc <- runTSNE(sce.grun.hsc, dimred="PCA")

# 檢查PC的數量
ncol(reducedDim(sce.grun.hsc, "PCA"))
## [1] 9

聚類

snn.gr <- buildSNNGraph(sce.grun.hsc, use.dimred="PCA")
colLabels(sce.grun.hsc) <- factor(igraph::cluster_walktrap(snn.gr)$membership)

table(colLabels(sce.grun.hsc))
## 
##   1   2   3   4   5   6   7   8   9  10  11  12 
## 259 148 221 103 177 108  48 122  98  63  62  18

作圖

short <- ifelse(grepl("micro", sce.grun.hsc$protocol), "micro", "sorted")
gridExtra:::grid.arrange(
    plotTSNE(sce.grun.hsc, colour_by="label"),
    plotTSNE(sce.grun.hsc, colour_by=I(short)),
    ncol=2
)

由於沒有去除兩個技術批次的差異，所以這裏分的很開

6 找marker基因

markers <- findMarkers(sce.grun.hsc, test.type="wilcox", direction="up",
    row.data=rowData(sce.grun.hsc)[,"SYMBOL",drop=FALSE])

檢查一下cluster6的marker基因

chosen <- markers[['6']]
best <- chosen[chosen$Top <= 10,]
length(best)
# [1] 16

# 將cluster6與其他clusters對比的AUC結果提取出來
aucs <- getMarkerEffects(best, prefix="AUC")
rownames(aucs) <- best$SYMBOL

library(pheatmap)
pheatmap(aucs, color=viridis::plasma(100))

看到溶菌酶相關基因（LYZ家族）、Camp、 Lcn2、 Ltf 都上調，表明cluster6可能是神經元起源細胞

---

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