这是我们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 TcellHD.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), #其实位置，扇区内行距为0gap.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.5to_pos <- to_idx - 0.5}else{from_pos <- from_idx[1] - 0.5to_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)
}

效果可以