单细胞加权基因共表达网络分析scWGCNA-01

scWGCNA是一个生物信息学工作流程，是R包WGCNA的附加组件，用于在单细胞或单核RNA-seq数据集中进行加权基因共表达网络分析。WGCNA最初是为分析大量基因表达数据集而构建的，由于scRNA-seq数据的固有稀疏性，vanilla WGCNA在单细胞数据上的性能受到限制。为了解决这个问题，scWGCNA在运行WGCNA分析之前将转录表达谱相似的细胞聚集成pseudo-bulk元细胞。

scWGCNA代码比较简短，对WGCNA的原有算法的一种改进，以适应单细胞稀疏矩阵（很多表达为0）；

该包只包含两个函数metacells_by_groups和construct_metacells，construct_metacells()函数将 Seurat 对象，基于knn算法，将相邻细胞构建平均的“元细胞”（averaged metacells）。

github网站：https://github.com/smorabit/scWGCNA
在线教程：https://smorabit.github.io/tutorials/9_scWGCNA_tutorial

作者在2021年nature genetics发表的文章Single-nucleus chromatin accessibility and transcriptomic characterization of Alzheimer's disease中应用了此算法。

1. 先决条件

运行 scWGCNA，需要有一个 Seurat 格式的单细胞转录组数据集，且已经进行聚类和降维。

2. scWGCNA安装

# 要运行scWGCNA，需要安装其他一些R包
install.packages('WGCNA') 
install.packages('igraph') 
install.packages('devtools') 
# install Seurat, check their website for the most up-to-date instructions 
install.packages('Seurat')

devtools::install_github('smorabit/scWGCNA')

library(scWGCNA)

3. scWGCNA实例教程

官方教程介绍从操作Seurat 对象到构建metacells逐步展开分析。 如果你已经有一个已聚类的数据集，你可以跳过接下来的前两部分，从“构建metacells”部分开始分析。

3.1 聚类和降维

首先，从已发表的人类大脑健康和疾病的 snRNA-seq 研究中收集了几个数据集，总计超过 50 万个单核转录组细胞。这些数据集都满足scWGCNA 的先决条件，并且可以通过许多不同的方式进行聚类/降维。由于处理来自多个来源的数据，因此使用online iNMF来构建不受批次或数据来源影响的降维，以反映潜在的细胞异质性。

代码中总共包含9个文献数据集，数据非常不容易下载，先放弃实操。

step1: 将9个seurat对象merge在一起，生成seurat_obj对象，进行Normalize归一化和scale处理；
step2: 提取9个数据集的基因表达矩阵，生成expression_list，构建Liger对象，Liger是一种去批次，多数据集整合方法，跟SCTransform-CCA，Harmony方法类似。对Liger对象进行如下操作：1）normalize，scale等预处理；2）执行online iNMF；3) quantile归一化。将liger_obj保存为9_datasets_online_liger.rds。
step3：将iNMF坐标转移至seurat_obj，我们之前的seurat_obj降维方式通常只有pca，umap，tsne，现在将增加iNMF降维，另外，用liger_obj的umap坐标替换掉seurat_obj的坐标。将修改后的seurat_obj保存为9_datasets_online_seurat.rds。

library(Seurat) 
library(Matrix) 
library(tidyverse) 
library(rliger) 
data_dir <- "data/" 

# load individual seurat objects: 
seurat_trem2 <- readRDS(file=paste0(data_dir, 'seurat_objects/trem2_nmed_unprocessed.rds')) 
seurat_allen <- readRDS(file=paste0(data_dir, 'seurat_objects/allen_brain_map_2020_unprocessed.rds')) 
seurat_jakel <- readRDS(file=paste0(data_dir, 'seurat_objects/jakel_2019_unprocessed.rds')) 
seurat_grubman <- readRDS(file=paste0(data_dir, 'seurat_objects/grubman_2019_unprocessed.rds')) 
seurat_schirmer <- readRDS(file=paste0(data_dir, 'seurat_objects/schirmer_2019_unprocessed.rds')) 
seurat_velmeshev <- readRDS(file=paste0(data_dir, 'seurat_objects/velmeshev_2019_unprocessed.rds')) 
seurat_swarup_splitseq <- readRDS(file=paste0(data_dir, 'seurat_objects/swarup_AD_splitseq_2019_unprocessed.rds')) 
seurat_swarup <- readRDS(file=paste0(data_dir, 'seurat_objects/swarup_AD_2019_unprocessed.rds')) 
seurat_tsai <- readRDS(file=paste0(data_dir, 'seurat_objects/tsai_AD_2019_unprocessed.rds')) 
# make one big merged Seurat object: 
seurat_obj <- merge(c(seurat_trem2, seurat_allen, seurat_jakel, seurat_grubman, seurat_schirmer, seurat_velmeshev, seurat_swarup_splitseq, seurat_swarup, seurat_tsai)) 
# Normalize and scale data: 
seurat_obj <- NormalizeData(seurat_obj) 
seurat_obj <- ScaleData(seurat_obj) 
# make a list of expression matrices: 
expression_list <- list( 
  'trem2' = GetAssayData(seurat_trem2, slot='counts'), 
  'allen'= GetAssayData(seurat_allen, slot='counts'), 
  'jakel'= GetAssayData(seurat_jakel, slot='counts'), 
  'grubman'= GetAssayData(seurat_grubman, slot='counts'), 
  'schirmer'= GetAssayData(seurat_schirmer, slot='counts'), 
  'velmeshev'= GetAssayData(seurat_velmeshev, slot='counts'), 
  'swarup_splitseq'= GetAssayData(seurat_swarup_splitseq, slot='counts'), 
  'swarup_AD'= GetAssayData(seurat_swarup, slot='counts'), 
  'mathys'= GetAssayData(seurat_tsai, slot='counts') 
) 
# append dataset names to barcodes: 
for(dataset in names(expression_list)){ 
  colnames(expression_list[[dataset]]) <- paste0(dataset, '_', colnames(expression_list[[dataset]])) 
} 
# combined metadata: 
meta_columns <- c('orig.ident', 'nCount_RNA', 'nFeature_RNA', 'Age', 'Sex', 'Condition', 'Condition_specific', 'Batch', 'SampleID', 'DonorID', 'Original_cluster', 'Dataset', 'Tissue', 'Technology' ) 
seurat_meta <- rbind( 
  [email protected][,meta_columns], 
  [email protected][,meta_columns], 
  [email protected][,meta_columns], 
  [email protected][,meta_columns], 
  [email protected][,meta_columns], 
  [email protected][,meta_columns], 
  [email protected][,meta_columns], 
  [email protected][,meta_columns], 
  [email protected][,meta_columns] 
) 
rownames(seurat_meta) <- paste0(seurat_meta$Dataset, '_', rownames(seurat_meta)) 
# remove individual seurat objects to save space: 
rm(seurat_trem2, seurat_allen, seurat_jakel, seurat_grubman, seurat_schirmer, seurat_velmeshev, seurat_swarup, seurat_swarup_splitseq, seurat_tsai); gc(); 
# create liger object: 
liger_obj <- createLiger(expression_list) 
# pre-processing 
liger_obj <- normalize(liger_obj) 
liger_obj <- selectGenes(liger_obj,) 
liger_obj <- scaleNotCenter(liger_obj) 
# perform online iNMF 
liger_obj = online_iNMF(liger_obj, k=50, max.epochs=5) 
# quantile normalization 
liger_obj  = quantile_norm(liger_obj) 
liger_obj  = runUMAP(liger_obj) 
saveRDS(liger_obj, file=paste0(data_dir, '9_datasets_online_liger.rds')) 
# transfer iNMF matrix to seurat obj: 
seurat_obj@reductions$iNMF <- CreateDimReducObject( 
    loadings=t(liger_obj@W), 
    [email protected][colnames(seurat_obj),], 
    key="iNMF_", 
    assay="RNA" 
) 
# add UMAP: 
seurat_obj@reductions$UMAP <- CreateDimReducObject( 
  embeddings = [email protected][colnames(seurat_obj),], 
  key='umap', 
  assay='RNA' 
) 
# add clusters from liger 
[email protected]$liger_clusters <- liger_obj@clusters 
saveRDS(seurat_obj, file=paste0(data_dir, '9_datasets_online_seurat.rds'))

---

问题1：liger_obj进行runUMAP降维，但是在后面的代码中，出现[email protected]，有点看不懂，是不是误写？

seurat_obj@reductions$UMAP <- CreateDimReducObject( 
  embeddings = [email protected][colnames(seurat_obj),],  
  key='umap', 
  assay='RNA' 
)

找同行确认了下，这应该是作者误写。

image.png

问题2：seurat_meta整合9个样本的meta.data信息（orig.ident，nCount_RNA等），但是代码中没有将seurat_meta赋值给[email protected]或[email protected]， 也没有保存？

[email protected] <- seurat_meta
[email protected] <- seurat_meta

---

下图是用online iNMF整合方法得到的UMAP聚类图

image

3.2 获取感兴趣的特定细胞类型子集

为了识别给定细胞类型内的共表达模块，作者仅使用数据的一个子集重复上述分析。在这里，我们对感兴趣的少突胶质细胞谱系细胞进行这种分析，包括少突胶质祖细胞和成熟的少突胶质细胞。
step1：从seurat_obj提取细胞类型为ODC，OPC的子集seurat_odc；同上述操作，对seurat_odc数据集进行iNMF整合，降维，将liger_obj保存为ODC_9_datasets_online_liger.rds。
step2：将iNMF坐标转移至seurat_odc，命名为ctiNMF，这将新增ctiNMF降维方式（类似于pca），seurat_odc对象scale处理后，基于ctiNMF进行umap降维，将生成的seurat_odc保存为9_datasets_ODC_seurat.rds。

# subset by neuronal clusters
seurat_odc <- subset(seurat_obj, celltype %in% c('ODC', 'OPC'))

# iNMF for just ODCs:
expr_matrix <- GetAssayData(seurat_odc, slot='counts')

expression_list <- list(
  'zhou' = expr_matrix[,colnames(seurat_odc)[seurat_odc$Dataset == 'zhou']],
  'allen'= expr_matrix[,colnames(seurat_odc)[seurat_odc$Dataset == 'allen']],
  'jakel'= expr_matrix[,colnames(seurat_odc)[seurat_odc$Dataset == 'jakel']],
  'grubman'= expr_matrix[,colnames(seurat_odc)[seurat_odc$Dataset == 'grubman']],
  'schirmer'= expr_matrix[,colnames(seurat_odc)[seurat_odc$Dataset == 'schirmer']],
  'velmeshev'= expr_matrix[,colnames(seurat_odc)[seurat_odc$Dataset == 'velmeshev']],
  'swarup_splitseq'= expr_matrix[,colnames(seurat_odc)[seurat_odc$Dataset == 'swarup_splitseq']],
  'swarup_AD'= expr_matrix[,colnames(seurat_odc)[seurat_odc$Dataset == 'swarup_AD_2020']],
  'mathys'= expr_matrix[,colnames(seurat_odc)[seurat_odc$Dataset == 'mathys']]
)

seurat_meta <- rbind(
  subset([email protected], Dataset=='zhou'),
  subset([email protected], Dataset=='allen'),
  subset([email protected], Dataset=='jakel'),
  subset([email protected], Dataset=='grubman'),
  subset([email protected], Dataset=='schirmer'),
  subset([email protected], Dataset=='velmeshev'),
  subset([email protected], Dataset=='swarup_splitseq'),
  subset([email protected], Dataset=='swarup_AD_2020'),
  subset([email protected], Dataset=='mathys')
)

# create liger object:
liger_obj <- createLiger(expression_list)

liger_obj <- normalize(liger_obj)
pdf("liger_variable_genes.pdf", width=8, height=8)
liger_obj <- selectGenes(
  liger_obj,
  var.thresh =c(0.05, 0.15, 0.025, 0.025, 0.075, 0.075, 0.05, 0.20, 0.025),
  do.plot=T
)
dev.off()
[email protected] %>% length
liger_obj <- scaleNotCenter(liger_obj)

# perform online iNMF
liger_obj = online_iNMF(liger_obj, k=20, max.epochs=5)

# quantile normalization
liger_obj  = quantile_norm(liger_obj)
liger_obj  = runUMAP(liger_obj)

saveRDS(liger_obj, file='ODC_9_datasets_online_liger.rds')

# transfer iNMF matrix to seurat obj:
seurat_odc@reductions$ctiNMF <- CreateDimReducObject(
    loadings=t(liger_obj@W),
    [email protected][colnames(seurat_odc),],
    key="ctiNMF_",
    assay="RNA"
  )
VariableFeatures(seurat_odc) <- [email protected]

# scale expression data:
seurat_odc <- ScaleData(seurat_odc, features=VariableFeatures(seurat_odc))

# UMAP + clustering:
seurat_odc <- RunUMAP(seurat_odc, reduction='ctiNMF', dims=1:20)

# save the results
saveRDS(seurat_odc, file ='9_datasets_ODC_seurat.rds')

# optional: format for use in Scanpy
library(SeuratDisk)
SaveH5Seurat(cur_save, filename = "9_datasets_ODC_seurat.h5Seurat", overwrite=TRUE)
Convert("9_datasets_ODC_seurat.h5Seurat", dest='h5ad', overwrite=TRUE)

下面可以看到少突胶质细胞谱系 细胞的UMAP聚类图，作者根据已知标记基因将其分为 4 个主要cluster。

image

3.3 构建metacells

现在我们准备构建metacells。为了节省内存，我们只使用高可变基因来构建metacells并执行下游 WGCNA分析。 可以使用 HVG基因，也可以用所有基因，下游结果将基因数目的差异而有所不同。因此，你可以重新运行此步骤以尝试不同的参数。

step1：这个数据集有几种不同的疾病处理条件，但是，我们只想聚合相同条件下的细胞，即odc_group和Condition属性一致的细胞群。 因此，我们在 Seurat 对象中创建了一个新的metadata列metacell_group ，它将 ODC 亚群(odc_group)与处理条件(Condition)组合在一起。

step2：接下来，我们将来自同一 ODC 亚群和相同疾病处理组的细胞群构建metacells。construct_metacells()函数有一个关键参数是 k，有多少个细胞合并成一个metacells。 这里我们使用了一个较大数值 100，这仅仅是因为我们这里的数据集非常大。 你可以根据数据集中的细胞数来调整 k 值大小。我只是通过 for 循环单线程运行它，当然，您可以更快速，例如，如果您要将每个调用construct_metacells函数的程序投入到HPC计算节点，实现并行运算。该construct_metacells() 函数输出一个新的Seurat 对象，包含聚合后的基因表达谱。

step3：将每个metacell_group构建好的metacells(Seurat 对象)进行merge，scale缩放，Harmony整合，umap聚类。

# load scWGCNA package
library(scWGCNA)

# construct metacells by ODC group, condition
seurat_odc$metacell_group <- paste0(
  as.character(seurat_odc$odc_group), '_',
  as.character(seurat_odc$Condition)
)

genes.keep <- VariableFeatures(seurat_odc)

# loop through each group and construct metacells
seurat_list <- list()
for(group in unique(seurat_odc$metacell_group)){
  print(group)
  cur_seurat <- subset(seurat_odc, metacell_group == group)
  cur_seurat <- cur_seurat[genes.keep,]
  cur_metacell_seurat <- scWGCNA::construct_metacells(
    cur_seurat, name=group,
    k=100, reduction='umap',
    assay='RNA', slot='data'
  )
  cur_metacell_seurat$Condition <- as.character(unique(cur_seurat$Condition))
  cur_metacell_seurat$odc_group <- as.character(unique(cur_seurat$odc_group))
  seurat_list[[group]] <- cur_metacell_seurat
}

# merge all of the metacells objects
metacell_seurat <- merge(seurat_list[[1]], seurat_list[2:length(seurat_list)])
saveRDS(metacell_seurat, file='data/metacell_seurat.rds')

Optionally, we can run a dimensionality reduction on the metacell Seurat object to check if some cellular heterogeneity has been retained. The differences in the transcriptional profiles of the different disease groups are quite prominent in the UMAP space, so I am harmonizing the data on the basis of condition merely for visualization purposes.

metacell_subset <- ScaleData(metacell_subset, features = rownames(metacell_subset))
metacell_subset <- RunPCA(metacell_subset, features=rownames(metacell_subset))
metacell_subset <- RunHarmony(metacell_subset, group.by='Condition', dims=1:15)
metacell_subset <- RunUMAP(metacell_subset, reduction='harmony', dims=1:15)

pdf(paste0(fig_dir, "metacell_umap_group.pdf"), width=6, height=6)
DimPlot(metacell_subset, group.by='odc_group', reduction='umap', label=TRUE) + umap_theme
dev.off()

由下图可以看出，通过construct_metacells处理后的seurat对象在umap图中仍有很好地分离。

image.png

前面代码最关键的一步是construct_metacells，将cur_seurat转成cur_metacell_seurat ，我们看下源码，这步做了什么处理。

construct_metacells <- function(seurat_obj, name='agg', k=50, reduction='umap', assay='RNA', slot='data'){
  reduced_coordinates <- as.data.frame(seurat_obj@reductions[[reduction]]@cell.embeddings)
  nn_map <- FNN::knn.index(reduced_coordinates, k = (k - 1))
  row.names(nn_map) <- row.names(reduced_coordinates)
  nn_map <- cbind(nn_map, seq_len(nrow(nn_map)))
  good_choices <- seq_len(nrow(nn_map))
  choice <- sample(seq_len(length(good_choices)), size = 1,
      replace = FALSE)
  chosen <- good_choices[choice]
  good_choices <- good_choices[good_choices != good_choices[choice]]
  it <- 0
  k2 <- k * 2
  get_shared <- function(other, this_choice) {
      k2 - length(union(cell_sample[other, ], this_choice))
  }
  while (length(good_choices) > 0 & it < 5000) {
      it <- it + 1
      choice <- sample(seq_len(length(good_choices)), size = 1,
          replace = FALSE)
      new_chosen <- c(chosen, good_choices[choice])
      good_choices <- good_choices[good_choices != good_choices[choice]]
      cell_sample <- nn_map[new_chosen, ]
      others <- seq_len(nrow(cell_sample) - 1)
      this_choice <- cell_sample[nrow(cell_sample), ]
      shared <- sapply(others, get_shared, this_choice = this_choice)

      if (max(shared) < 0.9 * k) {
          chosen <- new_chosen
      }
  }

  cell_sample <- nn_map[chosen, ]
  combs <- combn(nrow(cell_sample), 2)
  shared <- apply(combs, 2, function(x) {
      k2 - length(unique(as.vector(cell_sample[x, ])))
  })

  message(paste0("Overlap QC metrics:\nCells per bin: ",
      k, "\nMaximum shared cells bin-bin: ", max(shared),
      "\nMean shared cells bin-bin: ", mean(shared), "\nMedian shared cells bin-bin: ",
      median(shared)))
  if (mean(shared)/k > 0.1)
      warning("On average, more than 10% of cells are shared between paired bins.")

  exprs_old <- GetAssayData(seurat_obj, assay=assay, slot=slot)

  mask <- sapply(seq_len(nrow(cell_sample)), function(x) seq_len(ncol(exprs_old)) %in%
      cell_sample[x, , drop = FALSE])
  mask <- Matrix::Matrix(mask)
  new_exprs <- (exprs_old %*% mask) / k
  colnames(new_exprs) <- paste0(name, '_', 1:ncol(new_exprs))
  rownames(cell_sample) <- paste0(name, '_', 1:ncol(new_exprs))
  colnames(cell_sample) <- paste0('knn_', 1:ncol(cell_sample))

  # make seurat obj:
  seurat_aggr <- CreateSeuratObject(
    counts = new_exprs
  )
  seurat_aggr
}

代码解析：

1.假设seurat_obj对象有5000个细胞，10000个基因，即5000*10000的基因表达矩阵。提取seurat_obj对象的umap坐标信息(umap1,umap2)，生成reduced_coordinates(5000*2矩阵)。

2.利用FNN快速最近邻搜索算法，为每个细胞寻找99个最近邻细胞，nn_map为5000*99矩阵；第1-99列均为最临近细胞的次序号；

添加第100列，为当前细胞自身的次序号；nn_map为5000*100矩阵；99个邻近细胞加上自身细胞，共100个。

3.随机从5000个细胞中抽取一个细胞，如编号为2000的细胞N2000，然后从剩下的4999个细胞中再随机抽取一个编号N100细胞，计算N2000和N100的最临近细胞群数目(200个细胞编号)，对着200个细胞编号，取其并集，如满足max(shared) < 0.9 * k条件，也就是说，如果这两细胞越相似，他们的共享邻居应该越多，把N2000和N100细胞合并成chosen组，反之亦然。接着从剩下的细胞群抽取，与上一步的chosen 组比较，看相似程度，迭代5000次，把相似的细胞编号放入chosen组。
4.通过上一步的找邻居策略，chosen组为2000个，5000个总细胞群，有2000个最相似的最近邻居群， cell_sample为2000*100矩阵。

5.2000个细胞两两比较，查看共有邻居数，统计max(shared)，median(shared)，mean(shared)。
6.提取5000*10000的基因表达矩阵exprs_old ，(exprs_old %*% mask) / k的计算是2000个细胞邻近细胞群的平均表达量，转换成2000*10000，即5000个细胞由2000个细胞所代表，数据集也实现了降维。

construct_metacells算法小结：

1.seurat_obj对象有5000个细胞，10000个基因，是5000*10000的基因表达矩阵；设置参数k=100，通过KNN算法查找100个最临近邻居群（包括自身细胞），如A细胞，找99个邻居，加上自己，共100个。
2.指定一套筛选相似细胞策略，将细胞的邻居群相互比较，保留相似的细胞，5000个细胞保留了最相似的2000个细胞，用这2000个细胞代表整体细胞。
3.之前是5000*10000的基因表达矩阵，新的基因表达矩阵是：2000个细胞的邻居群(100个细胞)的平均基因表达量，如A细胞的gene1表达量为100个邻居群在gene1的表达平均值，因此新矩阵为2000*10000，剔除了噪音数据，也实现了数据降维。这应该也是处理单细胞表达谱的一种数据处理策略。