單細胞交響樂28-實戰十一 Smart-seq2-小鼠造血幹細胞

劉小澤寫於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-實戰九 胰腺細胞數據整合
單細胞交響樂27-實戰十 CEL-seq-小鼠造血幹細胞

1 前言

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

數據來自 (Nestorowa et al. 2016) 的小鼠造血幹細胞 haematopoietic stem cell (HSC) ,使用的技術是Smart-seq2

準備數據

library(scRNAseq)
sce.nest <- NestorowaHSCData()

sce.nest
# class: SingleCellExperiment 
# dim: 46078 1920 
# metadata(0):
#   assays(1): counts
# rownames(46078): ENSMUSG00000000001
# ENSMUSG00000000003 ... ENSMUSG00000107391
# ENSMUSG00000107392
# rowData names(0):
#   colnames(1920): HSPC_007 HSPC_013 ... Prog_852
# Prog_810
# colData names(2): cell.type FACS
# reducedDimNames(1): diffusion
# altExpNames(1): ERCC

counts(sce.nest)[1:3,1:3]
# 3 x 3 sparse Matrix of class "dgCMatrix"
# HSPC_007 HSPC_013 HSPC_019
# ENSMUSG00000000001        .        7        1
# ENSMUSG00000000003        .        .        .
# ENSMUSG00000000028        4        1        2

看到使用了ERCC、Ensembl ID

ID轉換
library(AnnotationHub)
ens.mm.v97 <- AnnotationHub()[["AH73905"]]
anno <- select(ens.mm.v97, keys=rownames(sce.nest), 
    keytype="GENEID", columns=c("SYMBOL", "SEQNAME"))
# 這裏全部對應
> sum(is.na(anno$SYMBOL))
[1] 0
> sum(is.na(anno$SEQNAME))
[1] 0
# 接下來只需要匹配順序即可
rowData(sce.nest) <- anno[match(rownames(sce.nest), anno$GENEID),]

sce.nest
# class: SingleCellExperiment 
# dim: 46078 1920 
# metadata(0):
#   assays(1): counts
# rownames(46078): ENSMUSG00000000001
# ENSMUSG00000000003 ... ENSMUSG00000107391
# ENSMUSG00000107392
# rowData names(3): GENEID SYMBOL SEQNAME
# colnames(1920): HSPC_007 HSPC_013 ... Prog_852
# Prog_810
# colData names(2): cell.type FACS
# reducedDimNames(1): diffusion
# altExpNames(1): ERCC

2 質控

依然是備份一下,把unfiltered數據主要用在質控的探索上
unfiltered <- sce.nest

這裏沒有線粒體基因,因此只能用ERCC計算過濾條件

library(scater)
stats <- perCellQCMetrics(sce.nest)
qc <- quickPerCellQC(stats, percent_subsets="altexps_ERCC_percent")
sce.nest <- sce.nest[,!qc$discard]

# 看下過濾的細胞
colSums(as.matrix(qc))
# low_lib_size            low_n_features 
# 146                        28 
# high_altexps_ERCC_percent                   discard 
# 241                       264 

做個圖

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

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="altexps_ERCC_percent",
        colour_by="discard") + ggtitle("ERCC percent"),
    ncol=2
)
最後對數據進行過濾
sce.nest <- sce.nest[,!qc$discard]

# 過濾前後
> dim(unfiltered);dim(sce.nest)
[1] 46078  1920
[1] 46078  1656

3 歸一化

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

4 找高變異基因

使用基於ERCC的構建模型方法

set.seed(00010101)
dec.nest <- modelGeneVarWithSpikes(sce.nest, "ERCC")
top.nest <- getTopHVGs(dec.nest, prop=0.1)

class(dec.nest)
# [1] "DFrame"
# attr(,"package")
# [1] "S4Vectors"

# 其中ERCC的信息就存儲在dec.nest的metadata中
curfit <- metadata(dec.nest)
class(curfit)
# [1] "list"
names(curfit)
# [1] "mean"    "var"     "trend"   "std.dev"
length(unique(names(curfit$mean))) # 一共92個ERCC spike-in
# [1] 92 

# 其中的mean、var就定義了橫縱座標
head(curfit$mean)
# ERCC-00002  ERCC-00003  ERCC-00004  ERCC-00009  ERCC-00012  ERCC-00013 
# 14.91183375 11.27060119 13.31197197 11.94866319  0.02211546  0.21249156 
head(curfit$var)
# ERCC-00002 ERCC-00003 ERCC-00004 ERCC-00009 ERCC-00012 ERCC-00013 
# 0.02375131 0.29308411 0.05376959 0.41814635 0.14928826 1.08599155 
然後把基因(黑點)、ERCC(紅點)、根據ERCC擬合的線(藍線)畫出來
plot(dec.nest$mean, dec.nest$total, pch=16, cex=0.5,
    xlab="Mean of log-expression", ylab="Variance of log-expression")
curve(curfit$trend(x), col='dodgerblue', add=TRUE, lwd=2)
points(curfit$mean, curfit$var, col="red")

5 降維聚類

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

# 檢查PC的數量
ncol(reducedDim(sce.nest, "PCA"))
## [1] 9
聚類
snn.gr <- buildSNNGraph(sce.nest, use.dimred="PCA")
colLabels(sce.nest) <- factor(igraph::cluster_walktrap(snn.gr)$membership)

table(colLabels(sce.nest))
## 
##   1   2   3   4   5   6   7   8   9 
## 203 472 258 175 142 229  20  83  74

作圖看看

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

6 marker基因檢測

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

比如檢測一下cluster8:

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

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

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

看到其中血紅蛋白相關基因(Hba1、Hba2、Hbb)、Car2、Hebp1基因上調,說明clsuter8可能包含紅細胞前體細胞

7 細胞類型註釋

將會使用內置的參考註釋數據,SingleR中就包含了一些內置數據集,大部分是bulk RNA-Seq或芯片數據中經過篩選的細胞類型。

準備參考數據
library(SingleR)
mm.ref <- MouseRNAseqData()
mm.ref
# class: SummarizedExperiment 
# dim: 21214 358 
# metadata(0):
#   assays(1): logcounts
# rownames(21214): Xkr4 Rp1 ... LOC100039574
# LOC100039753
# rowData names(0):
#   colnames(358): ERR525589Aligned
# ERR525592Aligned ... SRR1044043Aligned
# SRR1044044Aligned
# colData names(3): label.main label.fine
# label.ont
進行轉換
renamed <- sce.nest
# 參考數據集中使用的是symbol name,這裏也轉換一下
rownames(renamed) <- uniquifyFeatureNames(rownames(renamed),
                                          rowData(sce.nest)$SYMBOL)
# 然後把我們的細胞在參考數據集中找對應的細胞類型
# 返回的pred結果是一個數據框,每行是我們自己數據的一個細胞
pred <- SingleR(test=renamed, ref=mm.ref, labels=mm.ref$label.fine)
table(pred$labels)
# 
# B cells Endothelial cells      Erythrocytes      Granulocytes       Macrophages         Monocytes          NK cells           T cells 
# 61                 1              1005                 1                 2               500                 1                85 

這裏也看到cluster8與紅細胞更相近


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

發表評論
所有評論
還沒有人評論,想成為第一個評論的人麼? 請在上方評論欄輸入並且點擊發布.
相關文章