hello，大家好，最近呢，10X单细胞核转录组 + 10X单细胞ATAC的多组学测序技术日渐成熟，因为这样技术同时可以获得一个细胞表达的转录组信息和ATAC的信息，所以很多学者和公司开始关注和推广这项技术，目前来看，前景非常广阔，而且很早之前Seurat就推出了WNN（Weighted Nearest Neighbor Analysis）分析，用于分析从一个细胞得到的多组学数据，大家可以参考我之前分享的文章,Seurat4版本的WNN的运行与原理与softmax。
注意一点，10X单细胞核转录组 + 10X单细胞ATAC技术和一个样本分成两份，分别测转录组信息和ATAC信息的联合分析方法完全不一样，WNN也不简单的就是一一对应起来，而是相互辅助进行数据分析，非常重要，一定要认真明白其中的原理和方法，采用合适的分析策略。
示例代码
同时测量多种模态，称为多模态分析，代表了单细胞基因组学的一个令人兴奋的前沿领域，需要新的计算方法来定义基于多种数据类型的细胞状态。 每种模态的不同信息内容，即使在同一数据集中的细胞之间，也代表了对多模态数据集的分析和整合的紧迫挑战。 在 (Hao, Hao et al, Cell 2021) 中，我们引入了“加权最近邻”(WNN) 分析，这是一种无监督框架，用于学习每个单元格中每种数据类型的相对效用，从而能够对多种模态进行综合分析 。（相对效用这个大家要重点关注一下）。
WNN analysis of 10x Multiome, RNA + ATAC
Here, we demonstrate the use of WNN analysis to a second multimodal technology, the 10x multiome RNA+ATAC kit. We use a dataset that is publicly available on the 10x website, where paired transcriptomes and ATAC-seq profiles are measured in 10,412 PBMCs.
- Create a multimodal Seurat object with paired transcriptome and ATAC-seq profiles
- Perform weighted neighbor clustering on RNA+ATAC data in single cells
- Leverage both modalities to identify putative regulators of different cell types and states
加载包
library(Seurat)
library(Signac)
library(EnsDb.Hsapiens.v86)
library(dplyr)
library(ggplot2)
我们将根据基因表达数据创建一个 Seurat 对象，然后添加 ATAC-seq 数据作为第二个检测。
# the 10x hdf5 file contains both data types.
inputdata.10x <- Read10X_h5("../data/pbmc_granulocyte_sorted_10k_filtered_feature_bc_matrix.h5")
# extract RNA and ATAC data
rna_counts <- inputdata.10x$`Gene Expression`
atac_counts <- inputdata.10x$Peaks
# Create Seurat object
pbmc <- CreateSeuratObject(counts = rna_counts)
pbmc[["percent.mt"]] <- PercentageFeatureSet(pbmc, pattern = "^MT-")
# Now add in the ATAC-seq data
# we'll only use peaks in standard chromosomes
grange.counts <- StringToGRanges(rownames(atac_counts), sep = c(":", "-"))
grange.use <- seqnames(grange.counts) %in% standardChromosomes(grange.counts)
atac_counts <- atac_counts[as.vector(grange.use), ]
annotations <- GetGRangesFromEnsDb(ensdb = EnsDb.Hsapiens.v86)
seqlevelsStyle(annotations) <- 'UCSC'
genome(annotations) <- "hg38"
frag.file <- "../data/pbmc_granulocyte_sorted_10k_atac_fragments.tsv.gz"
chrom_assay <- CreateChromatinAssay(
counts = atac_counts,
sep = c(":", "-"),
genome = 'hg38',
fragments = frag.file,
min.cells = 10,
annotation = annotations
)
pbmc[["ATAC"]] <- chrom_assay
我们根据每种模式检测到的分子数量以及线粒体百分比执行基本 QC。
VlnPlot(pbmc, features = c("nCount_ATAC", "nCount_RNA","percent.mt"), ncol = 3,
log = TRUE, pt.size = 0) + NoLegend()
pbmc <- subset(
x = pbmc,
subset = nCount_ATAC < 7e4 &
nCount_ATAC > 5e3 &
nCount_RNA < 25000 &
nCount_RNA > 1000 &
percent.mt < 20
)
接下来，我们使用 RNA 和 ATAC-seq 数据的标准方法，独立地对两种检测进行预处理和降维。
# RNA analysis
DefaultAssay(pbmc) <- "RNA"
pbmc <- SCTransform(pbmc, verbose = FALSE) %>% RunPCA() %>% RunUMAP(dims = 1:50, reduction.name = 'umap.rna', reduction.key = 'rnaUMAP_')
# ATAC analysis
# We exclude the first dimension as this is typically correlated with sequencing depth
DefaultAssay(pbmc) <- "ATAC"
pbmc <- RunTFIDF(pbmc)
pbmc <- FindTopFeatures(pbmc, min.cutoff = 'q0')
pbmc <- RunSVD(pbmc)
pbmc <- RunUMAP(pbmc, reduction = 'lsi', dims = 2:50, reduction.name = "umap.atac", reduction.key = "atacUMAP_")
We calculate a WNN graph, representing a weighted combination of RNA and ATAC-seq modalities. We use this graph for UMAP visualization and clustering
pbmc <- FindMultiModalNeighbors(pbmc, reduction.list = list("pca", "lsi"), dims.list = list(1:50, 2:50))
pbmc <- RunUMAP(pbmc, nn.name = "weighted.nn", reduction.name = "wnn.umap", reduction.key = "wnnUMAP_")
pbmc <- FindClusters(pbmc, graph.name = "wsnn", algorithm = 3, verbose = FALSE)
We annotate the clusters below.
# perform sub-clustering on cluster 6 to find additional structure
pbmc <- FindSubCluster(pbmc, cluster = 6, graph.name = "wsnn", algorithm = 3)
Idents(pbmc) <- "sub.cluster"
# add annotations
pbmc <- RenameIdents(pbmc, '19' = 'pDC','20' = 'HSPC','15' = 'cDC')
pbmc <- RenameIdents(pbmc, '0' = 'CD14 Mono', '9' ='CD14 Mono', '5' = 'CD16 Mono')
pbmc <- RenameIdents(pbmc, '10' = 'Naive B', '11' = 'Intermediate B', '17' = 'Memory B', '21' = 'Plasma')
pbmc <- RenameIdents(pbmc, '7' = 'NK')
pbmc <- RenameIdents(pbmc, '4' = 'CD4 TCM', '13'= "CD4 TEM", '3' = "CD4 TCM", '16' ="Treg", '1' ="CD4 Naive", '14' = "CD4 Naive")
pbmc <- RenameIdents(pbmc, '2' = 'CD8 Naive', '8'= "CD8 Naive", '12' = 'CD8 TEM_1', '6_0' = 'CD8 TEM_2', '6_1' ='CD8 TEM_2', '6_4' ='CD8 TEM_2')
pbmc <- RenameIdents(pbmc, '18' = 'MAIT')
pbmc <- RenameIdents(pbmc, '6_2' ='gdT', '6_3' = 'gdT')
pbmc$celltype <- Idents(pbmc)
我们可以可视化基于基因表达、ATAC-seq 或 WNN 分析的聚类。 差异比之前的分析更微妙，但我们发现 WNN 提供了最清晰的细胞状态分离。
p1 <- DimPlot(pbmc, reduction = "umap.rna", group.by = "celltype", label = TRUE, label.size = 2.5, repel = TRUE) + ggtitle("RNA")
p2 <- DimPlot(pbmc, reduction = "umap.atac", group.by = "celltype", label = TRUE, label.size = 2.5, repel = TRUE) + ggtitle("ATAC")
p3 <- DimPlot(pbmc, reduction = "wnn.umap", group.by = "celltype", label = TRUE, label.size = 2.5, repel = TRUE) + ggtitle("WNN")
p1 + p2 + p3 & NoLegend() & theme(plot.title = element_text(hjust = 0.5))
例如，ATAC-seq 数据有助于分离 CD4 和 CD8 T 细胞状态。 这是由于存在多个基因座，这些基因座在不同 T 细胞亚型之间表现出不同的可及性。
## to make the visualization easier, subset T cell clusters
celltype.names <- levels(pbmc)
tcell.names <- grep("CD4|CD8|Treg", celltype.names,value = TRUE)
tcells <- subset(pbmc, idents = tcell.names)
CoveragePlot(tcells, region = 'CD8A', features = 'CD8A', assay = 'ATAC', expression.assay = 'SCT', peaks = FALSE)
Next, we will examine the accessible regions of each cell to determine enriched motifs. 有几种方法可以做到这一点，但我们将使用 Greenleaf 实验室的 chromVAR 包。 这会计算已知基序的每个细胞可访问性分数，并将这些分数添加为 Seurat 对象中的第三个检测 (chromvar)。
加载数据
library(chromVAR)
library(JASPAR2020)
library(TFBSTools)
library(motifmatchr)
library(BSgenome.Hsapiens.UCSC.hg38)
# Scan the DNA sequence of each peak for the presence of each motif, and create a Motif object
DefaultAssay(pbmc) <- "ATAC"
pwm_set <- getMatrixSet(x = JASPAR2020, opts = list(species = 9606, all_versions = FALSE))
motif.matrix <- CreateMotifMatrix(features = granges(pbmc), pwm = pwm_set, genome = 'hg38', use.counts = FALSE)
motif.object <- CreateMotifObject(data = motif.matrix, pwm = pwm_set)
pbmc <- SetAssayData(pbmc, assay = 'ATAC', slot = 'motifs', new.data = motif.object)
# Note that this step can take 30-60 minutes
pbmc <- RunChromVAR(
object = pbmc,
genome = BSgenome.Hsapiens.UCSC.hg38
)
最后，我们探索多模态数据集以识别每个细胞状态的关键调节器。 配对数据提供了一个独特的机会来识别满足多个标准的转录因子 (TF)，有助于将推定的调节器列表缩小到最有可能的候选者。 我们的目标是识别在 RNA 测量中在多种细胞类型中表达丰富的 TF，但在 ATAC 测量中也丰富了其基序的可及性。
作为示例和阳性对照，CCAAT 增强子结合蛋白 (CEBP) 蛋白家族，包括 TF CEBPB，已反复证明在包括单核细胞和树突细胞在内的骨髓细胞的分化和功能中发挥重要作用。 我们可以看到 CEBPB 的表达和 MA0466.2.4 基序（编码 CEBPB 的结合位点）的可及性都富含单核细胞。
#returns MA0466.2
motif.name <- ConvertMotifID(pbmc, name = 'CEBPB')
gene_plot <- FeaturePlot(pbmc, features = "sct_CEBPB", reduction = 'wnn.umap')
motif_plot <- FeaturePlot(pbmc, features = motif.name, min.cutoff = 0, cols = c("lightgrey", "darkred"), reduction = 'wnn.umap')
gene_plot | motif_plot
量化这种关系，并在所有细胞类型中搜索以找到类似的例子。 为此，我们将使用 presto 包来执行快速差分表达。 我们进行了两项测试：一项使用基因表达数据，另一项使用 chromVAR 基序可访问性。 presto 根据 Wilcox 秩和检验计算 p 值，这也是 Seurat 中的默认检验，我们将搜索限制为在两个检验中都返回显着结果的 TF。
presto 还计算“AUC”统计数据，它反映了每个基因（或基序）作为细胞类型标记的能力。 最大 AUC 值为 1 表示完美标记。 由于基因和基序的 AUC 统计量在同一尺度上，我们取两个测试的 AUC 值的平均值，并使用它来对每种细胞类型的 TF 进行排序：
markers_rna <- presto:::wilcoxauc.Seurat(X = pbmc, group_by = 'celltype', assay = 'data', seurat_assay = 'SCT')
markers_motifs <- presto:::wilcoxauc.Seurat(X = pbmc, group_by = 'celltype', assay = 'data', seurat_assay = 'chromvar')
motif.names <- markers_motifs$feature
colnames(markers_rna) <- paste0("RNA.", colnames(markers_rna))
colnames(markers_motifs) <- paste0("motif.", colnames(markers_motifs))
markers_rna$gene <- markers_rna$RNA.feature
markers_motifs$gene <- ConvertMotifID(pbmc, id = motif.names)
# a simple function to implement the procedure above
topTFs <- function(celltype, padj.cutoff = 1e-2) {
ctmarkers_rna <- dplyr::filter(
markers_rna, RNA.group == celltype, RNA.padj < padj.cutoff, RNA.logFC > 0) %>%
arrange(-RNA.auc)
ctmarkers_motif <- dplyr::filter(
markers_motifs, motif.group == celltype, motif.padj < padj.cutoff, motif.logFC > 0) %>%
arrange(-motif.auc)
top_tfs <- inner_join(
x = ctmarkers_rna[, c(2, 11, 6, 7)],
y = ctmarkers_motif[, c(2, 1, 11, 6, 7)], by = "gene"
)
top_tfs$avg_auc <- (top_tfs$RNA.auc + top_tfs$motif.auc) / 2
top_tfs <- arrange(top_tfs, -avg_auc)
return(top_tfs)
}
We can now compute, and visualize, putative regulators for any cell type.
# identify top markers in NK and visualize
head(topTFs("NK"), 3)
## RNA.group gene RNA.auc RNA.pval motif.group motif.feature motif.auc
## 1 NK TBX21 0.7264660 0.000000e+00 NK MA0690.1 0.9223858
## 2 NK EOMES 0.5895889 1.552097e-100 NK MA0800.1 0.9263286
## 3 NK RUNX3 0.7722418 7.131401e-122 NK MA0684.2 0.7083570
## motif.pval avg_auc
## 1 2.343664e-211 0.8244259
## 2 2.786462e-215 0.7579587
## 3 7.069675e-53 0.7402994
motif.name <- ConvertMotifID(pbmc, name = 'TBX21')
gene_plot <- FeaturePlot(pbmc, features = "sct_TBX21", reduction = 'wnn.umap')
motif_plot <- FeaturePlot(pbmc, features = motif.name, min.cutoff = 0, cols = c("lightgrey", "darkred"), reduction = 'wnn.umap')
gene_plot | motif_plot
# identify top markers in pDC and visualize
## RNA.group gene RNA.auc RNA.pval motif.group motif.feature motif.auc
## 1 pDC TCF4 0.9998833 3.347777e-163 pDC MA0830.2 0.9959622
## 2 pDC IRF8 0.9905372 2.063258e-124 pDC MA0652.1 0.8814713
## 3 pDC SPIB 0.9114648 0.000000e+00 pDC MA0081.2 0.8997955
## motif.pval avg_auc
## 1 2.578226e-69 0.9979228
## 2 9.702602e-42 0.9360043
## 3 1.130040e-45 0.9056302
motif.name <- ConvertMotifID(pbmc, name = 'TCF4')
gene_plot <- FeaturePlot(pbmc, features = "sct_TCF4", reduction = 'wnn.umap')
motif_plot <- FeaturePlot(pbmc, features = motif.name, min.cutoff = 0, cols = c("lightgrey", "darkred"), reduction = 'wnn.umap')
gene_plot | motif_plot
# identify top markers in HSPC and visualize
head(topTFs("CD16 Mono"),3)
## RNA.group gene RNA.auc RNA.pval motif.group motif.feature motif.auc
## 1 CD16 Mono SPI1 0.8764099 4.116679e-291 CD16 Mono MA0080.5 0.8831213
## 2 CD16 Mono CEBPB 0.8675114 8.321489e-292 CD16 Mono MA0466.2 0.7859496
## 3 CD16 Mono MEF2C 0.7132221 4.210640e-79 CD16 Mono MA0497.1 0.7986104
## motif.pval avg_auc
## 1 3.965856e-188 0.8797656
## 2 1.092808e-105 0.8267305
## 3 4.462855e-115 0.7559162
motif.name <- ConvertMotifID(pbmc, name = 'SPI1')
gene_plot <- FeaturePlot(pbmc, features = "sct_SPI1", reduction = 'wnn.umap')
motif_plot <- FeaturePlot(pbmc, features = motif.name, min.cutoff = 0, cols = c("lightgrey", "darkred"), reduction = 'wnn.umap')
gene_plot | motif_plot
不同的技术需要用到不同的方法，大家需要注意留心
生活很好，等你超越
568
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
