seurat单细胞转录组整合分析教程-01

前段时间跟师兄聊天，聊到seurat包，他说学软件一定要知道这个软件开发的目的，它是要解决哪些主要问题，哪些是次要问题，次要问题其他R包同样解决，他开发的主线是什么。单细胞多样本数据集的整合无疑是最核心的问题，数据没有整合好，也无从谈后续的下游分析。数据集“各自为政”，都不处在同一个cluster，后续如何比较分析。
所以，还是想抽空梳理下单细胞数据是如何整合的。

一、影响单细胞数据整合的因素

影响数据整合的主要因素有：

批次效应(Batch Effect)
批次效应是源自许多不同的技术上(technical) 因素，而造成样本细胞群上的不同，例如：非同批次处理的样本、不同实验人员的操作等。而这些数据如果没有处理就直接分析，会导致我们错误解读样本，对样本间的异质性存在误判；也就是说，明明是技术上造成的差异，却让我们认为是不同处理的样本间具有生物意义上的差异。
单细胞数据存在dropouts(零值)
由于测序深度和数据覆盖率不足，数据的“dropouts”事件的普遍存在是单细胞数据的严重问题，即其中一个基因在一个细胞中以低或中等表达水平观察到，但在同一细胞类型的另一个细胞中未检测到。这些丢失事件的发生是由于单个细胞中 mRNA 的含量低和 mRNA 捕获效率低下，以及 mRNA 表达的随机性。由于 dropouts，scRNA-seq 数据通常非常稀疏，基因表达式矩阵中由 dropout 效应而产生的大量的随机零值。通常，单个细胞数据在表达式矩阵中具有60-80%的零元素。过多的零计数导致数据零膨胀，仅捕获每个细胞转录组的一小部分，这给数据整合，聚类和下游分析等带来了困难。
虽然目前有针对单细胞数据的零值填充数据校正算法，通过推断dropouts事件，用推断出的合适的表达值替换这些零值以减少数据集中的噪声，某些缺失值填充方法是基于假设数据符合预期的负二项噪声分布。这种基于统计模拟的校正方法可能存在过校正或校正不足。此步操作仍需谨慎。

二、单细胞整合方法介绍

现在，我们可以获得越来越多的scRNA-seq数据集，对它们进行merge_seurat的方法就显得尤为重要。

整合不同的scRNA-Seq数据集有两种主要方法。第一种方法是“以标签为中心”（label-centric），它侧重于通过比较单个细胞或细胞群来尝试识别跨数据集的相同细胞类型/状态。另一种方法是“跨数据集归一化”（cross-dataset normalization），它试图通过计算（算法），来消除特定于实验技术/生物学上的影响，以便可以对多个实验的数据进行联合分析。seurat包的CCA数据整合方法属于后者。

以标签为中心的方法，可以与具有高可信度细胞注释的数据集一起使用，例如，人类细胞图谱数据库HCA (Regev et al. 2017) 或小鼠单细胞图谱数据库Tabula Muris (Quake2017?) 。一旦将新样本中的细胞或cluster映射到到参考数据集上，便可了解组织的细胞类型组成和识别具有新 /身份不明的细胞群。从概念上讲，这类预测类似于流行的BLAST方法（Altschul 等人，1990 年），BLAST算法是可以在数据库中快速找到与待鉴定的核苷酸或氨基酸序列最接近的匹配项。以标签为中心的方法还可用于比较从不同实验室收集的相似生物来源的数据集，以确保注释和分析的一致性。

图1：以标签为中心的数据集比较可用于比较两个不同样本的细胞类型注释

图2：以标签为中心的数据集比较可以将新实验中的细胞映射到带细胞类型注释的参考数据集上

跨数据集归一化方法也可用于比较具有相似生物学起源的数据集，与以标签为中心的方法不同，它能够对多个数据集进行联合分析，也有利于稀有细胞类型的识别，这些细胞类型可能在每个单独样本数据集中采样过于稀疏而无法可靠检测到。然而，跨数据集归一化不适用于非常大和多样化的参考数据集，因为它假设每个数据集中的生物变异性的很大一部分与其他数据集是有重叠的。

图 3：跨数据集归一化支持对 2+ scRNASeq 数据集进行联合分析

三、 MNN-based methods

mnnCorrect校正数据集，以便于联合分析。为了解释两个重复或两个不同实验之间的组成差异，首先比对跨实验的单个细胞以找到重叠的生物结构。通过这些重叠部分，它学习哪些表达维度对应于生物学状态，哪些维度对应于批次/实验效应；mnnCorrect假设这些维度在高维表达空间中彼此正交。最后，它从整个表达式矩阵中删除批次/实验效应以返回校正后的矩阵。

为了跨数据集将单个细胞彼此匹对，mnnCorrect使用余弦距离来避免文库大小引起的效应，然后，跨数据集识别相互最近的邻居（k值决定邻居数目）。只有重叠的生物学上的细胞群才应该有相互最近的邻居（见下面的面板 b）。然而，假设k值设置为数据集中大约多少个细胞组成最小生物组，但是太低的k值会识别出太少的相互最近邻居对，无法很好地估计我们想要删除的批次效应。

学习生物/技术效应是通过奇异值分解（singular value decomposition, SVD）完成的，类似于我们在批次校正部分遇到的RUV，或者，使用优化的irlba包进行主成分分析，这应该比SVD更快。或者该参数svd.dim指定应该保留多少维度来概括数据的生物学结构，我们将其设置为3个，因为我们使用上面的Metaneighbor找到了三个主要组。这些估计可以通过平滑 ( sigma) 和/或方差调整 ( var.adj)进一步调整。

MNN方法基于3种假设：
(1) 至少有一个细胞群体在不同batches都存在；
(2) batch effect 向量跟不同的biological subspace 呈现正交关系；
(3) batch effect 造成的variation 远比biological-effect 小
基于这些假设，接着就是去找细胞在每个batch 内最近的邻居，如果彼此都是最近的邻居，他们就叫做mutual nearest partner 。

相互最近邻（MNN）集成方法的方案

四、典型关联分析 (Seurat v3)

Seurat包有另一种用于组合多个数据集的校正方法，称为CCA（Cannonical Correlation Analysis）。但是，与mnnCorrect不同的是，它不直接纠正表达式矩阵本身。Seurat的做法是，为每个数据集找到一个较低维的子空间，然后纠正这些子空间。另一个不同于mnnCorrect的地方是，Seurat每次只组合一对数据集。

Seurat通过一种称为典型相关分析(CCA)的方法，利用基因-基因相关性来识别数据集中的生物学结构。Seurat学习基因-基因相关性的共享结构，然后评估每个细胞与该结构的匹配程度。假定细胞代表特定于数据集的细胞类型/状态，通过特定于数据的降维方法比通过共享相关结构能更好地描述细胞。最后，使用“扭曲”算法校准两个数据集，该算法，通过对代表每个数据集的低维特征归一化，以对群体密度的差异具有鲁棒性。

最近文献发布了几个基线评估研究(Chazarra-Gil et al, 2021; Tran et al, 2020; Luecken et al, 2020)。最详细的一篇（Tran 2020）使用多个不同大小和不同复杂度的模拟数据和真实数据集，比较了14种scRNA-seq 数据集整合方法。根据基准测试，Harmony、LIGER（最近成为 rliger）和 Seurat (v3) 的表现最好。

五、Seurat官网单细胞数据整合分析

教程链接：https://satijalab.org/seurat/articles/integration_introduction.html
更新时间：January 11, 2022

5.1 单细胞scRNA-seq 整合分析介绍

两个或多个单细胞数据集的联合分析提出了独特的挑战。特别是，在标准分析流程下，识别存在于多个数据集中的细胞群可能会出现问题。 Seurat v4 包括一组方法来匹配（或“比对”）跨数据集的共享细胞群。这些方法首先识别处于匹配生物学状态（anchors，锚点）的跨数据集细胞对，既可用于校正数据集之间的技术差异（即批量效应校正），也可用于比较跨实验条件的scRNA-seq 分析。

接下来，我们演示Stuart、Butler等人2019年所述的scRNA-seq整合方法，以对静息状态或干扰素刺激状态下的人类免疫细胞（PBMC）进行比较分析。

数据整合的目的

下面的教程旨在使用 Seurat整合分析程序对复杂的细胞类型进行各种比较分析。在这里，我们解决了几个关键目标：

为下游分析创建“integrated”数据分析
识别两个数据集中存在的细胞类型
获得在对照细胞和受刺激细胞中都保守的细胞类型标记
比较数据集以发现对刺激反应特异的细胞类型
细胞类型对刺激的特异性反应

5.2 创建Seurat对象

加载R包

library(Seurat) 
library(SeuratData) 
library(patchwork)

加载示例数据，数据下载有点困难，尝试手动下载：https://seurat.nygenome.org/src/contrib/ifnb.SeuratData_3.1.0.tar.gz
对每个样本分别进行归一化，查找各自的高可变基因；

# load dataset
LoadData("ifnb")

# 查看每个样本的数据大小
table(ifnb$stim)
# CTRL STIM 
# 6548 7451

# split the dataset into a list of two seurat objects (stim and CTRL)
ifnb.list <- SplitObject(ifnb, split.by = "stim")
ifnb.list
# $CTRL
# An object of class Seurat 
# 14053 features across 6548 samples within 1 assay 
# Active assay: RNA (14053 features, 0 variable features)
# 
# $STIM
# An object of class Seurat 
# 14053 features across 7451 samples within 1 assay 
# Active assay: RNA (14053 features, 0 variable features)

# normalize and identify variable features for each dataset independently
ifnb.list <- lapply(X = ifnb.list, FUN = function(x) {
    x <- NormalizeData(x)
    x <- FindVariableFeatures(x, selection.method = "vst", nfeatures = 2000)
})
# 查看两个样本高可变基因的交集
hvf_CTRL <- VariableFeatures(ifnb.list[['CTRL']])
length(hvf_CTRL)
# [1] 2000
hvf_STIM <- VariableFeatures(ifnb.list[['STIM']])
length(hvf_STIM)
# [1] 2000
length(intersect(hvf_CTRL, hvf_STIM))
# [1] 787

# select features that are repeatedly variable across datasets for integration
features <- SelectIntegrationFeatures(object.list = ifnb.list)

length(intersect(features, hvf_STIM))
# [1] 1363
length(intersect(features, hvf_CTRL))
# [1] 1424

问题1：多个样本进行数据整合，每个样本都有各自的高可变基因，如何为整合的数据集选择公共的高可变基因？
以本案例为例，用韦恩图查看两个样本的共同高可变基因，共787个基因(787/2000)。

library(venn)
library(scales)
pdf("overlap_genes_in_hvfs.pdf",6,6,useDingbats = F)
try(ll <- list(CTRL=hvf_CTRL, STIM=hvf_STIM),silent = T)
try(a <- attr(venn(ll, zcolor = hue_pal()(7)[1:2],opacity = .2), "intersections"),silent = T)
dev.off()

image.png

我们翻下SelectIntegrationFeatures源码看看
主要执行了以下步骤：
step1： CTRL和STIM样本的DefaultAssay默认为RNA；每个样本2000个高可变基因；
step2： 将每个样本的高可变基因赋值给var.features，共3213个基因（787个共有）；统计每个基因出现的频次，降序排列；
step3： 两个样本共有3213个基因，我们只需要top2000个基因。查看第2000个基因的出现频次tie.val=1；
step4： 查看基因频次大于1的基因数features，有787个，两个样本共有的高可变基因。这些基因需要排序，取在两个样本中排序的中位数；例如，CCL4基因在CTRL样本排序为4，在STIM样本排序为5，取中位数median(c(4,5))=4.5，CCL4的排位是4.5；根据排位升序排列；
step5： 查看基因频次=1的基因，共2426个基因，也依次对每个基因计算排位；例如，A4GALT基因在样本排序为1620，在STIM样本排序为NULL（不存在），取其两者的中位数median(c(1620,NULL))=1620；根据排位依次提取2000-787=1213个基因；
多样本的高可变基因选取可类比学校的考试录取，考试科目语文和数学，取前2000名优等生。语文和数学全优学生787名，全部录用，但要排名，取语文和数学的平均数（这里是中位数），依次排序；还剩下1213个名额，针对单科优秀者，根据单科成绩排名，择优录取填充剩下的席位。

SelectIntegrationFeatures <- function( 
  object.list, 
  nfeatures = 2000, 
  assay = NULL, 
  verbose = TRUE, 
  fvf.nfeatures = 2000, 
  ... 
) { 
  if (!is.null(x = assay)) { 
    if (length(x = assay) != length(x = object.list)) { 
      stop("If specifying the assay, please specify one assay per object in the object.list") 
    } 
    for (ii in length(x = object.list)) { 
      DefaultAssay(object = object.list[[ii]]) <- assay[ii] 
    } 
  } else { 
    assay <- sapply(X = object.list, FUN = DefaultAssay) 
  } 
  for (ii in 1:length(x = object.list)) { 
    if (length(x = VariableFeatures(object = object.list[[ii]])) == 0) { 
      if (verbose) { 
        message(paste0("No variable features found for object", ii, " in the object.list. Running FindVariableFeatures ...")) 
      } 
      object.list[[ii]] <- FindVariableFeatures(object = object.list[[ii]], nfeatures = fvf.nfeatures, verbose = verbose, ...) 
    } 
  } 
  var.features <- unname(obj = unlist(x = lapply( 
    X = 1:length(x = object.list), 
    FUN = function(x) VariableFeatures(object = object.list[[x]], assay = assay[x])) 
  )) 
  var.features <- sort(x = table(var.features), decreasing = TRUE) 
  for (i in 1:length(x = object.list)) { 
    var.features <- var.features[names(x = var.features) %in% rownames(x = object.list[[i]][[assay[i]]])] 
  } 
  tie.val <- var.features[min(nfeatures, length(x = var.features))] 
  features <- names(x = var.features[which(x = var.features > tie.val)]) 
  vf.list <- lapply(X = object.list, FUN = VariableFeatures) 
  if (length(x = features) > 0) { 
    feature.ranks <- sapply(X = features, FUN = function(x) { 
      ranks <- sapply(X = vf.list, FUN = function(vf) { 
        if (x %in% vf) { 
          return(which(x = x == vf)) 
        } 
        return(NULL) 
      }) 
      median(x = unlist(x = ranks)) 
    }) 
    features <- names(x = sort(x = feature.ranks)) 
  } 
  features.tie <- var.features[which(x = var.features == tie.val)] 
  tie.ranks <- sapply(X = names(x = features.tie), FUN = function(x) { 
    ranks <- sapply(X = vf.list, FUN = function(vf) { 
      if (x %in% vf) { 
        return(which(x = x == vf)) 
      } 
      return(NULL) 
    }) 
    median(x = unlist(x = ranks)) 
  }) 
  features <- c( 
    features, 
    names(x = head(x = sort(x = tie.ranks), nfeatures - length(x = features))) 
  ) 
  return(features) 
}

5.3 执行数据整合

然后，我们使用FindIntegrationAnchors()函数识别锚点，该函数将Seurat对象列表作为输入，并使用IntegratedData()函数，用这些锚点将两个数据集集成在一起。

immune.anchors <- FindIntegrationAnchors(object.list = ifnb.list, anchor.features = features)

# this command creates an 'integrated' data assay
immune.combined <- IntegrateData(anchorset = immune.anchors)

这里有两个非常重要的函数FindIntegrationAnchors()和IntegratedData()。
FindIntegrationAnchors()代码极为复杂，另起一篇再写。

参考资料：
1.http://toolsbiotech.blog.fc2.com/blog-entry-113.html
2.https://github.com/satijalab/seurat/blob/f1b2593ea72f2e6d6b16470dc7b9e9b645179923/R/integration.R
3.https://satijalab.org/seurat/articles/get_started.html