如何为圆形图添加外部轨道

Question

我有以下数据框，我喜欢使用circlize 绘制：

library(circlize)
library(tidyverse)


circos_tc_dat <- structure(list(ligand = c("Cxcr4 ", "Cd44 ", "Cxcr4 ", "Cxcr4 ", 
"Csf2rb ", "Plaur ", "Plaur ", "Cxcr4 ", "Csf3r ", "Sell ", "Tnfrsf1b ", 
"Sell ", "Csf2rb ", "Tnfrsf1b ", "Csf2rb ", "Il1r2 ", "Plaur ", 
"Calm1 ", "Cd44 ", "Ptafr ", "Il1r2 ", "Calm1 ", "Cxcr2 ", "Cxcr2 "
), receptor = c("Dsg2", "Itgb1", "Cxcl10", "Cxcl10", "Itgb1", 
"Itgb1", "Agt", "Csf1", "Csf1", "Icam1", "Calm1", "Calm1", "Tnf", 
"App", "Il1b", "Tnf", "Il1b", "Tnf", "Mmp9", "Anxa1", "Il1b", 
"Il1b", "Cxcl10", "Calr"), weight = c(0.168, 0.169, 0.099, 0.099, 
0.314, 0.342, 0.093, 0.106, 0.388, 0.179, 0.278, 0.179, 0.043, 
0.046, 0.043, 0.044, 0.046, 0.172, 0.539, 0.11, 0.908, 0.141, 
0.097, 0.02), tc = c("DAY03", "DAY03", "DAY03", "DAY03", "DAY03", 
"DAY03", "DAY03", "DAY03", "DAY03", "DAY03", "DAY03", "DAY03", 
"DAY03", "DAY03", "DAY03", "DAY03", "DAY03", "DAY03", "DAY03", 
"DAY03", "DAY03", "DAY03", "DAY03", "DAY03"), sender_cell_name = c("Abs. & secrectory cell", 
"Abs. & secrectory cell", "Abs. & secrectory cell", "Endothelial", 
"Endothelial", "Endothelial", "Fibroblast", "Fibroblast", "Fibroblast", 
"Fibroblast", "Germinal center B cell", "Lymphatic", "Macrophage", 
"Macrophage", "Macrophage", "Macrophage", "Macrophage", "Macrophage", 
"Macrophage", "Myofibroblast", "Neutrophil", "Neutrophil", "Plasma cell", 
"Plasma cell"), receiver_cell_name = c("Neutrophil", "Neutrophil", 
"Neutrophil", "Neutrophil", "Neutrophil", "Neutrophil", "Neutrophil", 
"Neutrophil", "Neutrophil", "Neutrophil", "Neutrophil", "Neutrophil", 
"Neutrophil", "Neutrophil", "Neutrophil", "Neutrophil", "Neutrophil", 
"Neutrophil", "Neutrophil", "Neutrophil", "Neutrophil", "Neutrophil", 
"Neutrophil", "Neutrophil"), sender_cell_color = c("#8DD3C7", 
"#8DD3C7", "#8DD3C7", "#FFFFB3", "#FFFFB3", "#FFFFB3", "#BEBADA", 
"#BEBADA", "#BEBADA", "#BEBADA", "#FB8072", "#80B1D3", "#FDB462", 
"#FDB462", "#FDB462", "#FDB462", "#FDB462", "#FDB462", "#FDB462", 
"#B3DE69", "#FCCDE5", "#FCCDE5", "#D9D9D9", "#D9D9D9"), receiver_cell_color = c("#000000", 
"#000000", "#000000", "#000000", "#000000", "#000000", "#000000", 
"#000000", "#000000", "#000000", "#000000", "#000000", "#000000", 
"#000000", "#000000", "#000000", "#000000", "#000000", "#000000", 
"#000000", "#000000", "#000000", "#000000", "#000000")), class = c("tbl_df", 
"tbl", "data.frame"), row.names = c(NA, -24L))

它看起来像这样：

> circos_tc_dat 
# A tibble: 24 x 8
   ligand    receptor weight tc    sender_cell_name       receiver_cell_name sender_cell_color receiver_cell_color
   <chr>     <chr>     <dbl> <chr> <chr>                  <chr>              <chr>             <chr>              
 1 "Cxcr4 "  Dsg2      0.168 DAY03 Abs. & secrectory cell Neutrophil         #8DD3C7           #000000            
 2 "Cd44 "   Itgb1     0.169 DAY03 Abs. & secrectory cell Neutrophil         #8DD3C7           #000000            
 3 "Cxcr4 "  Cxcl10    0.099 DAY03 Abs. & secrectory cell Neutrophil         #8DD3C7           #000000            
 4 "Cxcr4 "  Cxcl10    0.099 DAY03 Endothelial            Neutrophil         #FFFFB3           #000000            
 5 "Csf2rb " Itgb1     0.314 DAY03 Endothelial            Neutrophil         #FFFFB3           #000000            
 6 "Plaur "  Itgb1     0.342 DAY03 Endothelial            Neutrophil         #FFFFB3           #000000            
 7 "Plaur "  Agt       0.093 DAY03 Fibroblast             Neutrophil         #BEBADA           #000000            
 8 "Cxcr4 "  Csf1      0.106 DAY03 Fibroblast             Neutrophil         #BEBADA           #000000            
 9 "Csf3r "  Csf1      0.388 DAY03 Fibroblast             Neutrophil         #BEBADA           #000000            
10 "Sell "   Icam1     0.179 DAY03 Fibroblast             Neutrophil         #BEBADA           #000000     

使用此代码：

# Define color

ligand_color <- circos_tc_dat %>% dplyr::select(ligand, sender_cell_color) %>% unique()
grid_ligand_color <- ligand_color$sender_cell_color %>% set_names(ligand_color$ligand)
receptor_color <- circos_tc_dat %>% dplyr::select(receptor, receiver_cell_color) %>% unique()
grid_receptor_color <- receptor_color$receiver_cell_color %>% set_names(receptor_color$receptor)

grid_col <- c(grid_ligand_color, grid_receptor_color)


# Prepare the circos visualization: order ligands and targets  ------------

receptor_order <- circos_tc_dat$receptor %>% unique()
# ligand_order <- c(CAF_specific_ligands, general_ligands, endothelial_specific_ligands) %>%
#   c(paste(., " ")) %>%
#   intersect(circos_tc_dat$ligand)
ligand_order <- circos_tc_dat$ligand %>% unique()
order <- c(ligand_order, receptor_order)

# Define links

lr_links_circle <- circos_tc_dat %>% dplyr::select(ligand, receptor, weight)


cutoff_include_all_ligands <- lr_links_circle$weight %>% quantile(0.66)


# Prepare the circos visualization: define the gaps between the different segments --------
width_same_cell_same_ligand_type <- 0.25
width_different_cell <- 3
width_ligand_receptor <- 3
width_same_cell_same_receptor_type <- 0.25

gaps <- c(
  rep(width_same_cell_same_ligand_type, times = (circos_tc_dat  %>% distinct(ligand) %>% nrow() - 1)),
  width_ligand_receptor,
  # width_different_cell,
  rep(width_same_cell_same_receptor_type, times = (circos_tc_dat %>%  distinct(receptor) %>% nrow() - 1)),
  width_ligand_receptor
)

circos.par(gap.degree = gaps)
chordDiagram(lr_links_circle,
             directional = 1, order = order, link.sort = TRUE,
             link.decreasing = FALSE,
             grid.col = grid_col,
             transparency = 0,
             diffHeight = 0.005,
             direction.type = c("diffHeight", "arrows"),
             link.arr.type = "big.arrow",
             annotationTrack = "grid",
             preAllocateTracks = list(track.height = 0.075)
)
# we go back to the first track and customize sector labels
circos.track(track.index = 1, panel.fun = function(x, y) {
  circos.text(CELL_META$xcenter, CELL_META$ylim[1], CELL_META$sector.index,
              facing = "clockwise", niceFacing = TRUE, 
              adj = c(0, 0.55), 
              cex = 0.5
  )
}, bg.border = NA)

circos.clear()

我可以制作这个情节：

如上图所示，我想在外面添加另一个轨道，对receiver_cell_nameor进行编码sender_cell_name。我怎样才能做到这一点？

Answer 1

一个快速的解决方案可能只是添加另一个文本标签，在原始标签和下一个新标签之间具有不同的间距。通过增加

locations=c(0.5,1.6,2.5,3,3.75,4.5,7)
labels=c("Abs.sc","Endotelial","Fib","GermB","Mac","Plasma Myo","Neutrophil")

for (i in 1:length(locations)){
    circos.text(locations[i],0,labels[i],adj=c(0,-2.4),facing="bending.inside")
}

我得到以下情节。

希望能帮助到你