前言
作者开发Scissor的目的是结合bulk-seq的数据，寻找与某一性状显著相关的单细胞亚群，然后从表型的角度解释这些细胞亚群的生物学意义。作者开发Scissor的动机是由于目前对细胞亚群的分群大多基于scRNA的表达量进行无监督聚类，却鲜有人从表型的角度解释这些单细胞亚群。作者认为，相同的细胞亚群可能会导致相同表型的发生
完整流程
# 加载数据
## 单细胞数据
location <- "https://xialab.s3-us-west-2.amazonaws.com/Duanchen/Scissor_data/"
load(url(paste0(location, 'scRNA-seq.RData')))
## bulk-seq data
load(url(paste0(location, 'TCGA_LUAD_exp1.RData')))
## 表型 data
load(url(paste0(location, 'TCGA_LUAD_survival.RData')))
# 预处理单细胞数据
sc_dataset <- Seurat_preprocessing(sc_dataset, verbose = F)
# 预处理表型数据
phenotype <- bulk_survival[,2:3]
colnames(phenotype) <- c("time", "status")
# 运行Scissor
infos1 <- Scissor(bulk_dataset, sc_dataset, phenotype, alpha = 0.05,
family = "cox", Save_file = 'Scissor_LUAD_survival.RData')
Scissor_select <- rep(0, ncol(sc_dataset))
names(Scissor_select) <- colnames(sc_dataset)
## infos1$Scissor_pos代表 β > 0 的细胞
## infos1$Scissor_neg代表 β < 0 的细胞
Scissor_select[infos1$Scissor_pos] <- 1
Scissor_select[infos1$Scissor_neg] <- 2
sc_dataset <- AddMetaData(sc_dataset, metadata = Scissor_select, col.name = "scissor")
DimPlot(sc_dataset, reduction = 'umap', group.by = 'scissor', cols = c('grey','indianred1','royalblue'), pt.size = 1.2, order = c(2,1))
如上图，每一个点代表一个细胞，红色代表与表型呈正相关的细胞；蓝色代表与表型呈负相关的细胞
因此，经过计算获得的回归系数β表征每一个细胞与表型的相关程度，若回归系数β > 0代表该细胞与某种表型呈现正相关；若回归系数β < 0代表该细胞与某种表型呈现负相关
原理
如上图所示，作者需要的 input 文件有三种，单细胞数据，表型数据（可以说分类表型数据，也可以是连续型表型数据）和bulk-seq的表达矩阵
第一步，软件利用分位数回归去除了bulk-seq和scRNA的批次效应；第二步基于单细胞数据构建cell与cell间的similarity network（G）；第三步计算单细胞表达矩阵对bulk-seq表达矩阵的皮尔斯相关系数，记作S={sij}n×m，n为sample的总数目，m为细胞的总数目；第四步，利用相关性矩阵S作为决策变量，表型数据作为响应变量建立回归关系，设回归系数为β，在计算β的过程中将以及cell与cell间的similarity network（G）的部分信息（利用度矩阵和邻接矩阵构建拉普拉斯矩阵）作为估计的正则项
那么接下来的任务就是估计出回归系数β，转换为最优化问题：
β等于
其中：
- L(拉普拉斯矩阵） = I - D-1/2AD-1/2
- 上式的A={aij}m×m代表cell与cell间的similarity network（G）的邻接矩阵（aij介于0—1之间）
- 上式的D={dij}m×m是G的度矩阵，dij=∑j=1aij，其中 j = 1—m
- λ 为 penalty
其中：
- 设
表示sample i 对每一个细胞的皮尔斯相关系数，si2表示sample i 与第2个细胞的皮尔斯相关系数- 若表型数据Y是连续型变量
l(β)定义为：
3.若表型数据Y是分类型变量l(β)定义为：
那么计算出来的回归系数为β越高代表某细胞亚群与某表型的相关性比较高，反之比较低
事实上bulk-seq的sample数量与表型数据的数量是一致的。而决策变量Si表征每个细胞与sample i的相关性，相关性高即代表该细胞与该sample的表达模式相同，也就是sample i 中这个细胞的含量较多（该细胞含量多才会使得该细胞与该sample之间表达模式相同），因此可以等量代换为某个细胞的含量与表型之间的关系，因此β值为正且越大，则说明该细胞含量对表型影响呈正相关且影响大。反之β为负且越小，则说明该细胞含量对表型影响呈正负相关且影响大
代码
第一部分：
# single cell
location <- "https://xialab.s3-us-west-2.amazonaws.com/Duanchen/Scissor_data/"
load(url(paste0(location, 'scRNA-seq.RData')))
sc_dataset <- Seurat_preprocessing(sc_dataset, verbose = F)
# bulk seq
load(url(paste0(location, 'TCGA_LUAD_exp1.RData')))
load(url(paste0(location, 'TCGA_LUAD_survival.RData')))
# 提取表型数据
all(colnames(bulk_dataset) == bulk_survival$TCGA_patient_barcode)
phenotype <- bulk_survival[,2:3]
colnames(phenotype) <- c("time", "status")
其中bulk-seq的列表示不同sample，行表示不同基因；表型数据：
phenotype
第二部分：
# 读取数据
bulk_dataset = bulk_dataset
sc_dataset = sc_dataset
phenotype = phenotype
tag = NULL
alpha = 0.05
cutoff = 0.2
family = "cox"
Save_file = "Scissor_inputs.RData"
Load_file = NULL
# 单细胞基因和bulk-seq基因取交集
common <- intersect(rownames(bulk_dataset), rownames(sc_dataset))
# 构建cell与cell间的similarity network（G）
sc_exprs <- as.matrix(sc_dataset@assays$RNA@data)
network <- as.matrix(sc_dataset@graphs$RNA_snn)
diag(network) <- 0
network[which(network != 0)] <- 1
# Dataset before quantile normalization.
dataset0 <- cbind(bulk_dataset[common,], sc_exprs[common,])
# Dataset after quantile normalization.
dataset1 <- normalize.quantiles(dataset0)
rownames(dataset1) <- rownames(dataset0)
colnames(dataset1) <- colnames(dataset0)
# 得到单细胞表达矩阵和bulk-seq表达矩阵
Expression_bulk <- dataset1[,1:ncol(bulk_dataset)]
Expression_cell <- dataset1[,(ncol(bulk_dataset) + 1):ncol(dataset1)]
# 单细胞矩阵和bulk-seq表达量矩阵求皮尔斯相关系数所构成的相关系数矩阵，作为决策变量
X <- cor(Expression_bulk, Expression_cell)
quality_check <- quantile(X)
# 定义表型的响应变量
Y <- as.matrix(phenotype)
# 计算回归系数β
set.seed(123)
# 初次计算
fit0 <- APML1(X, Y, family = family, penalty = "Net", alpha = alpha[i], Omega = network, nlambda = 100, nfolds = 10)
# 再次计算，将fit0$lambda.min作为新模型的 lambda
fit1 <- APML1(X, Y, family = family, penalty = "Net", alpha = alpha[i], Omega = network, lambda = fit0$lambda.min)
# 获取回归系数β
Coefs <- as.numeric(fit1$Beta)
Cell1 <- colnames(X)[which(Coefs > 0)]
Cell2 <- colnames(X)[which(Coefs < 0)]
percentage <- (length(Cell1) + length(Cell2)) / ncol(X)
因此，经过计算获得的回归系数β表征每一个细胞与表型的相关程度，若回归系数β > 0代表该细胞与某种表型呈现正相关；若回归系数β < 0代表该细胞与某种表型呈现负相关
细胞水平评估
此外，作者还提供了一个估计细胞水平的函数evaluate.cell()，其核心代码如下：
Scissor_result = infos1
selected_cell <- c(Scissor_result$Scissor_pos, Scissor_result$Scissor_neg)
# Expression_bulk意义参见第二部分代码
m <- ncol(Expression_bulk)
# selected_cell意义参见第二部分代码
n <- length(selected_cell)
evaluate_summary <- as.data.frame(matrix(0, n, 11, dimnames = list(selected_cell,
c("Mean correlation","Correlation > 0","Correlation < 0","Significant Correlation","Coefficient",
"Beta 0%","Beta 25%","Beta 50%","Beta 75%","Beta 100%","Probability of zero"))))
cor_test_p <- matrix(0, m, n)
for (i in 1:m){
Sys.sleep(1 / 100)
for (j in 1:n){
#相关性的显著性检验
cor_test_p[i,j] <- cor.test(Expression_bulk[,i], Expression_cell[,selected_cell[j]])$p.value
}
}
cor_test_FDR <- matrix(p.adjust(as.numeric(cor_test_p), method = "fdr"), m)
for (j in 1:n){
# X代表单细胞矩阵和bulk-seq表达量矩阵求皮尔斯相关系数所构成的相关系数矩阵，参考第二部分
evaluate_summary[j,1] <- mean(X[,selected_cell[j]])
evaluate_summary[j,2] <- percent(sum(X[,selected_cell[j]] > 0)/m)
evaluate_summary[j,3] <- percent(sum(X[,selected_cell[j]] < 0)/m)
evaluate_summary[j,4] <- percent(sum(cor_test_FDR[,j] < FDR_cutoff)/m)
}
其中：X代表单细胞矩阵和bulk-seq表达量矩阵求皮尔斯相关系数所构成的相关系数矩阵
因此结果的第一列表示的是某一个细胞与所有bulk-seq样本相关性的均值；第二列是统计X矩阵相关系数大于0的比例；第三列是统计X矩阵相关系数小于0的比例
小tips：关于APML1函数
以cox为参数作为例子
# 读取数据
x=X
y=Y
Omega = network
alpha = alpha[i]
lambda=NULL
nlambda = 100
rlambda=NULL
nfolds = 10
foldid=NULL
inzero=TRUE
wbeta=rep(1,ncol(x))
sgn=rep(1,ncol(x))
isd=FALSE
iysd=FALSE
keep.beta=FALSE
ifast=TRUE
thresh=1e-7
maxit=1e+5
penalty="Net"
wbeta=abs(wbeta)
family = 'cox'
fit=CoxL0(x,y,Omega,alpha,lambda,nlambda,rlambda,nfolds,foldid,inzero,wbeta,sgn,isd,keep.beta,ifast,thresh,maxit)
class(fit)="APML1"
# 最终返回 fit
return(fit)
其中CoxL0函数的功能是估计β的算式，是用C++写的
