1 簡介
1.1 scRNA-seq
- 2009年由湯富酬等人首次公開
- 測量每個基因在細胞群中表達水平的分布
- 允許研究在轉錄組中特定于細胞的變化的非常重要的生物學問題，例如細胞類型識別，細胞反應的異質性，基因表達的隨機性，細胞內基因調控網絡的推斷
- bulk和單細胞RNA-seq之間的主要區別在于，每個測序文庫代表單個細胞，而不是細胞群體。因此，必須特別注意比較不同細胞（測序文庫）的結果。
- 目前單細胞測序主要由于轉錄物的起始量較低，在擴增（1 million fold）的時候會產生許多問題。目前，提高轉錄物捕獲效率和降低擴增偏差是研究的活躍領域。可以通過適當的歸一化緩解其中的一些問題。
1.2 scRNA-seq的技術
- CEL-seq (Hashimshony et al. 2012)
- CEL-seq2 (Hashimshony et al. 2016)
- Drop-seq (Macosko et al. 2015)
- InDrop-seq (Klein et al. 2015)
- MARS-seq (Jaitin et al. 2014)
- SCRB-seq (Soumillon et al. 2014)
- Seq-well (Gierahn et al. 2017)
- Smart-seq (Picelli et al. 2014)
- Smart-seq2 (Picelli et al. 2014)
- SMARTer
- STRT-seq (Islam et al. 2013)
2 分析流程
2.1 讀入數據
本次使用的數據集（Lun et al.2017 ）該數據集包含兩塊416B細胞板（永生的小鼠骨髓祖細胞系），使用Smart-seq2進行處理（Picelli et al，2014）。在制備文庫之前，還將spike-in RNA添加到每個細胞的裂解物中。進行高通量測序，并通過計數映射到其外顯子區域的讀數總數來量化每個基因的表達。類似地，通過計數映射到刺入參考序列的讀數的數目來測量每個刺入轉錄本的量。
首先使用BiocFileCache包下載兩個416B細胞板的數據，并將其保存在指定路徑中，隨后使用read.delim讀取并使用SingleCellExperiment轉化為單細胞分析中的對象，它可以儲存各種信息，包括表達矩陣，基因注釋信息，樣本分組信息，文庫信息和降維信息等絕大部分信息，極大地簡化了我們分析時的操作。
library(BiocFileCache)
bfc <- BiocFileCache("raw_data", ask = FALSE)
lun.zip <- bfcrpath(bfc,
file.path("https://www.ebi.ac.uk/arrayexpress/files",
"E-MTAB-5522/E-MTAB-5522.processed.1.zip"))
lun.sdrf <- bfcrpath(bfc,
file.path("https://www.ebi.ac.uk/arrayexpress/files",
"E-MTAB-5522/E-MTAB-5522.sdrf.txt"))
unzip(lun.zip, exdir='E:/simpleSingcell/simpleSingcell')
plate1 <- read.delim(file.path('E:/simpleSingcell/simpleSingcell', "counts_Calero_20160113.tsv"),
header=TRUE, row.names=1, check.names=FALSE)
plate2 <- read.delim(file.path('E:/simpleSingcell/simpleSingcell', "counts_Calero_20160325.tsv"),
header=TRUE, row.names=1, check.names=FALSE)
gene.lengths <- plate1$Length # First column is the gene length.
plate1 <- as.matrix(plate1[,-1]) # Discarding gene length (as it is not a cell).
plate2 <- as.matrix(plate2[,-1])
rbind(Plate1=dim(plate1), Plate2=dim(plate2))
stopifnot(identical(rownames(plate1), rownames(plate2)))
all.counts <- cbind(plate1, plate2)
library(SingleCellExperiment)
sce <- SingleCellExperiment(list(counts=all.counts))
rowData(sce)$GeneLength <- gene.lengths
sce
##查看sce這個SingleCellExperiment，它是一個S4對象，我們可以使用rowData，colData，assay等命令獲取對象內的主要信息，seurat中的CreateSeuratObject也是一個S4對象，不過命令稍有不同
#class: SingleCellExperiment
#dim: 46703 192
#metadata(0):
#assays(1): counts
#rownames(46703): ENSMUSG00000102693 ENSMUSG00000064842 ... SIRV7 CBFB-MYH11-mcherry
#rowData names(1): GeneLength
#colnames(192): SLX-9555.N701_S502.C89V9ANXX.s_1.r_1 SLX-9555.N701_S503.C89V9ANXX.s_1.r_1 ...
SLX-11312.N712_S508.H5H5YBBXX.s_8.r_1 SLX-11312.N712_S517.H5H5YBBXX.s_8.r_1
#colData names(0):
#reducedDimNames(0):
#spikeNames(0):
2.2基因注釋
由于本例中存在ERCC基因，我們需要將這些基因單獨保存在對象中，以便于后續步驟提取；不僅如此，我們還需要獲取基因的ensembl id，symbol id，染色體定位等信息，儲存在rowData中，將樣本的信息保存在colData中。
#首先獲取表達矩陣中的ERCC信息
isSpike(sce, "ERCC") <- grepl("^ERCC", rownames(sce))
summary(isSpike(sce, "ERCC"))
#Mode FALSE TRUE
#logical 46611 92
#本例中不僅包含ERCC，作者還添加了SIRV信息，我們將其刪掉
is.sirv <- grepl("^SIRV", rownames(sce))
sce <- sce[!is.sirv,]
summary(is.sirv)
#Mode FALSE TRUE
#logical 46696 7
#讀取樣本信息，并將其添加到colData中，主要包含批次以及實驗處理等信息
metadata <- read.delim(lun.sdrf, check.names=FALSE, header=TRUE)
m <- match(colnames(sce), metadata[["Source Name"]]) # Enforcing identical order.
stopifnot(all(!is.na(m))) # Checking that nothing's missing.
metadata <- metadata[m,]
head(colnames(metadata))
#[1] "Source Name" "Comment[ENA_SAMPLE]" "Comment[BioSD_SAMPLE]"
#[4] "Characteristics[organism]" "Characteristics[cell line]" "Characteristics[cell type]"
colData(sce)$Plate <- factor(metadata[["Factor Value[block]"]])
pheno <- metadata[["Factor Value[phenotype]"]]
levels(pheno) <- c("induced", "control")
colData(sce)$Oncogene <- pheno
table(colData(sce)$Oncogene, colData(sce)$Plate)
# 20160113 20160325
# induced 48 48
# control 48 48
#我們可以使用getBMFeatureAnnos使用調取biomaRt包來對基因進行注釋
library(scater)
sce <- getBMFeatureAnnos(
sce,
filters = "ensembl_gene_id",
attributes = c(
"ensembl_gene_id",
"external_gene_name",
"chromosome_name",
"start_position",
"end_position"
),
biomart = "ENSEMBL_MART_ENSEMBL",
dataset = "mmusculus_gene_ensembl",
host = "www.ensembl.org"
)
rownames(sce) <- uniquifyFeatureNames(rowData(sce)$ensembl_gene_id, rowData(sce)$external_gene_name)
rowData(sce)$ensembl_gene_id <- rownames(sce)
head(rownames(sce))
#[1] "4933401J01Rik" "Gm26206" "Xkr4" "Gm18956" "Gm37180" "Gm37363"
mito <- which(rowData(sce)$chromosome_name=="MT")
## [1] "Plate" "Oncogene"
## [3] "is_cell_control" "total_features_by_counts"
## [5] "log10_total_features_by_counts" "total_counts"
## [7] "log10_total_counts" "pct_counts_in_top_50_features"
## [9] "pct_counts_in_top_100_features" "pct_counts_in_top_200_features"
這些指標的分布如圖所示，按致癌基因誘導狀態和板進行了分層。目的是去除具有低文庫大小，少量表達特征和高ERCC（或線粒體）比例的低質量細胞。這樣的細胞可以干擾下游分析，例如通過形成使結果解釋復雜化的不同簇。
2.3 檢測離群值
為這些指標選擇一個閾值并不容易，因為它們的值取決于實驗方案。不管細胞的質量如何，測序到更大的深度將導致更多的讀取和更多表達的特征。同樣，在方案中使用更多的刺入RNA將導致更高的ERCC比例。為了獲得自適應閾值，我們假設大多數數據集均由高質量單元格組成，并確定對于各種QC指標而言異常的單元格。
離群值是根據與所有單元格中每個指標的中值的中值絕對偏差（MAD）定義的。刪除的庫大小比中位數庫大小大3個MAD的單元格。對數轉換可提高小值時的分辨率，尤其是當原始值的MAD等于或大于中值時。還刪除了表達基因的對數轉化數量低于中位數3 MAD的細胞。
#首先使用calculateQCMetrics函數計算這些質量控制指標，隨后做圖展示
sce <- calculateQCMetrics(sce, feature_controls=list(Mt=mito))
head(colnames(colData(sce)), 10)
sce$PlateOnco <- paste0(sce$Oncogene, ".", sce$Plate)
multiplot(
plotColData(sce, y="total_counts", x="PlateOnco"),
plotColData(sce, y="total_features_by_counts", x="PlateOnco"),
plotColData(sce, y="pct_counts_ERCC", x="PlateOnco"),
plotColData(sce, y="pct_counts_Mt", x="PlateOnco"),
cols=2)
par(mfrow=c(1,3))
plot(sce$total_features_by_counts, sce$total_counts/1e6, xlab="Number of expressed genes",
ylab="Library size (millions)")
plot(sce$total_features_by_counts, sce$pct_counts_ERCC, xlab="Number of expressed genes",
ylab="ERCC proportion (%)")
plot(sce$total_features_by_counts, sce$pct_counts_Mt, xlab="Number of expressed genes",
ylab="Mitochondrial proportion (%)")
#使用isOutlier計算大于3mad的離群值
libsize.drop <- isOutlier(sce$total_counts, nmads=3, type="lower",
log=TRUE, batch=sce$PlateOnco)
feature.drop <- isOutlier(sce$total_features_by_counts, nmads=3, type="lower",
log=TRUE, batch=sce$PlateOnco)
spike.drop <- isOutlier(sce$pct_counts_ERCC, nmads=3, type="higher",
batch=sce$PlateOnco)
該batch=參數可確保在指定批次的每個水平內識別異常值，防止不感興趣的因素影響結果。
按上述條件將僅保留高質量單元格。檢查每個過濾器除去的細胞數以及保留的細胞總數。刪除大量的單元格（> 10％）可能表明數據質量出現整體問題。
keep <- !(libsize.drop | feature.drop | spike.drop)
data.frame(ByLibSize=sum(libsize.drop), ByFeature=sum(feature.drop),
BySpike=sum(spike.drop), Remaining=sum(keep))
## ByLibSize ByFeature BySpike Remaining
## 1 5 4 6 183
然后，將SingleCellExperiment保留高質量細胞，還將原始對象保存到文件中以供以后使用。
sce$PassQC <- keep
saveRDS(sce, file="416B_preQC.rds")
sce <- sce[,keep]
dim(sce)
## [1] 46696 183
還可以使用PCA進行離群值的檢測，在運行PCA時，使用detect_outliers函數檢測離群值
sce_tmp <- runPCA(sce, use_coldata=TRUE, detect_outliers=TRUE)
table(sce_tmp $outlier)
FALSE TRUE
182 1
還存在一些R包可以供我們質控時使用，cellity使用支持向量機從scRNA-seq中識別低質量細胞。
2.4 細胞周期識別
基于基因表達數據將細胞分類為細胞周期階段。使用訓練數據集，為每對基因計算兩個基因之間表達差異的跡象。選擇跨細胞周期階段具有符號變化的對作為標記。然后，可以根據每個標記對的觀察符號是否與一個或另一個相一致，將測試數據集中的單元格劃分為適當的相，這種方法是在scran包的cyclone函數中實現的。
#使用scran中的cyclone確定細胞周期，目前scran自帶人和小鼠的數據可以直接調用
set.seed(100)
library(scran)
mm.pairs <- readRDS(system.file("exdata", "mouse_cycle_markers.rds",
package="scran"))
assignments <- cyclone(sce, mm.pairs, gene.names=rowData(sce)$ensembl_gene_id)
plot(assignments$score$G1, assignments$score$G2M,
xlab="G1 score", ylab="G2/M score", pch=16)
如果G1分數高于0.5且大于G2 / M分數，則將細胞分類為處于G1階段。如果G2 / M得分高于0.5且高于G1得分，則處于G2 / M階段；如果兩個分數均未超過0.5，則為S階段。在此，絕大多數細胞被分類為處于G1期。我們將這些分配保存到SingleCellExperiment對象中以供以后使用。
sce$phases <- assignments$phases
table(sce$phases)
##
## G1 G2M S
## 98 62 23
2.5 基因表達質控
檢查了表達量最高的基因的身份。通常應以組成型表達的轉錄本為主，例如核糖體或線粒體蛋白的轉錄本。如果其他類別的特征與預期的生物學不一致，則可能會引起關注。例如，包含許多ERCC轉錄本的集合表明在文庫制備過程中添加了太多spike-in RNA，而缺少核糖體蛋白和/或它們的假基因則表明存在次佳的比對。
fontsize <- theme(axis.text=element_text(size=12), axis.title=element_text(size=16))
plotHighestExprs(sce, n=50) + fontsize
低豐度基因存在問題，因為零或接近零的計數沒有太多信息可用于可靠的統計推斷。在涉及假設檢驗的應用中，這些基因通常不能提供足夠的證據來拒絕無效假設，但它們仍會增加多重檢驗校正的嚴重性。計數的離散性也可能會干擾統計程序，例如通過破壞連續逼近的準確性。因此，在應用下游方法之前，通常會在許多RNA-seq分析流程中刪除低豐度基因。
#首先做一個直方圖觀察基因表達的分布情況
ave.counts <- calcAverage(sce, use_size_factors=FALSE)
hist(log10(ave.counts), breaks=100, main="", col="grey80",
xlab=expression(Log[10]~"average count"))
可以將最小閾值應用于此值，以濾除表達水平較低的基因。
#表達每個基因的細胞數量，這與大多數基因的平均計數密切相關
num.cells <- nexprs(sce, byrow=TRUE)
smoothScatter(log10(ave.counts), num.cells, ylab="Number of cells",
xlab=expression(Log[10]~"average count"))
#在這里我們過濾掉了平均表達量為0的基因，代表在所有細胞中都沒有表達的基因。
to.keep <- num.cells > 0
sce <- sce[to.keep,]
summary(to.keep)
## Mode FALSE TRUE
## logical 22833 23863
2.6 標準化表達量
讀取count數據受細胞之間捕獲效率和測序深度的差異的影響。在進行下游定量分析之前，需要進行標準化以消除這些細胞特異性偏差。這通常是通過假設大多數基因在細胞之間不差異表達（DE）來完成的。假設兩個細胞之間跨非DE多數基因的計數大小的任何系統性差異都代表偏差，并通過縮放去除。更具體地說，將計算“size factor”，該大小因子表示每個庫中應縮放計數的程度。
#首先快速聚類，如果細胞數量較少可以不使用聚類
set.seed(1000)
clusters <- quickCluster(sce, use.ranks=FALSE, BSPARAM=IrlbaParam())
table(clusters)
#我們使用computeSumFactors計算每個細胞文庫大小
sce <- computeSumFactors(sce,min.mean=0.1，clusters=clusters)
summary(sizeFactors(sce))
#以散點圖的形式展示size factor與文庫之間的相關性
plot(sce$total_counts/1e6, sizeFactors(sce), log="xy",
xlab="Library size (millions)", ylab="Size factor",
col=c("red", "black")[sce$Oncogene], pch=16)
legend("bottomright", col=c("red", "black"), pch=16, cex=1.2,
legend=levels(sce$Oncogene))
由于ERCC基因并不是細胞本身存在的，所以計算size factor時并不適用于ERCC基因，而scater專門為ERCC開發了computeSpikeFactors函數來對ERCC進行標準化
#general.use表示是否應用到全局
sce <- computeSpikeFactors(sce, type="ERCC", general.use=FALSE)
隨后使用normalize對表達矩陣進行反卷積標準化，并在同時取對數降維，對數轉換是有用的，因為這意味著值的任何差異都直接表示單元格之間表達的對數2倍變化。這通常比覆蓋范圍的絕對差異更相關，后者需要在總體豐度的背景下進行解釋。對數轉換還提供了方差穩定化的一些措施，因此具有大方差的高豐度基因不會主導下游分析。數據保存在logcounts中
sce <- normalize(sce)
assayNames(sce)
##[1] "counts" "logcounts"
seurat方法
在seurat中首先使用NormalizeData進行全局縮放歸一化方法“ LogNormalize”，該方法將每個單元格的特征表達式測量結果與總表達式進行歸一化，再乘以比例因子（默認為10,000），然后對結果進行對數轉換。
suerat_object<- NormalizeData(suerat_object, normalization.method = "LogNormalize", scale.factor = 10000)
接下來，我們應用線性變換，這是像PCA這樣的降維技術之前的標準預處理步驟。對應ScaleData函數
- 移動每個基因的表達，從而使整個細胞的平均表達為0
- 縮放每個基因的表達，從而使細胞之間的差異為1
- 此步驟在下游分析中具有相同的權重，因此高表達的基因不會占主導地位
- 結果存儲在 pbmc[["RNA"]]@scale.data
all.genes <- rownames(suerat_object)
suerat_object<- ScaleData(suerat_object, features = all.genes)
2.7 方差建模篩選HVG
真正的生物異質性或無趣的技術噪音可能會驅動跨基因觀察到的表達值的差異。為了區分這兩種可能性，我們需要對每個基因的表達值差異的技術成分進行建模。我們使用一組ERCC轉錄本來完成，這些轉錄本以相同的數量添加到每個單元格中。因此，ERCC轉錄本不應表現出生物學變異性，即其表達的任何變異都應是技術來源。
我們使用該trendVar函數將均值相關趨勢擬合為ERCC轉錄本的對數表達值的方差。block參數將對設定批次，以確保各板之間的技術差異不會擴大差異。給定一個基因的平均豐度，然后將趨勢的擬合值用作該基因的技術成分的估計值。最后，通過decomposeVar函數從每個基因的總方差中減去技術成分，來計算方差的生物學成分。
var.fit <- trendVar(sce, parametric=TRUE, block=sce$Plate,
loess.args=list(span=0.3))
var.out <- decomposeVar(sce, var.fit)
head(var.out)
## DataFrame with 6 rows and 6 columns
## mean total
## <numeric> <numeric>
## ENSMUSG00000103377 0.00807160215928894 0.011921865486065
## ENSMUSG00000103147 0.0346526072192529 0.0722196162535234
## ENSMUSG00000103161 0.00519472222570747 0.00493857699521053
## ENSMUSG00000102331 0.018666093059853 0.032923591860573
## ENSMUSG00000102948 0.059057000132083 0.0881371257735823
## Rp1 0.0970243712569606 0.45233813529556
## bio tech p.value
## <numeric> <numeric> <numeric>
## ENSMUSG00000103377 -0.0238255786088717 0.0357474440949367 1
## ENSMUSG00000103147 -0.0812680860584481 0.153487702311972 0.999999999992144
## ENSMUSG00000103161 -0.0180705438722202 0.0230091208674307 1
## ENSMUSG00000102331 -0.0497487337065681 0.082672325567141 0.999999999998056
## ENSMUSG00000102948 -0.173441452696662 0.261578578470245 1
## Rp1 0.0226096722909625 0.429728463004597 0.0354980966384924
## FDR
## <numeric>
## ENSMUSG00000103377 1
## ENSMUSG00000103147 1
## ENSMUSG00000103161 1
## ENSMUSG00000102331 1
## ENSMUSG00000102948 1
## Rp1 0.153727758280855
隨后將擬合出來的結果進行展示
plot(var.out$mean, var.out$total, pch=16, cex=0.6, xlab="Mean log-expression",
ylab="Variance of log-expression")
curve(var.fit$trend(x), col="dodgerblue", lwd=2, add=TRUE)
cur.spike <- isSpike(sce)
points(var.out$mean[cur.spike], var.out$total[cur.spike], col="red", pch=16)
隨后檢查具有最大生物學成分的基因的表達值分布。這樣可確保方差估計不受一個或兩個異常值的影響。
chosen.genes <- order(var.out$bio, decreasing=TRUE)[1:10]
plotExpression(sce, features=rownames(var.out)[chosen.genes]) + fontsize
- 當我們的測序樣本中沒有添加spike-in基因的時候，我們就需要使用全部基因來建立擬合趨勢。
new.trend <- makeTechTrend(x=sce)
fit <- trendVar(sce, use.spikes=FALSE, loess.args=list(span=0.05))
plot(fit$mean, fit$var, pch=16)
curve(fit$trend(x), col="dodgerblue", add=TRUE)
curve(new.trend(x), col="red", add=TRUE)
#使用全部基因擬合出來的趨勢尋找HVG
fit$trend <- new.trend # overwrite trend.
dec <- decomposeVar(fit=fit) # use per-gene variance estimates in 'fit'.
top.dec <- dec[order(dec$bio, decreasing=TRUE),]
head(top.dec)
2.8 去除批次效應
limma
如前所述，數據是在兩個板上收集的。板之間的加工中不可控的微小差異會導致批次效應，即不同板上細胞之間表達的系統差異。這種差異我們并不關心，可以通過removeBatchEffect實現。這消除了批次的作用，同時考慮了致癌基因誘導的作用。
library(limma)
assay(sce, "corrected") <- removeBatchEffect(logcounts(sce),
design=model.matrix(~sce$Oncogene), batch=sce$Plate)
assayNames(sce)
## [1] "counts" "logcounts" "corrected"
當我們的數據類型相對簡單的時候可以使用removeBatchEffect，它是假定細胞群的組成在各批次之間是已知的或相同的。如果我們想要合并更加復雜的數據集的時候，由于scRNA-seq的特性，有一些方法專門用于處理單細胞測序的批次效應，例如MNN方法，seurat的CCA方法等。
MNN去除批次效應
使用fastMNN函數應用于消除批次效應。為了減少計算工作量和技術噪聲，將所有數據投影到低維空間中。然后在該低維空間中執行MNN的識別和校正向量的計算。該函數返回一個SingleCellExperiment包含低維校正值的對象，用于下游分析（如聚類或可視化）。
#首先對兩個樣本的基因名取交集
universe <- intersect(rownames(sce1), rownames(sce2))
#計算兩個樣本平均生物學差異
mean.bio <- (sce1[universe,"bio"] + sce2[universe,"bio"])/2
chosen <- universe[mean.bio > 0]
length(chosen)
重新縮放每個批次，以調整批次之間測序深度的差異。multiBatchNorm在調整大小因數以實現SingleCellExperiment對象之間覆蓋率的系統差異之后，該函數將重新計算對數歸一化的表達式值。（請注意，先前計算的大小的因素僅除去細胞之間的偏差內的單個批次）。這通過去除的批次之間的技術差異一方面提高了校正的質量。
rescaled <- batchelor::multiBatchNorm(
sce.gse85241[universe,],
sce.gse81076[universe,]
)
rescaled.gse85241 <- rescaled[[1]]
rescaled.gse81076 <- rescaled[[2]]
set.seed(100)
unc.gse81076 <- logcounts(rescaled.gse81076)[chosen,]
unc.gse85241 <- logcounts(rescaled.gse85241)[chosen,]
mnn.out <- batchelor::fastMNN(
GSE81076=unc.gse81076, GSE85241=unc.gse85241,
k=20, d=50, BSPARAM=IrlbaParam(deferred=TRUE)
)
mnn.out
2.8 降維
我們使用denoisePCA進行PCA線性降維，使用technical參數設定技術噪音，denoisePCA可以同時進行PC的篩選，刪除不重要的PC以便于后續的分析。
sce <- denoisePCA(sce, technical=var.out, assay.type="corrected")
dim(reducedDim(sce, "PCA"))
## [1] 183 24
在降維之后，我們可以在低維空間對結果進行可視化。
#查看前三個PC的情況
plotReducedDim(sce, use_dimred="PCA", ncomponents=3,
colour_by="Oncogene") + fontsize
相比之下，我們使用批次信息對細胞進行分組，可以發現并沒有明顯的細胞分離，這證明我們的批次更正步驟已成功。
plotReducedDim(sce, use_dimred="PCA", ncomponents=3,
colour_by="Plate") + fontsize
請注意，plotReducedDim將使用已經存儲在主成分分析sce的denoisePCA。這使我們能夠快速生成具有不同美感的新圖，而無需重復整個PCA計算。同樣，plotPCA將使用現有結果（如果可用），否則將重新計算。用戶應設置rerun=TRUE為在存在現有結果的情況下強制重新計算PC。
- 在PCA的基礎上，我們繼續使用t-SNE進行非線性降維， t- SNE可以比PCA更好地分離更多種群體中的細胞。這是因為前者可以直接捕獲高維空間中的非線性關系，而后者必須在線性軸上表示它們。但是，這種改進是以更多的計算工作為代價的。
set.seed(100)
out5 <- plotTSNE(sce, run_args=list(use_dimred="PCA", perplexity=5),
colour_by="Oncogene") + fontsize + ggtitle("Perplexity = 5")
set.seed(100)
out10 <- plotTSNE(sce, run_args=list(use_dimred="PCA", perplexity=10),
colour_by="Oncogene") + fontsize + ggtitle("Perplexity = 10")
set.seed(100)
out20 <- plotTSNE(sce, run_args=list(use_dimred="PCA", perplexity=20),
colour_by="Oncogene") + fontsize + ggtitle("Perplexity = 20")
multiplot(out5, out10, out20, cols=3)
t-SNE是一種隨機方法，因此用戶應多次運行該算法以確保結果具有代表性。腳本應通過set.seed設置一個種子，以確保所選結果可再現。還建議測試perplexity參數的不同設置，因為這會影響低維空間中點的分布。
在這里，我們runTSNE以20的perplexity進行調用，以將t-SNE結果存儲在SingleCellExperiment對象中。這避免了每當我們想使用創建新圖時都重復計算plotTSNE，因為將使用存儲的結果。同樣，用戶可以設置rerun=TRUE為在存在存儲結果的情況下強制重新計算。
set.seed(100)
sce <- runTSNE(sce, use_dimred="PCA", perplexity=20)
reducedDimNames(sce)
## [1] "PCA" "TSNE"
2.9 細胞聚類
使用層次聚類劃分亞群
去噪的對數表達值用于將細胞聚類為推定的亞群。具體來說，我們使用Ward.D2對單元之間的歐式距離進行層次聚類，以使每個聚類中的總方差最小。這將產生一個樹狀圖，該樹狀圖將跨所選基因具有相似表達模式的細胞分組在一起。
pcs <- reducedDim(sce, "PCA")
my.dist <- dist(pcs)
my.tree <- hclust(my.dist, method="ward.D2")
通過對樹狀圖應用動態樹切割來明確定義聚類。這利用了樹狀圖中的分支形狀來完善聚類定義，并且比cutree復雜樹狀圖更合適。通過在中手動指定cutHeight，cutreeDynamic函數可以更好地控制亞群的劃分。我們還設置minClusterSize了一個低于默認值20的值，以避免劃分虛假的小亞群。
library(dynamicTreeCut)
my.clusters <- unname(cutreeDynamic(my.tree, distM=as.matrix(my.dist),
minClusterSize=10, verbose=0))
隨后使用不同條件對聚類結果進行檢查
#使用批次信息
table(my.clusters, sce$Plate)
#使用實驗處理信息
table(my.clusters, sce$Oncogene)
在t-SNE圖中展示亞群的劃分，通常比較接近的細胞會被劃分在同一亞群中。
sce$cluster <- factor(my.clusters)
plotTSNE(sce, colour_by="cluster") + fontsize
在聚類之后，我們使用輪廓寬度檢查聚類的分離性。理想情況下，每個亞群將包含許多具有較大正寬度的單元，這表明該群集與其他群集完全分開。
library(cluster)
clust.col <- scater:::.get_palette("tableau10medium") # hidden scater colours
sil <- silhouette(my.clusters, dist = my.dist)
sil.cols <- clust.col[ifelse(sil[,3] > 0, sil[,1], sil[,2])]
sil.cols <- sil.cols[order(-sil[,1], sil[,3])]
plot(sil, main = paste(length(unique(my.clusters)), "clusters"),
border=sil.cols, col=sil.cols, do.col.sort=FALSE)
使用圖聚類劃分亞群
我們建立一個共享的最近鄰圖，并使用Walktrap算法來識別聚類。
snn.gr <- buildSNNGraph(sce, use.dimred="PCA")
clusters <- igraph::cluster_walktrap(snn.gr)
sce$Cluster <- factor(clusters$membership)
table(sce$Cluster)
## 1 2 3 4
##53 13 37 80
我們查看觀察到的邊緣權重與預期邊緣權重之比，以確認群集是模塊化的。（我們沒有看模塊性評分本身，因為模塊性評分在群集之間的變化幅度不同，并且難以解釋。）下圖指出，大多數群集都很好地分離開了，幾乎沒有強烈的相關亞群。
cluster.mod <- clusterModularity(snn.gr, sce$Cluster, get.values=TRUE)
log.ratio <- log2(cluster.mod$observed/cluster.mod$expected + 1)
library(pheatmap)
pheatmap(log.ratio, cluster_rows=FALSE, cluster_cols=FALSE,
color=colorRampPalette(c("white", "blue"))(100))
隨后在t-SNE中檢查聚類情況
plotTSNE(sce, colour_by="Cluster")
使用一致性聚類對亞群進行劃分
讓我們SC3對數據進行聚類。SC3的優點是它可以直接攝取SingleCellExperiment對象，當我們不清楚聚類條目K時，SC3可以估計多個群集
library(SC3) # BiocManager::install('SC3')
sce <- sc3_estimate_k(sce) # 先預估一下聚類亞群
sce@metadata$sc3$k_estimation # 預估13個亞群
rowData(sce)$feature_symbol <- rownames(rowData(sce))
# 接下來正式運行，kn參數表示的預估聚類數
# 我們這里自定義為5組
kn <- 5
start=Sys.time()
sce <- sc3(sce, ks = kn, biology = TRUE)
end=Sys.time()
(dur=end-start)
# 會將聚類結果放入表型信息(sce@colData)中去，默認叫sc3_cluster，這里人為改個名稱
sc3_cluster="sc3_5_clusters"
# 最后進行可視化比較之前tSNE的Kmeans聚類和SC3的聚類的一致性
sc3_plot_consensus(sce, k = kn, show_pdata = c("cluster",'sc3_5_clusters'))
2.10 Marker基因的篩選
我們使用findMarkers來尋找每個亞群中的Marker基因
top.markers <- rownames(marker.set)[marker.set$Top <= 10]
plotHeatmap(sce, features=top.markers, columns=order(sce$cluster),
colour_columns_by=c("cluster", "Plate", "Oncogene"),
cluster_cols=FALSE, center=TRUE, symmetric=TRUE, zlim=c(-5, 5))
