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

我得到以下情节。

希望有帮助

如何添加外部轨迹以进行圆图绘制

1 个答案: