I've been struggling with building a alluvial plot with three axis. This is what my data looks like:
sankey.df<-tibble::tibble(
technique = rep(c("SN", "SC"), c(46L, 39L)),
celltype_main = factor(
c(
"Immune cells", "Immune cells", "Immune cells", "Epithelial cells",
"Immune cells", "Immune cells", "Epithelial cells", "Immune cells",
"Mesenchymal cells", "Epithelial cells", "Immune cells", "Mesenchymal cells",
"Endothelial cells", "Epithelial cells", "Mesenchymal cells", "Immune cells",
"Immune cells", "Immune cells", "Mesenchymal cells", "Immune cells",
"Epithelial cells", "Immune cells", "Endothelial cells", "Immune cells",
"Immune cells", "Immune cells", "Epithelial cells", "Endothelial cells",
"Endothelial cells", "Immune cells", "Epithelial cells", "Mesenchymal cells",
"Epithelial cells", "Immune cells", "Endothelial cells", "Immune cells",
"Immune cells", "Epithelial cells", "Immune cells", "Mesenchymal cells",
"Epithelial cells", "Mesenchymal cells", "Mesenchymal cells",
"Mesenchymal cells", "Epithelial cells", "Mesenchymal cells", "Immune cells",
"Epithelial cells", "Endothelial cells", "Endothelial cells", "Immune cells",
"Immune cells", "Immune cells", "Immune cells", "Immune cells",
"Immune cells", "Epithelial cells", "Epithelial cells", "Epithelial cells",
"Mesenchymal cells", "Immune cells", "Epithelial cells", "Epithelial cells",
"Endothelial cells", "Immune cells", "Mesenchymal cells", "Immune cells",
"Mesenchymal cells", "Immune cells", "Immune cells", "Immune cells",
"Immune cells", "Immune cells", "Epithelial cells", "Immune cells",
"Epithelial cells", "Endothelial cells", "Epithelial cells", "Immune cells",
"Mesenchymal cells", "Mesenchymal cells", "Immune cells", "Immune cells",
"Immune cells", "Immune cells"
),
levels = c("Epithelial cells", "Mesenchymal cells", "Endothelial cells", "Immune cells")
),
annotation = factor(
c(
"AM", "TC", "Ccl22+ DC", "Club cells", "Mki67+ AM", "pDC", "AT2", "BC",
"Activated FB", "AT1", "ncMono", "Mesothelial cells", "gCAP",
"Ciliated cells", "Alveolar FB", "GB", "Cd103+ DC", "Recruited macrophages",
"Adipocytes", "IM", "PNECs", "NK", "EC", "PMN", "Cd209c+ mono", "Mki67+ Mono",
"Mki67+ Secretory cells", "aCAP", "Mki67+ EC", "Cd163+ macrophages",
"Mki67+ ATs", "Pericytes", "Deuterosomal cells", "Mast cells", "LEC",
"Mki67+ GB", "Mki67+ TC", "Muc5b+ cells", "Mki67+ BC", "Adventitial FB",
"Cdkn1a+ AT1", "Serpine1+ FB", "Peribronchial FB", "SMC", "Basal cells",
"Mki67+ FB", "T-lymphocytes", "AT2 cells", "VECs", "Vcam1+ VECs",
"Neutrophils", "AM (PBS)", "Cd163+/Cd11c- IMs", "NK cells", "B-lymphocytes",
"Cd163-/Cd11c+ IMs", "Goblet cells", "Club cells", "AT1 cells", "SMCs",
"AM (Bleo)", "Ciliated cells", "Ciliated cell subset", "CECs", "Cd103+ DCs",
"Fibroblasts", "Mki67+/Top2a+ proliferating cells", "Mesothelial cells",
"DCs", "Ccl17+ DCs", "Plasma cells", "Non-classical monocytes (Ly6c2-)",
"Recruited macrophages", "Low quality cells", "Mki67+ proliferating cells",
"Activated AT2 cells", "LECs", "Krt8 ADI", "Resolution macrophages",
"Activated mesothelial cells", "Myofibroblasts", "M2 macrophages",
"Fn1+ macrophages", "T cell subset", "Themis+ T-lymphocytes"
),
levels = c(
"Basal cells", "Club cells", "Mki67+ Secretory cells", "Muc5b+ cells",
"Deuterosomal cells", "Ciliated cells", "PNECs", "AT1", "Cdkn1a+ AT1", "AT2",
"Mki67+ ATs", "EC", "LEC", "gCAP", "aCAP", "Mki67+ EC", "SMC",
"Peribronchial FB", "Pericytes", "Adventitial FB", "Alveolar FB", "Mki67+ FB",
"Activated FB", "Mesothelial cells", "Adipocytes", "Serpine1+ FB", "AM",
"Mki67+ AM", "IM", "Cd163+ macrophages", "Recruited macrophages",
"Mki67+ Mono", "ncMono", "Ccl22+ DC", "Cd103+ DC", "Cd209c+ mono", "pDC",
"Mast cells", "PMN", "TC", "Mki67+ TC", "NK", "BC", "Mki67+ BC", "GB",
"Mki67+ GB", "T-lymphocytes", "AT2 cells", "VECs", "Vcam1+ VECs",
"Neutrophils", "AM (PBS)", "Cd163+/Cd11c- IMs", "NK cells", "B-lymphocytes",
"Cd163-/Cd11c+ IMs", "Goblet cells", "AT1 cells", "SMCs", "AM (Bleo)",
"Ciliated cell subset", "CECs", "Cd103+ DCs", "Fibroblasts",
"Mki67+/Top2a+ proliferating cells", "DCs", "Ccl17+ DCs", "Plasma cells",
"Non-classical monocytes (Ly6c2-)", "Low quality cells",
"Mki67+ proliferating cells", "Activated AT2 cells", "LECs", "Krt8 ADI",
"Resolution macrophages", "Activated mesothelial cells", "Myofibroblasts",
"M2 macrophages", "Fn1+ macrophages", "T cell subset",
"Themis+ T-lymphocytes"
)
),
technique_celltype = c(
"SN Immune cells", "SN Immune cells", "SN Immune cells",
"SN Epithelial cells", "SN Immune cells", "SN Immune cells",
"SN Epithelial cells", "SN Immune cells", "SN Mesenchymal cells",
"SN Epithelial cells", "SN Immune cells", "SN Mesenchymal cells",
"SN Endothelial cells", "SN Epithelial cells", "SN Mesenchymal cells",
"SN Immune cells", "SN Immune cells", "SN Immune cells",
"SN Mesenchymal cells", "SN Immune cells", "SN Epithelial cells",
"SN Immune cells", "SN Endothelial cells", "SN Immune cells",
"SN Immune cells", "SN Immune cells", "SN Epithelial cells",
"SN Endothelial cells", "SN Endothelial cells", "SN Immune cells",
"SN Epithelial cells", "SN Mesenchymal cells", "SN Epithelial cells",
"SN Immune cells", "SN Endothelial cells", "SN Immune cells",
"SN Immune cells", "SN Epithelial cells", "SN Immune cells",
"SN Mesenchymal cells", "SN Epithelial cells", "SN Mesenchymal cells",
"SN Mesenchymal cells", "SN Mesenchymal cells", "SN Epithelial cells",
"SN Mesenchymal cells", "SC Immune cells", "SC Epithelial cells",
"SC Endothelial cells", "SC Endothelial cells", "SC Immune cells",
"SC Immune cells", "SC Immune cells", "SC Immune cells", "SC Immune cells",
"SC Immune cells", "SC Epithelial cells", "SC Epithelial cells",
"SC Epithelial cells", "SC Mesenchymal cells", "SC Immune cells",
"SC Epithelial cells", "SC Epithelial cells", "SC Endothelial cells",
"SC Immune cells", "SC Mesenchymal cells", "SC Immune cells",
"SC Mesenchymal cells", "SC Immune cells", "SC Immune cells",
"SC Immune cells", "SC Immune cells", "SC Immune cells",
"SC Epithelial cells", "SC Immune cells", "SC Epithelial cells",
"SC Endothelial cells", "SC Epithelial cells", "SC Immune cells",
"SC Mesenchymal cells", "SC Mesenchymal cells", "SC Immune cells",
"SC Immune cells", "SC Immune cells", "SC Immune cells"
),
relation = rep(
c(
"shared", "unique SN", "shared", "unique SN", "shared", "unique SN", "shared",
"unique SN", "shared", "unique SN", "shared", "unique SN", "shared",
"unique SN", "shared", "unique SN", "shared", "unique SN", "shared",
"unique SN", "shared", "unique SN", "shared", "unique SC", "shared",
"unique SC", "shared", "unique SC", "shared", "unique SC", "shared",
"unique SC", "shared", "unique SC", "shared", "unique SC"
),
c(
5L, 1L, 2L, 1L, 5L, 1L, 3L, 1L, 1L, 1L, 3L, 3L, 3L, 4L, 1L, 1L, 2L, 2L, 1L,
1L, 2L, 2L, 16L, 1L, 2L, 1L, 2L, 1L, 4L, 1L, 1L, 1L, 2L, 2L, 1L, 4L
)
),
value = c(
20L, 20L, 20L, 11L, 20L, 20L, 11L, 20L, 10L, 11L, 20L, 10L, 5L, 11L, 10L, 20L,
20L, 20L, 10L, 20L, 11L, 20L, 5L, 20L, 20L, 20L, 11L, 5L, 5L, 20L, 11L, 10L,
11L, 20L, 5L, 20L, 20L, 11L, 20L, 10L, 11L, 10L, 10L, 10L, 11L, 10L, 21L, 9L,
4L, 4L, 21L, 21L, 21L, 21L, 21L, 21L, 9L, 9L, 9L, 5L, 21L, 9L, 9L, 4L, 21L,
5L, 21L, 5L, 21L, 21L, 21L, 21L, 21L, 9L, 21L, 9L, 4L, 9L, 21L, 5L, 5L, 21L,
21L, 21L, 21L
),
)
With this I've managed to build a 2 axis alluvial plot:
ggplot(sankey.df, aes(axis1 = technique_celltype, axis2 = relation, y = value)) +
geom_alluvium(aes(fill = celltype_main), width = 0.2) +
geom_stratum(width = 0.2, fill = "gray") +
geom_text(stat = "stratum", aes(label = after_stat(stratum))) +
scale_fill_brewer(palette = "Set3") +
theme_minimal() +
labs(x = "Stages", y = "Value")
What I'd like to do now is to have three axis: split axis1 in the SN and the SC categories and between those two have axis 2. The order of the axis would then be SN, shared/unique, SC. I've tried building 3 axis but I struggled because the "unique SC" and the "unique SN" categories would only come from one of the sides, and in my attempts I have categories flowing from "unique SN" into "SC" or "unique SC" into "SN".
data.frame(SN = c("Immune", "Immune", NA, "Mesenchymal", "Mesenchymal", NA,
"Endothelial", "Endothelial", NA, "Epithelial", "Epithelial", NA),
relation = rep(c("shared", "unique SN", "unique SC"), 4),
SC = c("Immune", NA, "Immune", "Mesenchymal", NA,"Mesenchymal",
"Endothelial",NA, "Endothelial", "Epithelial", NA, "Epithelial"),
freq = c(14,6,6,3,7,2,4,1,0,6,5,2),
fill_color = c("Immune", "Immune", "Immune", "Mesenchymal", "Mesenchymal", "Mesenchymal",
"Endothelial", "Endothelial", "Endothelial", "Epithelial", "Epithelial", "Epithelial")) %>%
ggplot(aes(axis1 = SN, axis2 = relation, axis3 = SC, y = freq))+
geom_alluvium(aes(fill = fill_color))+
geom_stratum(width = 0.2, fill = "gray") +
geom_text(stat = "stratum", aes(label = after_stat(stratum))) +
scale_fill_brewer(palette = "Set3") +
theme_minimal() +
labs(x = "Stages", y = "Value")
Here I'd like to remove the empty boxes on both sides so nothing from the unique nodes flow into the wrong side of the side nodes.
For bonus points, is it possible to have the nodes in the middle as bar plots showing the proportion of the fill_color?