这是我们circle系列的最后一节，我想常见的弦图是绕不开的，所以最后从前面介绍的circle plot思路，做一遍弦图。其实前面的内容如果消化了，plot互作弦图也就不成什么问题了。
效果如下：
#cellchat提取互作结果，这里我们选取了几种细胞
library(CellChat)
unique(HD.cellchat@idents)
# [1] Kers Mon Tcell lang Men Fibs SMCs ECs Mast
# Levels: ECs Fibs Kers lang Mast Men Mon SMCs Tcell
HD.com <- subsetCommunication(HD.cellchat, sources.use = c("Tcell","Mon","Fibs","SMCs","ECs"),
targets.use = c("Tcell","Mon","Fibs","SMCs","ECs"))
#为了演示顺利不繁琐，我们对prob做了筛选，实际按照自己的想法即可，这里仅仅是为了减少结果
HD.com <- HD.com[HD.com$prob > 0.01,]
HD.com <- HD.com[,1:5]
设置绘图：
library(circlize)
#plot我们还是分扇区，这样做的好处是对图做了注释，就不用额外plot 没必要的legend了
circos.clear()#清空当前作图，便于新的circle plot
group_size <- table(result_df$cells)#这个是每个细胞大群也就是分组的size，这里就是包含的亚群数目，需要注意这个涉及到后面扇形分区，所以顺序要对
#设置布局
circos.par(start.degree = 90, cell.padding = c(0, 0, 0, 0), #其实位置，扇区内行距为0
gap.after = 2,#设置每个扇区之间的gap，前面的扇区之间小一点，最后两个扇区也就是首尾的位置扇区开头大一点
circle.margin = c(0.1, 0.1, 0.1, 0.1))#环形图距离画布的距离
#初始化plot
circos.initialize(factors = result_df$cells,#扇区scctor，这是已经排好序的数据
xlim = cbind(0, group_size))#每个扇区xlim，每个扇区元素不同，所以每个扇区的xlim是0到扇区元素长度
plot第一轨道：
circos.track(
ylim = c(0, 1),
bg.border = NA,
track.height = 0.01,
panel.fun = function(x, y) {
sector_index = get.cell.meta.data("sector.index")
group_size = group_size[sector_index]
for (i in 1:group_size) {
circos.text(
x = i - 0.5,
y = 0.5,
labels = result_df$gene[result_df$cells == sector_index][i],
col= result_df$LR_color[result_df$cells == sector_index][i],
font = 2,
facing = "reverse.clockwise",
niceFacing = TRUE,
adj = c(1, 0.5),
cex = 0.8)
}
}
)
[图片上传失败...(image-2034cb-1745423123645)]
plot第二轨道，注释celltype：
circos.track(ylim = c(0, 1),
bg.border = NA,
track.height = 0.08,
bg.col=group_colors,
panel.fun=function(x, y) {
xlim = get.cell.meta.data("xlim")
ylim = get.cell.meta.data("ylim")
sector.index = get.cell.meta.data("sector.index")
circos.text(mean(xlim)，
mean(ylim),
sector.index,
col = "black",
cex = 0.8,
font=2,
facing = 'bending.inside',
niceFacing = TRUE)
})
[图片上传失败...(image-71fb3-1745423123645)]
第三轨道，注释受配体：
lables_LR <- c("L","R")
circos.track(
ylim = c(0,1),
bg.border = NA,
track.height = 0.08,
panel.fun = function(x, y) {
sector_index = get.cell.meta.data("sector.index")
group_data = result_df[result_df$cells == sector_index, ]
LR = table(group_data$group)
xleft = as.vector(c(0,LR))
xright = cumsum(LR)
for (i in 1:2) {
circos.rect(
xleft = xleft[i],
xright = xright[i],
ybottom = 0,#
ytop = 1,#
col = LR_color[i], #
border = NA
)
circos.text(xleft[i] + xleft[i+1]/2,
0.5,
lables_LR[i],
col = "white",
cex = 0.8,
font=2,
facing = 'bending.inside',
niceFacing = TRUE)
}
}
)
[图片上传失败...(image-beac72-1745423123645)]
最后添加互作线，需要使用circos.link函数，连线颜色表示互作强度。
HD.com <- HD.com1 %>%
mutate(
source = factor(source, levels = c("Tcell","Mon","Fibs","SMCs","ECs"))
)%>%
arrange(source)
col_fun = colorRamp2(range(edges$V3), c("#FFFDE7", "#013220"))
for(i in 1:nrow(HD.com)) {
source <- as.character(HD.com$source[i])
ligand <- as.character(HD.com$ligand[i])
from_subset <- result_df[result_df$cells == source, ]
from_idx <- which(from_subset$gene == ligand)
target <- as.character(HD.com$target[i])
receptor <- as.character(HD.com$receptor[i])
to_subset <- result_df[result_df$cells == target, ]
to_idx <- which(to_subset$gene == receptor)
if(identical(ligand, receptor)==FALSE){
from_pos <- from_idx - 0.5
to_pos <- to_idx - 0.5
}else{
from_pos <- from_idx[1] - 0.5
to_pos <- to_idx[2] - 0.5
}
circos.link(
sector.index1 = source,
point1 = from_pos,
sector.index2 = target,
point2 = to_pos,
col = col_fun(HD.com$prob[i]),
lwd = 2,
directional = 1,
arr.length=0.2,
arr.width=0.1
)
}
效果可以