單細胞交響樂14-細胞軌跡推斷

劉小澤寫於2020.7.16
爲何取名叫“交響樂”？因爲單細胞分析就像一個大樂團，需要各個流程的協同配合
單細胞交響樂1-常用的數據結構SingleCellExperiment
單細胞交響樂2-scRNAseq從實驗到下游簡介
單細胞交響樂3-細胞質控
單細胞交響樂4-歸一化
單細胞交響樂5-挑選高變化基因
單細胞交響樂6-降維
單細胞交響樂7-聚類分羣
單細胞交響樂8-marker基因檢測
單細胞交響樂9-細胞類型註釋
單細胞交響樂9-細胞類型註釋
單細胞交響樂10-數據集整合後的批次矯正
單細胞交響樂11-多樣本間差異分析
單細胞交響樂12-檢測Doublet
單細胞交響樂13-細胞週期推斷

1 前言

接觸單細胞數據，相信你一定聽過：軌跡推斷，英文名詞是： Trajectory Analysis。和它相關的另一個名詞是：擬時序分析（pseudotime），指的是細胞沿着這個軌跡，並且對潛在的生物活動進行量化。注意這裏看字面意思就知道，並不是指真正的時間，而是指細胞與細胞之間的更替、轉化的順序或者是軌跡，可以理解爲“一個連續過程的縮影”。

不同的生物過程對應的“擬時序”也是不同的：

許多生物過程都伴隨着細胞狀態的連續性變化，比如研究發育就會經常使用到。我們可以利用單細胞數據在高維空間畫一條線，貫穿於多種細胞狀態。最簡單是點到點的一條路徑，更復雜的還有一個點出發再生成多個分支。

看一下現在做相關分析的工具：來自https://broadinstitute.github.io/2019_scWorkshop/pseudotime-cell-trajectories.html

自2014年以後，已經開發出了超50種方法，那麼選擇何種方法進行分析成爲了一個難題，因爲我們不可能每一種都試一下，但有評測文章發現：Slingshot、TSCAN、Monocle DDRTree這幾種方法都不錯

當然還有其他的幾種方法值得推薦，還做成了一個流程圖方便查閱
如果對評測感興趣，可以看看：https://github.com/dynverse/dynverse，裏面有詳細的代碼

公開課推薦：Trajectory inference analysis of scRNA-seq data from ELIXIR-SE https://www.youtube.com/watch?v=XmHDexCtjyw，他們也有線上課程資料：https://github.com/NBISweden/excelerate-scRNAseq

有人整理了一份軌跡推斷工具的清單：https://github.com/agitter/single-cell-pseudotime

做這個分析之前，最好先問幾個問題：

• 確定數據會體現發育軌跡嗎？也就是研究的樣本是不是和發育相關的？
• 數據中的細胞會體現出中間態嗎？
• 是否認爲軌跡會出現分支？

並且要注意：

• 任何數據都可以強行畫出軌跡，但不一定都有生物學意義！
• 先要保證目前找到的HVGs和降維結果符合我們的預期，才能繼續向下分析

2 學習Slingshot

官方文檔在：https://bioconductor.org/packages/release/bioc/vignettes/slingshot/inst/doc/vignette.html

它需要兩個必須的輸入文件：降維結果與細胞分羣結果

因爲它分析的基礎假設就是：在低維空間上，細胞的位置是連續的並且是一個接一個的

2.1 數據準備

means <- rbind(
    # non-DE genes
    matrix(rep(rep(c(0.1,0.5,1,2,3), each = 300),100),
        ncol = 300, byrow = TRUE),
    # early deactivation
    matrix(rep(exp(atan( ((300:1)-200)/50 )),50), ncol = 300, byrow = TRUE),
    # late deactivation
    matrix(rep(exp(atan( ((300:1)-100)/50 )),50), ncol = 300, byrow = TRUE),
    # early activation
    matrix(rep(exp(atan( ((1:300)-100)/50 )),50), ncol = 300, byrow = TRUE),
    # late activation
    matrix(rep(exp(atan( ((1:300)-200)/50 )),50), ncol = 300, byrow = TRUE),
    # transient
    matrix(rep(exp(atan( c((1:100)/33, rep(3,100), (100:1)/33) )),50), 
        ncol = 300, byrow = TRUE)
)
counts <- apply(means,2,function(cell_means){
    total <- rnbinom(1, mu = 7500, size = 4)
    rmultinom(1, total, cell_means)
})
rownames(counts) <- paste0('G',1:750)
colnames(counts) <- paste0('c',1:300)
> counts[1:4,1:4]
   c1 c2 c3 c4
G1  0  1  2  0
G2  2  3  2  5
G3  3  8  5  4
G4  5 16  6  8
> dim(counts)
[1] 750 300

# 構建一個sce對象
sim <- SingleCellExperiment(assays = List(counts = counts))
> sim
class: SingleCellExperiment 
dim: 750 300 
metadata(0):
assays(1): counts
rownames(750): G1 G2 ... G749 G750
rowData names(0):
colnames(300): c1 c2 ... c299 c300
colData names(0):
reducedDimNames(0):
altExpNames(0):

2.2 基因過濾

geneFilter <- apply(assays(sim)$counts,1,function(x){
    sum(x >= 3) >= 10
})
sim <- sim[geneFilter, ]
# 過濾掉11個基因
> dim(sim)
[1] 739 300

2.3 歸一化

FQnorm <- function(counts){
    rk <- apply(counts,2,rank,ties.method='min')
    counts.sort <- apply(counts,2,sort)
    refdist <- apply(counts.sort,1,median)
    norm <- apply(rk,2,function(r){ refdist[r] })
    rownames(norm) <- rownames(counts)
    return(norm)
}
assays(sim)$norm <- FQnorm(assays(sim)$counts)

2.4降維

方法一：PCA

pca <- prcomp(t(log1p(assays(sim)$norm)), scale. = FALSE)
rd1 <- pca$x[,1:2]

plot(rd1, col = rgb(0,0,0,.5), pch=16, asp = 1)

方法二：diffusion maps

library(destiny, quietly = TRUE)
dm <- DiffusionMap(t(log1p(assays(sim)$norm)))
rd2 <- cbind(DC1 = dm$DC1, DC2 = dm$DC2)
plot(rd2, col = rgb(0,0,0,.5), pch=16, asp = 1)

將兩種結果都保存起來

reducedDims(sim) <- SimpleList(PCA = rd1, DiffMap = rd2)

2.5 聚類

方法一： Gaussian mixture modeling

library(mclust, quietly = TRUE)
#根據PCA結果
cl1 <- Mclust(rd1)$classification
colData(sim)$GMM <- cl1

library(RColorBrewer)
plot(rd1, col = brewer.pal(9,"Set1")[cl1], pch=16, asp = 1)

方法二：k-means

cl2 <- kmeans(rd1, centers = 4)$cluster
colData(sim)$kmeans <- cl2

plot(rd1, col = brewer.pal(9,"Set1")[cl2], pch=16, asp = 1)

2.6 使用slingshot

sim <- slingshot(sim, clusterLabels = 'GMM', reducedDim = 'PCA')
summary(sim$slingPseudotime_1)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   0.000   8.633  21.118  21.415  34.367  43.186

• 如果要把slingshot的所有結果都提取出來，可以用SlingshotDataSet
• 像是SingleCellExperiment這一類對象的結果可以用 metadata(sim)$slingshot 獲取

對結果可視化

colors <- colorRampPalette(brewer.pal(11,'Spectral')[-6])(100)
plotcol <- colors[cut(sim$slingPseudotime_1, breaks=100)]

plot(reducedDims(sim)$PCA, col = plotcol, pch=16, asp = 1)
lines(SlingshotDataSet(sim), lwd=2, col='black')

3 學習TSCAN

說明文檔在：https://bioconductor.org/packages/3.11/bioc/vignettes/TSCAN/inst/doc/TSCAN.pdf

3.1 準備數據

library(TSCAN)
data(lpsdata)
procdata <- preprocess(lpsdata)

這個preprocess函數做了三件事：

• 對錶達量進行了log2(exp+1)
• 去掉了在超過一半細胞中表達量小於1的基因
• 將coefficient ofcovariance小於1的基因去掉

3.2 構建擬時序

使用exprmclust函數，進行了PCA降維以及model-based的聚類

lpsmclust <- exprmclust(procdata)
# 然後看下結果
plotmclust(lpsmclust)

這個圖上很亂，但不妨礙看到分了3羣

接着獲得排序

lpsorder <- TSCANorder(lpsmclust)

3.3 基於找到的排序檢測差異基因

使用difftest函數

diffval <- difftest(procdata,lpsorder)

根據q值找差異基因

head(row.names(diffval)[diffval$qval < 0.05])

對其中某個差異基因作圖

# 以STAT2基因爲例
STAT2expr <- log2(lpsdata["STAT2",]+1)
singlegeneplot(STAT2expr, TSCANorder(lpsmclust,flip=TRUE,orderonly=FALSE))

4 關於monocle

monocle2的擬時序分析前期數據準備可以看：單細胞轉錄組學習筆記-18-scRNA包學習Monocle2

另外monocle3可以看：跟着官網學習單細胞Monocle3

以版本2爲例，基本上還是分三步走：從差異分析結果選合適基因=》降維=》細胞排序

step1: 選合適基因

ordering_genes <- row.names (subset(diff_test_res, qval < 0.01))
cds <- setOrderingFilter(cds, ordering_genes)
plot_ordering_genes(cds)

step2: 降維

# 默認使用DDRTree的方法 
cds <- reduceDimension(cds, max_components = 2,
                            method = 'DDRTree')

step3: 細胞排序

cds <- orderCells(cds)

最後可視化

plot_cell_trajectory(cds, color_by = "Biological_Condition")  

這個圖就可以看到細胞的發展過程

另外，plot_genes_in_pseudotime 可以對基因在不同細胞中的表達量變化進行繪圖

plot_genes_in_pseudotime(cds[cg,],
                         color_by = "Biological_Condition")

---

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