最近微信群有小伙伴抛出这样一张图，是一个细胞通讯LR气泡图，确切的说应该是Cellchat结果的可视化。我一看这不就是用Cellchat做的嘛。没什么难度，做一下！这个相比于上次我们做的可视化，也是受配体对，难度小巫见大巫了。
image.png
（reference：Single-cell atlas reveals a distinct immune profile fostered by T cell-B cell crosstalk in triple negative breast cancer）
小伙伴的问题所在于横坐标是每个celltype下包含每个分组，其实但凡思考一下，或者自己摸索过就会一眼看出，这就是cellchat多组结果的可视化，这也就是我第一眼就说这是cellchat默认做的图。至于哪些注释标签，可以自己手动AI修饰添加。
我们的示例数据刚好有三组，我们将三个分组的数据分别提取出来：这个示例数据的celltype命名太长了，不利于作图，我们重命名为简写！
library(CellChat)
library(ggplot2)
library(Seurat)
library(plyr)
setwd('D:/KS项目/公众号文章/cellchat多组点图')
uterus <- readRDS("D:/KS项目//uterus.rds")
#提取不同分组的数据分别进行cellchat分析，最后合并，也就是多组比较
#我们的示例数据有3组
unique(uterus@meta.data$orig.ident)
# [1] "HC" "EEC" "AEH"
unique(uterus$celltype)
# [1] "Smooth muscle cells" "Lymphocytes"
# [3] "Unciliated epithelial cells" "Stromal fibroblasts"
# [5] "Ciliated epithelial cells" "Endothelial cells"
# [7] "Macrophages"
#提取每一组的seurat对象
HC <- subset(uterus, orig.ident=='HC')
AEH <- subset(uterus, orig.ident=='AEH')
EEC <- subset(uterus, orig.ident=='EEC')
data_list <- list(HC, AEH, EEC)
names(data_list) <- c("HC", "AEH", "EEC")
#这个示例数据的celltype名太长了，我们修改一下,用简称
for(i in 1:3){
data_list[[i]]@meta.data$newcell <- mapvalues(data_list[[i]]@meta.data$celltype,
from=c("Smooth muscle cells","Lymphocytes",
"Unciliated epithelial cells","Stromal fibroblasts",
"Ciliated epithelial cells","Endothelial cells","Macrophages"),
to=c("SMC","Ly","UEP","SF","CEP","EC","MAC"))
}
然后就是分别对每一组进行cellchat分析流程,然后合并作图了。可是我们也知道，cellchat流程很繁琐，如果我一个一个的去做太费劲，这里3各样本还好，假设是5个六个不得烦死。所以我们按照自己需求的参数调整后，将所有这些步骤简单的封装在一个函数里面。利用循环对三组进行分析。
#接下来进行分析，分析结果我们储存在一个list
cellchat_list <- list()
for (i in 1:3){
cellchat_res <- KS_cellchat(Seuratobject = data_list[[i]],
select_meta_col = c("orig.ident","newcell"),
organism = 'human',
min.cells = 10)
cellchat_list[[i]] <- cellchat_res
}
然后将三组cellchat合并，进行可视化。看这个图是不是就是文献中的那感觉！
#多组合并
names(cellchat_list) <- c("HC", "AEH", "EEC")
uterus_cellchat <- mergeCellChat(cellchat_list,add.names = names(cellchat_list))
#全部展示太多了，我们可以选择性展示需要的LR
pairLR.use <- as.data.frame(c("TNF_TNFRSF1A",
"TNF_TNFRSF1B",
"C3_ITGAM_ITGB2",
"FN1_ITGA4_ITGB1",
"FN1_ITGA5_ITGB1",
"HLA-E_KLRC1",
"HLA-DMB_CD4",
"HLA-DPA1_CD4",
"CD99_CD99L2",
'HLA-E_CD8A',
"HLA-F_CD8A",
"HLA-F_LILRB1"))
colnames(pairLR.use) <- 'interaction_name'
netVisual_bubble(uterus_cellchat,
sources.use = c("Ly","MAC"),
targets.use = c("SMC","Ly","UEP","SF","CEP","EC","MAC"),
comparison = c(1, 2, 3),
pairLR.use = pairLR.use)
#这样这个图是不是就出具样式了。还有一点要知道，cellchat的作图是和ggplot互通的，所以可以进行修饰了
p <- netVisual_bubble(uterus_cellchat,
sources.use = c("Ly","MAC"),
targets.use = c("SMC","Ly","UEP","SF","CEP","EC","MAC"),
comparison = c(1, 2, 3),
pairLR.use = pairLR.use)+
theme(legend.position = 'top',
legend.key.width = unit(1,'cm'),
legend.margin = margin(0.5,0.5,0,0,'cm'),
plot.margin=unit(c(2.5, 2.5, 2.5, 2.5),'cm'))+
coord_cartesian(clip = 'off')
image.png
其实到这里就差不多了，x轴的label、已经legend都可以通过AI的形式修饰，这样还最简单，当然了，提取数据后用ggplot2按照我们之前很多帖子的方式，也是可以完成的，但是我觉得没必要了。这里我们提一下一个R包，老俊俊的杰作，一个注释R包，对于上层分组注释还是可以的。具体参数可参见帮助函数。
library(jjAnno)
p2 <- annoSegment(object = p,
annoPos = 'top',
aesGroup = T,
aesGroName = 'source',
yPosition = 13,
segWidth = 0.4,
pCol=c("#EB746A",'#26A5DF'),
addText=T,
textSize = 10,
textCol = c("black","black"))
image.png
这样就完成了，其实我觉得哪些注释自己用AI最简便，没必要非要用代码，即麻烦也没有什么用。希望这个分享对你有用。觉得分享有用的点个赞再走呗！白嫖可不是好习惯哦！请多多支持！
网友评论