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

Question

I have the following data frame, which I like to plot using 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))

It looks like this:

> 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     

With this code:

# 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()

I can make this plot:

As shown in the above figure, I would like to add another track outside, that encode the receiver_cell_name or sender_cell_name . How can I achieve that?

Answer 1

A quick solution could be just to add anoter text label with a different spacing between the original label and the next new labels. By adding

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")
}

I get the following plot.

Hope it helps