R包SCENIC:结果可视化与分析

1.鉴定细胞状态

以t-SNE图呈现AUC评分和TF表达情况（即调控元件的活动度）

利用AUC 交互app（Scope）

logMat <- exprMat # Better if it is logged/normalized

aucellApp <- plotTsne_AUCellApp(scenicOptions, logMat) # default t-SNE

savedSelections <- shiny::runApp(aucellApp)

print(tsneFileName(scenicOptions))

## [1] "int/tSNE_AUC_05pcs_15perpl.Rds"

函数AUCell_plotTSNE() 可以用于保存一些plot

tSNE_scenic <- readRDS(tsneFileName(scenicOptions))

aucell_regulonAUC <- loadInt(scenicOptions, "aucell_regulonAUC")

# Show TF expression:

par(mfrow=c(2,3))

AUCell::AUCell_plotTSNE(tSNE_scenic$Y, exprMat, aucell_regulonAUC[onlyNonDuplicatedExtended(rownames(aucell_regulonAUC))[c("Dlx5", "Sox10", "Sox9","Irf1", "Stat6")],], plots="Expression")

将AUC结果保存为PDF

# Save AUC as PDF:

Cairo::CairoPDF("output/Step4_BinaryRegulonActivity_tSNE_colByAUC.pdf", width=20, height=15)

par(mfrow=c(4,6))

AUCell::AUCell_plotTSNE(tSNE_scenic$Y, cellsAUC=aucell_regulonAUC, plots="AUC")

dev.off()

绘制密度图，显示稳定状态的细胞

library(KernSmooth)

library(RColorBrewer)

dens2d <- bkde2D(tSNE_scenic$Y, 1)$fhat

image(dens2d, col=brewer.pal(9, "YlOrBr"), axes=FALSE)

contour(dens2d, add=TRUE, nlevels=5, drawlabels=FALSE)

同时显示多个调控元件

#par(bg = "black")

par(mfrow=c(1,2))

regulonNames <- c( "Dlx5","Sox10")

cellCol <- plotTsne_rgb(scenicOptions, regulonNames, aucType="AUC", aucMaxContrast=0.6)

text(-30,-25, attr(cellCol,"red"), col="red", cex=.7, pos=4)

text(-30,-25-4, attr(cellCol,"green"), col="green3", cex=.7, pos=4)

regulonNames <- list(red=c("Sox10", "Sox8"),

                    green=c("Irf1"),

                    blue=c( "Tef"))

cellCol <- plotTsne_rgb(scenicOptions, regulonNames, aucType="Binary")

text(-30,-25, attr(cellCol,"red"), col="red", cex=.7, pos=4)

text(-30,-25-4, attr(cellCol,"green"), col="green3", cex=.7, pos=4)

text(-30,-25-8, attr(cellCol,"blue"), col="blue", cex=.7, pos=4)

---

2.GRN:调控元件的靶点和motif

#查看regulon包含哪些基因
regulons <- loadInt(scenicOptions, "regulons")

regulons[c("Dlx5", "Irf1")]

#注意：AUCell只对10个以上基因的调控元件进行评分

regulons <- loadInt(scenicOptions, "aucell_regulons")

head(cbind(onlyNonDuplicatedExtended(names(regulons))))

#查看TF-target pair

regulonTargetsInfo <- loadInt(scenicOptions, "regulonTargetsInfo")

tableSubset <- regulonTargetsInfo[TF=="Stat6" & highConfAnnot==TRUE]

viewMotifs(tableSubset) 

#查看motif富集分析

motifEnrichment_selfMotifs_wGenes <- loadInt(scenicOptions, "motifEnrichment_selfMotifs_wGenes")

tableSubset <- motifEnrichment_selfMotifs_wGenes[highlightedTFs=="Dlx5"]

viewMotifs(tableSubset) 

3.查看cluster或者已知细胞类型的调控因子活性

如r包Seurat得到细胞cluster可作为Cellinfo

cellInfo <- data.frame(seuratCluster=Idents(seuratObject)))

计算cluster的平均调控因子的活性

（1）用AUC评分表示调控因子的活性

regulonAUC <- loadInt(scenicOptions, "aucell_regulonAUC")

regulonAUC <- regulonAUC[onlyNonDuplicatedExtended(rownames(regulonAUC)),]

regulonActivity_byCellType <- sapply(split(rownames(cellInfo), cellInfo$CellType),

                                    function(cells) rowMeans(getAUC(regulonAUC)[,cells]))

regulonActivity_byCellType_Scaled <- t(scale(t(regulonActivity_byCellType), center = T, scale=T))

pheatmap::pheatmap(regulonActivity_byCellType_Scaled, #fontsize_row=3,                    color=colorRampPalette(c("blue","white","red"))(100), breaks=seq(-3, 3, length.out = 100),

                  treeheight_row=10, treeheight_col=10, border_color=NA)

heatmap：不同细胞类型对应的调控元件

topRegulators <- reshape2::melt(apply(regulonActivity_byCellType_Scaled, 2, function(x) cbind(sort(x[x>0], decreasing=TRUE))))[c("L1","Var1", "value")]; colnames(topRegulators) <- c("CellType","Regulon", "RelativeActivity")

viewTable(topRegulators)

（2）用二进制结果表示调控因子活性

minPerc <- .7

binaryRegulonActivity <- loadInt(scenicOptions, "aucell_binary_nonDupl")

cellInfo_binarizedCells <- cellInfo[which(rownames(cellInfo)%in% colnames(binaryRegulonActivity)),, drop=FALSE]

regulonActivity_byCellType_Binarized <- sapply(split(rownames(cellInfo_binarizedCells), cellInfo_binarizedCells$CellType),

function(cells) rowMeans(binaryRegulonActivity[,cells, drop=FALSE]))

binaryActPerc_subset <- regulonActivity_byCellType_Binarized[which(rowSums(regulonActivity_byCellType_Binarized>minPerc)>0),]

pheatmap::pheatmap(binaryActPerc_subset, # fontsize_row=5,  color = colorRampPalette(c("white","pink","red"))(100), breaks=seq(0, 1, length.out = 100),treeheight_row=10, treeheight_col=10, border_color=NA)

heatmap:不同细胞类型对应的调控因子活性

topRegulators <- reshape2::melt(apply(regulonActivity_byCellType_Binarized, 2, function(x) cbind(sort(x[x>minPerc], decreasing=TRUE))))[c("L1","Var1", "value")]; colnames(topRegulators) <- c("CellType","Regulon", "RelativeActivity")

viewTable(topRegulators)

查看其它方法计算embeddings/trajectorie上的调控因子活性

library(Seurat)

dr_coords <- Embeddings(seuratObject, reduction="tsne")

tfs <- c("Sox10","Irf1","Sox9", "Dlx5")

par(mfrow=c(2,2))

AUCell::AUCell_plotTSNE(dr_coords, cellsAUC=selectRegulons(regulonAUC, tfs), plots = "AUC")