ggaling for grouping categories in a ggtree phylogenetic tree
discuss
Hi @Yunuuuu here is Matteo we talked about this issue on SO ([link here](https://stackoverflow.com/questions/79636877/how-to-group-based-on-category-in-ggtree/79734656#79734656)),
I'm basically trying to group the same _varieties_ of a plant species in a `ggtree` plot and you proposed two alternatives with `ggalign` which I really like.
I believe based on my data I might need to follow **Example 1** as I have well-defined groups in my `df` which is not rooted as well. Anyway, testing your code on my data yield this output
<img width="2287" height="1473" alt="Image" src="https://github.com/user-attachments/assets/406c8d14-e785-4614-b3e3-1662c782d701" />
For one, I wish to have dots rather than branches colored based on the _location_ of my samples; secondly, I would need to understand how to integrate the `guides` function to change the legend output based on my original post. I believe this can be done simply with this
```
ggalign() +
# add boxplot layer
geom_boxplot(aes(x = .discrete_x, y = value, fill = .panel)) +
guides(...)
```
but I'm asking for confirmation.
Also, this is the code I'm using for plotting the original tree you can see on the SO post
```
library(dplyr)
library(scico)
library(tibble)
library(ggtree)
library(ggplot2)
library(phangorn)
library(ggtreeExtra)
library(RColorBrewer)
###LOAD DATA AND WRANGLING
ibs_matrix = read.delim("/path/to/phylo_tree_ibs_header.phy", sep="\t", header=TRUE)
colnames(ibs_matrix)[1] <- ""
ibs_matrix[1] <- NULL
box_plot = read.delim("/path/to/box-plot.txt", sep="\t", header=FALSE)
box_plot[1,1] <- "id"
ibs_matrix_t <- t(ibs_matrix)
box_plot_t <- t(box_plot); box_plot_t <- janitor::row_to_names(box_plot_t, 1)
###ADD META INFO AND DF FORMATTING
variety <- c("wt", "wt", "wt", "wt", "wt", "wt", "wt", "wt", "wt", "lr", "wt", "wt", "wt", "wt", "wt", "wt", "wt", "wt", "wt", "lr", "wt",
"wt", "wt", "wt", "wt", "wt", "lr", "lr", "wt", "wt", "wt", "wt", "lr", "cv", "wt", "wt", "wt", "wt", "wt", "lr", "wt", "wt",
"wt", "wt", "wt", "lr", "lr", "lr", "lr", "lr", "lr", "lr", "lr", "lr", "lr", "lr", "lr", "lr", "lr", "wt", "wt", "wt", "wt",
"wt", "wt", "wt", "wt", "wt", "wt", "wt", "wt", "wt", "wt", "wt", "wt", "wt", "cv", "lr", "lr", "lr", "lr", "lr", "lr", "wt",
"lr", "lr", "cv", "lr", "wt", "wt", "wt", "wt", "cv", "wt", "wt", "wt", "wt", "cv", "cv", "cv", "cv", "cv", "cv", "cv", "cv",
"cv", "cv", "cv", "wt", "wt", "cv", "cv", "cv", "cv", "cv", "cv", "cv", "cv", "cv", "lr", "lr", "cv", "cv", "cv", "cv", "cv",
"cv", "cv", "cv", "cv", "cv", "cv", "cv", "unk", "unk", "unk", "unk", "unk", "unk", "unk", "unk", "unk", "unk", "unk", "unk",
"unk", "unk", "wt", "wt", "wt", "wt", "lr", "lr", "wt", "wt", "lr", "cv", "lr", "cv", "cv", "lr", "lr", "lr", "lr", "cv", "cv",
"lr", "lr", "unk", "cv", "cv", "cv", "cv", "unk", "cv", "cv", "unk", "cv", "lr", "lr", "lr", "lr", "lr", "lr", "lr", "lr", "lr",
"lr", "lr", "lr", "lr", "lr", "lr", "lr", "lr", "lr", "lr", "lr", "lr", "lr", "lr", "lr", "lr", "lr", "lr", "unk", "lr", "lr",
"lr", "lr", "lr", "lr", "lr", "lr", "lr", "lr", "cv", "unk", "unk", "unk", "unk", "unk", "lr", "unk", "unk", "unk", "unk", "unk",
"unk", "unk", "unk", "unk", "lr", "unk", "cv", "lr", "cv", "cv", "lr", "lr", "lr", "cv", "cv", "cv", "cv", "cv", "cv", "cv", "cv",
"cv", "cv", "cv", "cv", "cv", "cv", "cv", "cv", "cv", "cv", "cv", "cv", "cv", "cv", "cv", "cv", "wt", "cv", "cv", "cv", "cv", "cv",
"cv", "cv", "wt", "cv", "cv", "lr", "unk", "cv", "cv", "cv", "lr", "cv", "cv", "cv", "cv", "lr", "lr", "cv", "cv", "wt", "wt", "unk",
"unk", "unk", "unk", "unk", "unk", "unk", "unk", "wt", "wt", "wt", "wt")
macro <- c("SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur",
"SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur",
"SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur",
"SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "EEur", "SEur", "EEur", "SEur", "SEur", "SEur", "SEur", "SEur",
"SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "NAfr", "SEur", "SEur", "Ame", "WAs", "WAs", "WAs", "NAfr",
"NAfr", "WAs", "WAs", "Ame", "NEur", "unk", "WAs", "SEur", "SEur", "NAfr", "SAfr", "WEur", "WAs", "WAs", "NAfr", "WAs", "SEur", "WAs",
"SEur", "SEur", "WEur", "WEur", "EEur", "EEur", "SEur", "WEur", "WEur", "EEur", "EEur", "EEur", "WEur", "SEur", "SEur", "EEur", "EEur",
"WEur", "EEur", "WEur", "WAs", "WAs", "Ame", "EEur", "WEur", "WEur", "EEur", "EEur", "EEur", "EEur", "WEur", "WEur", "WEur", "SAfr", "SEur",
"SEur", "WAs", "SAfr", "SAfr", "SAfr", "SAfr", "WAs", "WAs", "WAs", "WEur", "NAfr", "NAfr", "NAfr", "SEur", "SEur", "SEur", "SEur", "unk", "unk",
"SEur", "EEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "unk", "unk", "SEur", "SEur", "unk", "WEur", "EEur", "SEur",
"unk", "SEur", "EEur", "unk", "WAs", "unk", "NAfr", "NAfr", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur",
"SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur",
"SEur", "SEur", "SEur", "SEur", "unk", "unk", "unk", "unk", "unk", "NAfr", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SEur", "SAfr", "WEur",
"NEur", "EEur", "SEur", "unk", "WEur", "SEur", "SEur", "SEur", "WEur", "WEur", "WEur", "WEur", "EEur", "WEur", "WEur", "unk", "WEur", "SEur", "WEur", "unk", "unk",
"EEur", "SEur", "SEur", "NAfr", "SEur", "WEur", "SEur", "SEur", "SEur", "unk", "unk", "NAfr", "SEur", "SEur", "SEur", "WEur", "SEur", "WEur", "NAfr", "SEur", "SEur",
"NAfr", "SEur", "NAfr", "SEur", "NAfr", "NAfr", "SEur", "EEur", "SEur", "WEur", "EEur", "SEur", "SEur", "EEur", "NAfr", "SEur", "SEur", "SEur", "EEur", "NAfr", "NAfr",
"SEur", "SEur", "Aus", "SEur", "Aus", "Aus", "Aus", "Aus")
meta_df <- data.frame(ibs_matrix_t[, 1], variety, macro); meta_df <- meta_df[ -c(1) ]
meta_df$id <- rownames(meta_df); meta_df <- meta_df[,c(3,1,2)]
rownames(meta_df) <- NULL
lupin_NJ <- NJ(ibs_matrix_t)
###GGTREE PERSONALIZATION
meta_df$variety <- factor(meta_df$variety, levels=c('wt', 'lr', 'cv', 'unk'))
t1 <- ggtree(lupin_NJ, branch.length='none', layout='circular') %<+% meta_df + geom_tippoint(aes(color=variety), size=1.5) +
scale_color_manual(values=c(brewer.pal(11, "Spectral")[c(9, 11, 4)], "black"),
guide=guide_legend(keywidth=1, keyheight=0.8, ncol=2, order=1))
box_plot <- janitor::row_to_names(box_plot, 1); box_plot=subset(box_plot, select=-c(id))
box_plot_t <- data.frame(values=matrix(t(box_plot)),
id=colnames(box_plot)); box_plot_t <- box_plot_t[order(box_plot_t[["id"]]),]
box_plot_t <- full_join(box_plot_t, meta_df, by="id")
get_category <- function(macro) {
if (macro == "Ame") {
return(1)
} else if (macro == "Aus") {
return(2)
} else if (macro == "SEur") {
return(3)
} else if (macro == "WEur") {
return(4)
} else if (macro == "EEur") {
return(5)
} else if (macro == "NEur") {
return(6)
} else if (macro == "SAfr") {
return(7)
} else if (macro == "NAfr") {
return(8)
} else if (macro == "WAs") {
return(9)
} else if (macro == "unk") {
return(10)
}
}
box_plot_t <- box_plot_t %>%
mutate(numbering = sapply(macro, get_category))
box_plot_t["values"][is.na(box_plot_t["values"])] <- 0
t1_box <- t1 +
geom_fruit(
data=box_plot_t, geom=geom_boxplot,
mapping = aes(
y=id,
x=log(
(as.numeric(as.character(values)))
/max(as.numeric(as.character(values)))
+1),
fill=as.factor(numbering)
),
offset=.05, size=.2, outlier.stroke=0, outlier.shape=NA,
axis.params = list(
axis="x",
text.size=1.8,
hjust=1,
vjust=0.5,
nbreak=3,
),
grid.params=list()
)
t1_box <- rotate_tree(t1_box, -90)
t1_box <- t1_box +
scale_fill_manual(
name="location",
values=c(rev(scico(9, palette='hawaii')), "black"),
labels=c("Ame", "Aus", "SEur", "WEur", "EEur", "NEur", "SAfr", "NAfr", "WAs", "unk"),
guide=guide_legend(keywidth=1, keyheight=0.8, ncol=2, order=2)
) + theme(legend.title=element_text(hjust=.5,face='italic'))
t1_box
```
In this example dots are restricted to only samples, whereas in the `ggalign` **Example 1 ** there seems to be four crowns of points; the boxplots also disappears... I apologize in advance for my code that could be very basic and not optimal, but I'm no expert and the documentation on `ggtree` isn't helpful either beside some v. simple tutorial/examples...
I also attach the two files loaded by the script for completeness, thanks in advance!
[phylo_tree_ibs_header.txt](https://github.com/user-attachments/files/21829646/phylo_tree_ibs_header.txt)
[box-plot.txt](https://github.com/user-attachments/files/21829645/box-plot.txt)
关闭于 2025-09-27 12 条评论