劉小澤寫于19.10.24
筆記目的：根據生信技能樹的單細胞轉錄組課程探索Smartseq2技術及發育相關的分析
課程鏈接在：http://jm.grazy.cn/index/mulitcourse/detail.html?cid=55
這次會介紹如何對不同譜系的差異基因分類注釋。對應視頻第三單元14講
前言
將對應文章這張圖：
1 Monocle找不同譜系之間的高變化基因
加載數據
rm(list = ls())
options(warn=-1)
options(stringsAsFactors = F)
source("../analysis_functions.R")
# RPKM矩陣進行可視化，count矩陣進行差異分析
load('../female_rpkm.Rdata')
load('../female_count.Rdata')
# 譜系推斷結果，這里選擇之前的Slingshot結果
load('../step4-psudotime/female-psudotime-percent.Rdata')
# 6個發育時期獲取
head(colnames(female_count))
female_stages <- sapply(strsplit(colnames(female_count), "_"), `[`, 1)
names(female_stages) <- colnames(female_count)
table(female_stages)
# 4個cluster獲取
cluster <- read.csv('../step1-female-RPKM-tSNE/female_clustering.csv')
female_clustering=cluster[,2];names(female_clustering)=cluster[,1]
table(female_clustering)
首先找第一個譜系中變化更劇烈的
下面這個get_var_genes_pseudotime函數是作者包裝好的（https://github.com/IStevant/XX-XY-mouse-gonad-scRNA-seq/blob/master/scripts/XX_analysis_dm.R），很長但不難理解。只需要自己進入作者的代碼，將其中的變量替換成自己現有的變量，一步步操作理解即可。
female_lineage1_sig_gene_pseudoT <- get_var_genes_pseudotime(
females,
female_count,
female_pseudotime,
lineageNb=1,
female_clustering
)
> dim(female_lineage1_sig_gene_pseudoT)
[1] 12612 6
# 從中找到差異顯著的基因，根據qval<0.05過濾
# 結果從12612個基因里面挑選出2861個差異顯著的基因
female_lineage1_sig_gene_pseudoT <- female_lineage1_sig_gene_pseudoT[female_lineage1_sig_gene_pseudoT$qval<0.05,]
> dim(female_lineage1_sig_gene_pseudoT)
[1] 2861 6
同樣對第二個譜系
female_lineage2_sig_gene_pseudoT <- get_var_genes_pseudotime(
females,
female_count,
female_pseudotime,
lineageNb=2,
female_clustering
)
female_lineage2_sig_gene_pseudoT <- female_lineage2_sig_gene_pseudoT[female_lineage2_sig_gene_pseudoT$qval<0.05,]
# 從11937個基因里面挑選出2182個差異顯著的基因
> dim(female_lineage2_sig_gene_pseudoT)
[1] 2182 6
save(female_lineage1_sig_gene_pseudoT,
female_lineage2_sig_gene_pseudoT,
file = 'lineage_sig_gene.Rdata')
2 將不同譜系中的高變化基因進行分類
找到了變化顯著的基因，就相當于縮小了操作對象，下面聚類的操作就會得到這些基因并基于它們進行后續分析
2.1 取兩個譜系全部的HVGs，并進行去重復
首先各自提取兩個譜系中差異顯著的基因
female_lineage1_clustering <- female_lineage1_sig_gene_pseudoT[female_lineage1_sig_gene_pseudoT$qval<0.05,]
female_lineage2_clustering <- female_lineage2_sig_gene_pseudoT[female_lineage2_sig_gene_pseudoT$qval<0.05,]
然后得到之前兩個譜系的全部高變化基因，并使用unique()函數進行去重復
理解一下這個函數。對于重復值操作，常見的有unique和duplicated，前者直接返回去重復后的結果；后者返回邏輯值，判斷是否為重復值
> unique(c(1,2,1,2,3))
[1] 1 2 3
> duplicated(c(1,2,1,2,3))
[1] FALSE FALSE TRUE TRUE FALSE
那么就可以得到全部高變化基因
gene_list <- unique(rownames(female_lineage1_clustering),
rownames(female_lineage2_clustering))
> length(gene_list)
[1] 2861
這樣就可以提取無重復HVGs的RPKM小表達矩陣
de_matrix <- log(females[rownames(females) %in% gene_list,]+1)
> dim(females)
[1] 21083 563
> dim(de_matrix)
[1] 2861 563
最后得到2861個高變化基因的小表達矩陣
2.2 分別得到兩個譜系的細胞排序后的表達矩陣
思路：從開始的左邊??那張圖可以看到，兩個譜系的細胞都是從中間0開始向兩側（100）延伸，那么這里也需要按照之前做好的譜系百分比對細胞進行一個升序排序，然后再按照這個順序提取每個譜系的表達矩陣
## 對第一個譜系來說
# 得到第一個譜系的細胞百分比
L1_lineage <- female_pseudotime[!is.na(female_pseudotime[,1]),1]
# 對百分比進行升序排序
L1_ordered_lineage <- L1_lineage[order(L1_lineage,
decreasing = FALSE)]
# 根據第一個譜系的排序后的細胞名稱，得到屬于它的表達矩陣
L1_cells <- de_matrix[,names(L1_ordered_lineage)]
## 同理得到L2
if(T){
## 第二個譜系
# 得到第二個譜系的細胞百分比
L2_lineage <- female_pseudotime[!is.na(female_pseudotime[,2]),2]
# 對百分比進行升序排序（細胞數量從少到多）
L2_ordered_lineage <- L2_lineage[order(L2_lineage,
decreasing = FALSE)]
# 根據第二個譜系的細胞名稱，得到屬于它的表達矩陣
L2_cells <- de_matrix[,names(L2_ordered_lineage)]
}
2.3 按照表達矩陣的細胞順序，對譜系和分群的細胞名重新排序
把這兩個譜系的排序好的細胞名稱提取出來
## 提取細胞名
L1_lineage_cells <- names(L1_ordered_lineage)
length(L1_lineage_cells)
# 423
L2_lineage_cells <- names(L2_ordered_lineage)
length(L2_lineage_cells)
# 294
看到L1_lineage有423個，L2_lineage有294個，而總共563個細胞。
那么我們想知道，哪些細胞是兩個譜系分化之前共有的，哪些是特有的
也就是找交集和補集
comp_list <- comparelists(L1_lineage_cells, L2_lineage_cells)
common_cells <- comp_list$intersect
L1_spe_cells <- L1_lineage_cells[!L1_lineage_cells %in% comp_list$intersect]
L2_spe_cells <- L2_lineage_cells[!L2_lineage_cells %in% comp_list$intersect]
length(common_cells);length(L1_spe_cells);length(L2_spe_cells)
# 共有的是154個，L1特有269個，L2特有140個
把L1特有和共有的標記成L1_cellLin
L1_cellLin <- c(
rep_along("common cells", common_cells),
rep_along("L1 cells", L1_spe_cells)
)
names(L1_cellLin) <- c(common_cells, L1_spe_cells)
然后按照之前L1的小表達矩陣L1_cells的列名進行重新排序
L1_cellLin <- L1_cellLin[match(colnames(L1_cells),names(L1_cellLin) )]
對L2也進行同樣的操作，得到L2_cellLin
if(T){
L2_cellLin <- c(
rep_along("common cells", common_cells),
rep_along("L2 cells", L2_spe_cells)
)
names(L2_cellLin) <- c(common_cells, L2_spe_cells)
# 將L1_cellLin按照之前得到的L1表達矩陣列名重新排序
L2_cellLin <- L2_cellLin[match(colnames(L2_cells),names(L2_cellLin) )]
}
接著按照之前分群的結果對小表達矩陣的列名重新排序，同時也對上面的譜系順序再次排序。
看到這么多次，反反復復的排序，目的就一個：把小表達矩陣、分群、細胞譜系的細胞信息做到對應
# 將第一個譜系的表達矩陣細胞名與分群、譜系信息聯系起來
cellType_L1 <- female_clustering[colnames(L1_cells)]
colnames(L1_cells) <- paste(colnames(L1_cells), "L1", sep="_")
names(L1_cellLin) <- colnames(L1_cells)
# 同理對L2
cellType_L2 <- female_clustering[colnames(L2_cells)]
colnames(L2_cells) <- paste(colnames(L2_cells), "L2", sep="_")
names(L2_cellLin) <- colnames(L2_cells)
然后合并排序后的譜系和分群信息
cellLin <- c(
L2_cellLin,
L1_cellLin
)
cellType <- c(
cellType_L2,
cellType_L1
)
2.4 開始對基因進行分類
從圖中可以看到，將基因 分成了17組
# 表達量局部加權回歸散點平滑法（locally weighted scatterplot smoothing，LOESS）
L2_cells_smooth <- smooth_gene_exp(
L2_cells,
L2_ordered_lineage,
span=0.4
)
L1_cells_smooth <- smooth_gene_exp(
L1_cells,
L1_ordered_lineage,
span=0.4
)
# 合并局部加權回歸表達矩陣
data_heatmap <- data.frame(
L2_cells_smooth,
L1_cells_smooth
)
# 利用pheatmap函數進行層次聚類，只是為了調用它的算法而已，不是真的作圖
set.seed(123)
gene_clustering <- pheatmap::pheatmap(
data_heatmap,
scale="row",
clustering_method="ward.D",
silent=TRUE
)
# 挑出17個基因cluster
clusters <- cutree(gene_clustering$tree_row, k = 17)
clustering <- data.frame(clusters)
clustering[,1] <- as.character(clustering[,1])
colnames(clustering) <- "Gene_Clusters"
write.csv(clustering,
file="step5.2-gene_clustering_kmeans_k17_scaled.csv")
save(clusters,clustering,file = 'step5.2-gene_clustering.Rdata')
save(data_heatmap,cellLin,cellType,cellType_L2,
file = 'step5.2-for_heatmap.Rdata')
3 分類后，添加顏色信息進行熱圖繪制
3.1 首先還是添加之前做好的數據
rm(list = ls())
options(warn=-1)
options(stringsAsFactors = F)
source("../analysis_functions.R")
load('step5.2-for_heatmap.Rdata')
load('step5.2-gene_clustering.Rdata')
# 3個譜系（2個特有+1個共有）
> table(cellLin)
cellLin
L1 cells L2 cells common cells
269 140 308
# 4種細胞類型
> table(cellType)
cellType
C1 C2 C3 C4
394 90 190 43
# 17個基因分類結果
> table(clustering[,1])
1 10 11 12 13 14 15 16 17 2 3 4 5 6 7 8 9
295 257 117 69 122 128 209 162 150 319 61 167 83 136 229 129 228
3.2 熱圖準備之--配置基因分組顏色
gene_cluster_palette <- c(
'#a6cee3',
'#1f78b4',
'#b2df8a',
'#33a02c',
'#fb9a99',
'#e31a1c',
'#fdbf6f',
'#ff7f00',
'#cab2d6',
'#6a3d9a',
'#ffff99',
'#b15928',
'#49beaa',
'#611c35',
'#2708a0',
'#fccde5',
'#bc80bd'
)
gene_cluster_colors <- gene_cluster_palette[1:max(clusters)]
names(gene_cluster_colors) <- 1:max(clusters)
3.3 熱圖準備之--配置行、列注釋信息
行注釋：每個基因屬于哪個組
annotation_row <- data.frame(clustering=clustering)
列注釋：三種信息cell lineage, cell cluster type, cell stage
annotation_col <- data.frame(
cellLineages=cellLin,
cellType=cellType,
Stages=sapply(strsplit(colnames(data_heatmap), "_"), `[`, 1)
)
rownames(annotation_col) <- colnames(data_heatmap)
3個cell lineages顏色
cellLinCol <- c(
"#3b3561",
"#c8c8c8",
"#ff6663"
)
names(cellLinCol) <- unique(cellLin)
4個cell clusters顏色
cellTypeCol <- c(
C2="#a53bad",
C1="#560047",
C3="#eb6bac",
C4="#ffa8a0"
)
names(cellTypeCol) <- unique(cellType)
3.4 熱圖準備之--把三種注釋信息顏色放在一起
3個譜系（2個特有+1個共有）+4種細胞類型 +17個基因分類結果
annotation_colors <- list(
cellType=cellTypeCol,
cellLineages=cellLinCol,
clustering=gene_cluster_colors,
Stages=c(
E10.5="#2754b5",
E11.5="#8a00b0",
E12.5="#d20e0f",
E13.5="#f77f05",
E16.5="#f9db21",
P6="#43f14b"
)
)
# 調畫板
cold <- colorRampPalette(c('#f7fcf0','#41b6c4','#253494','#081d58','#081d58'))
warm <- colorRampPalette(c('#ffffb2','#fecc5c','#e31a1c','#800026','#800026'))
mypalette <- c(rev(cold(21)), warm(20))
breaksList = seq(-2.2, 2.5, by = 0.2)
3.5 繪制熱圖
library(pheatmap)
tiff(file="step5.3-A-female_heatmap_DE_genes_k_17_pval_005.tiff",
res = 300, height = 21, width = 18, units = 'cm')
gene_clustering <- pheatmap(
data_heatmap,
scale="row",
gaps_col=length(cellType_L2),
show_colnames=FALSE,
show_rownames=FALSE,
cluster_cols=FALSE,
clustering_method="ward.D",
annotation_row=annotation_row,
annotation_col=annotation_col,
annotation_colors=annotation_colors,
cutree_rows=17,
annotation_names_row=FALSE,
color=mypalette
)
dev.off()
4 功能分析
上一步將基因分成了G1-G17組，然后作者根據相似的表達模式又進行整合，再看原文的那張圖，將G1-G4規定為a（從熱圖中能看到它們都在早期表達，在晚期不表達），類似地分成了a-g7組。分組的原因一個是：原來的17組進行注釋太繁瑣；另一個是：原來的17組中有的組細胞數量太少，注釋結果也不好解釋。正好借助熱圖，觀察到有的組很像，那么就干脆將它們放在一起進行注釋。新的分組也是有意義的，文章中也花了大篇幅介紹這些整合是根據什么：
image-20191110210627112
下載作者做好的分組數據
dyn_genes <- read.csv(file="../female_lineages_DE_gene_pseudotime_clustered_annotated.csv")
gene_names <- dyn_genes$Genes
基因ID轉換
entrez_genes <- bitr(gene_names, fromType="SYMBOL", toType="ENTREZID", OrgDb="org.Mm.eg.db")
提取有對應Entrez ID的變化基因
gene_clusters <- dyn_genes[dyn_genes$Genes %in% entrez_genes$SYMBOL,,drop=FALSE]
# drop=FALSE確保返回數據框
進行富集分析
de_gene_clusters <- data.frame(
ENTREZID=entrez_genes[!duplicated(entrez_genes$SYMBOL),"ENTREZID"],
Gene_Clusters=gene_clusters$Gene.categories
)
formula_res <- compareCluster(
ENTREZID~Gene_Clusters,
data=de_gene_clusters,
fun="enrichGO",
OrgDb="org.Mm.eg.db",
ont = "BP",
pAdjustMethod = "BH",
pvalueCutoff = 0.05,
qvalueCutoff = 0.05
)
因為有7個分組，所以富集分析也是一個組一個組地去做，但是這里可以直接提供數據框格式，然后函數本身再對數據框進行拆分成列表的操作，只是方便了使用，背后的邏輯沒有變
它在背后做了：
split(de_gene_clusters,de_gene_clusters$Gene_Clusters)
簡化GO富集分析結果
GO數據庫是有向無環圖，存在父-子關系，因此常規的注釋可能會注釋到很多同屬一個根的結果，會有些冗余?？梢赃x擇使用simplify函數進行簡化
lineage1_ego <- simplify(
formula_res,
cutoff=0.5,
by="p.adjust",
select_fun=min
)
結果可以對比一下
dotplot(formula_res, showCategory=3)+ theme(aspect.ratio=0.8)
dotplot(lineage1_ego, showCategory=3)+ theme(aspect.ratio=2)
