這是我們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)
}

效果可以