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?