偷偷问一下，关注了吗？
内容获取
1、购买打包合集（《KS科研分享与服务》付费内容打包集合），价格感人，可以加入微信VIP群（答疑交流群，甚至有小伙伴觉得群比代码更好），可以获取建号以来所有内容，群成员专享视频教程，提前更新，其他更多福利！
2、《KS科研分享与服务》公众号有QQ群，进入门槛是20元（完全是为了防止白嫖党，请理解），请考虑清楚。群里有免费推文的注释代码和示例数据（终身拥有），没有付费内容，群成员福利是购买单个付费内容半价！
需要者详情请联系作者（非需要者勿扰，处理太费时间）：
Metacell或者中文直接翻译叫元细胞大家相比都听过。简单点说就是cell合并，将相似的细胞合并。为什么说这个，主要是为了compass单细胞转录组代谢分析（（视频教程）Compass代谢分析详细流程及python版-R语言版下游分析和可视化), 想做compass的小伙伴应该都了解了，它的那个分析速度感人，那么compasss官网也说了，用metacell可能是一个好的办法。所以这里我们介绍一个metacell分析的工具Supercell，是基于R语言的分析，分析比较简单！supercell和其他单细胞metacell分析方法虽然在操作上有所不同，但是原理一样，都是network-based的。
1、单细胞网络是基于细胞间的相似性（在转录组空间）来计算的。 2、高度相似的细胞被认为是那些在单细胞网络中形成密集区域并合并成元细胞（coarse-graining）的细胞。 3、将每个元细胞内的转录组信息组合（平均值或总和）。 4、Metacell data可以替代大规模单细胞数据用于下游分析。
supercell github : https://github.com/GfellerLab/SuperCell
接下来具体演示以下，首先安装包：
setwd('D:\\KS项目\\公众号文章\\supercell_单细胞数据合并')if (!requireNamespace("remotes")) install.packages("remotes")remotes::install_github("GfellerLab/SuperCell")library(SuperCell)library(Seurat)
如果你是多样本数据，我建议分析单个运行，这样避免不同组的celltype合并，我们得到的metacell确保只是一个组的，不影响后续分析。
uterus <- readRDS("D:/KS项目/公众号文章/uterus.rds")table(uterus$orig.ident)# AEH EEC HC# 9525 12033 6356AEH <- subset(uterus, orig.ident=='AEH')#这里我们提取一个分组的数据进行单个的演示
Building metacell based on expression matrix:就一个函数。
exp_mat <- GetAssayData(AEH, layer = "data", assay = 'RNA')AEH <- FindVariableFeatures(AEH)hvg <- VariableFeatures(AEH)SC <- SCimplify(exp_mat, # gene expression matrix 基因表达矩阵k.knn = 5, # number of nearest neighbors to build kNN networkgamma = 20, # graining level，初始数据集中的单细胞数与最终数据集中的元细胞数的比例genes.use = hvg) # 用于PCA降维基因数量
提取metacell矩阵：
SC.GE <- supercell_GE(exp_mat, SC$membership)metacell注释，合并后我们得分配cell type，并对结果评估。
SC$cell_line <- supercell_assign(clusters = AEH$celltype, # 单细胞注释supercell_membership = SC$membership, # single-cell assignment to metacellsmethod = "jaccard")#assign的方法有c("jaccard", "relative", "absolute")# plot network of metacells colored by cell line assignmentsupercell_plot(SC$graph.supercells,group = SC$cell_line,main = "Metacells colored by cell line assignment"
purity <- supercell_purity(clusters = AEH$celltype,supercell_membership = SC$membership,method = 'entropy')hist(purity, main = "Purity of metacells \nin terms of cell line composition")SC$purity <- purity
supercell还可以将metacell结果返回seurat：
Super_sce <- supercell_2_Seurat(SC.GE = as.matrix(SC.GE), # supercell_GE(exp_mat, SC$membership)获得的metacell表达矩阵SC = SC, #super-cell (output of SCimplify function)fields = c("cell_line", "purity")#需要添加的信息，其实最主要的就是metacell annotation)# Performing log-normalization# 0% 10 20 30 40 50 60 70 80 90 100%# [----|----|----|----|----|----|----|----|----|----|# **************************************************|# [1] "Done: NormalizeData"# [1] "Doing: data to normalized data"# [1] "Doing: weighted scaling"# [1] "Done: weighted scaling"# Computing nearest neighbor graph# Computing SNN# Warning message:# 2116 instances of variables with zero scale detected!Super_sce <- RunUMAP(Super_sce,dims = 1:10)Super_sce <- FindClusters(Super_sce, graph.name = "RNA_nn")Idents(Super_sce) <- 'cell_line'DimPlot(Super_sce, label = T)
如果你的数据很大，比如有几十万的细胞，下游分析有很吃力，那么metacell分析就是一个不错的选择，这种合并我认为比单纯的抽样分析可能更靠谱。其实我们的目的只是想得到metacell矩阵，然后就可以进行compass或者pyscenic分析。这里我们简单验证以下metacell效果，结果是不是与原始的数据一样呢？我们随便分析两种细胞的差异基因，当然因为矩阵改变结果肯定不是一模一样，但是一致性还挺强！
de_orig <- FindMarkers(AEH, ident.1 = "Unciliated epithelial cells",ident.2 = "Ciliated epithelial cells")de_super <- FindMarkers(Super_sce, ident.1 = "Unciliated epithelial cells",ident.2 = "Ciliated epithelial cells")library(Vennerable)Set1 <- as.list(rownames(de_orig[de_orig$p_val <= 0.05 & abs(de_orig$avg_log2FC)>=0.25,]))Set2 <- as.list(rownames(de_super[de_super$p_val <= 0.05 & abs(de_super$avg_log2FC)>=0.25,]))example <-list(Set1=Set1,Set2=Set2)Veenplot <- Venn(example)Veenplot<-Veenplot[, c("Set1", "Set2")]plot(Veenplot, doWeights = TRUE)same_gene <- Veenplot@IntersectionSets$`11`data <- cbind(de_orig[de_orig$p_val <= 0.05 & abs(de_orig$avg_log2FC)>=0.25,][same_gene,][,2],de_super[de_super$p_val <= 0.05 & abs(de_super$avg_log2FC)>=0.25,][same_gene,][,2])colnames(data) <- c("de_orig", "de_super")data <- as.data.frame(data)library(ggpubr)ggscatter(data,x="de_orig",y="de_super",add = "reg.line",conf.int = T,color = '#0f8096')+stat_cor(label.x = 0.2, label.y = 0)
关注我们获取精彩内容：
关注不迷路：扫描下面二维码关注公众号！
B站视频号链接：https://space.bilibili.com/471040659?spm_id_from=333.1007.0.0
关注 KS科研分享与服务，
认清正版优质内容和服务！
优质内容持续输出，物超所值！
合作联系：ks_account@163.com
