|
需要者詳情請聯(lián)系作者（非需要者勿擾，我很社恐）： 1、購買打包合集（2025KS微信VIP付費合集），價格感人，加入微信VIP群（答疑交流群，甚至有小伙伴覺得群比代碼更好），可以獲取建號以來所有內(nèi)容，群成員專享視頻教程，提前更新，其他更多福利！ 2、《KS科研分享與服務》公眾號有QQ群，進入門檻是20元（完全是為了防止白嫖黨，請理解），請考慮清楚。群里有免費推文的注釋代碼和示例數(shù)據(jù)（終身擁有），沒有付費內(nèi)容，群成員福利是購買單個付費內(nèi)容半價！ circle plot精彩系列： 這是我們circle系列的最后一節(jié)，我想常見的弦圖是繞不開的，所以最后從前面介紹的circle plot思路，做一遍弦圖。其實前面的內(nèi)容如果消化了，plot互作弦圖也就不成什么問題了。本文完整代碼已發(fā)布微信VIP群，請自行下載！這里的演示數(shù)據(jù)使用的是cellchat的結果：首先提取互作結果。#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我們還是分扇區(qū)，這樣做的好處是對圖做了注釋，就不用額外plot 沒必要的legend了
circos.clear()#清空當前作圖，便于新的circle plotgroup_size <- table(result_df$cells)#這個是每個細胞大群也就是分組的size，這里就是包含的亞群數(shù)目，需要注意這個涉及到后面扇形分區(qū)，所以順序要對#設置布局circos.par(start.degree = 90, cell.padding = c(0, 0, 0, 0), #其實位置，扇區(qū)內(nèi)行距為0 gap.after = 2,#設置每個扇區(qū)之間的gap，前面的扇區(qū)之間小一點，最后兩個扇區(qū)也就是首尾的位置扇區(qū)開頭大一點 circle.margin = c(0.1, 0.1, 0.1, 0.1))#環(huán)形圖距離畫布的距離#初始化plotcircos.initialize(factors = result_df$cells,#扇區(qū)scctor，這是已經(jīng)排好序的數(shù)據(jù) xlim = cbind(0, group_size))#每個扇區(qū)xlim，每個扇區(qū)元素不同，所以每個扇區(qū)的xlim是0到扇區(qū)元素長度
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) } })
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) })
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)
} })
最后添加互作線，需要使用circos.link函數(shù)，連線顏色表示互作強度。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 )}
|
