Tuesday, March 26, 2024

"Hacky" trick to show discrete (and continuous!) characters at the tips of a plotted arc or fan style tree using phytools

This weekend I co-taught an NSF-funded workshop here at UMass-Boston with James Boyko and Luke Harmon, the latter of whom joined remotely, but still managed to bring a lot to the course.

A workshop participant asked me about visualizing one or more discrete characters at the tips of an “arc” or “fan” style tree in R.

I feel like I’ve provided other solutions to this problem in the past – but a new “hack” solution occurred to me. Even if there are less hacky options out there (including in phytools), I thought I’d put it here for posterity – just in case it might ever come in handy!

I’m just going to run the demo first and then I’ll explain it. The tree & data for this particular example come from Betancur et al. (2017) and Benun Sutton & Wilson (2019), respectively

library(phytools)
data("bonyfish.tree")
bonyfish.tree
## 
## Phylogenetic tree with 90 tips and 89 internal nodes.
## 
## Tip labels:
##   Xenomystus_nigri, Chirocentrus_dorab, Talismania_bifurcata, Alepocephalus_tenebrosus, Misgurnus_bipartitus, Opsariichthys_bidens, ...
## 
## Rooted; includes branch lengths.
data("bonyfish.data")
head(bonyfish.data)
##                          spawning_mode paternal_care
## Xenomystus_nigri                  pair          male
## Chirocentrus_dorab               group          none
## Talismania_bifurcata             group          none
## Alepocephalus_tenebrosus         group          none
## Misgurnus_bipartitus              pair          none
## Opsariichthys_bidens              pair          none

We should see that our dataset consists of two different discrete characters. They happen to be stored as factors – but even if they weren’t, this code would work with only a few small modifications.

h<-max(nodeHeights(bonyfish.tree))
par(lend=3)
spawning<-bonyfish.tree
spawning$edge.length[
  which(spawning$edge[,2]<=Ntip(spawning))]<-
  spawning$edge.length[
    which(spawning$edge[,2]<=Ntip(spawning))]+0.16*h
levs1<-levels(bonyfish.data$spawning_mode)
spawning<-paintSubTree(spawning,Ntip(spawning)+1,"0")
for(i in 1:nrow(bonyfish.data)){
  tip<-which(bonyfish.tree$tip.label==
      rownames(bonyfish.data)[i])
  spawning<-paintSubTree(spawning,node=tip,
    state=levs1[bonyfish.data[i,1]],
    stem=(0.05*h)/spawning$edge.length[
      which(spawning$edge[,2]==tip)])
}
care<-bonyfish.tree
care$edge.length[which(care$edge[,2]<=Ntip(care))]<-
  care$edge.length[which(care$edge[,2]<=
      Ntip(care))]+0.08*h
levs2<-levels(bonyfish.data$paternal_care)
care<-paintSubTree(care,Ntip(care)+1,"0")
for(i in 1:nrow(bonyfish.data)){
  tip<-which(bonyfish.tree$tip.label==
      rownames(bonyfish.data)[i])
  care<-paintSubTree(care,node=tip,
    state=levs2[bonyfish.data[i,2]],
    stem=(0.05*h)/care$edge.length[
      which(care$edge[,2]==tip)])
}
cols1<-setNames(c("transparent",palette()[2:3]),
  c("0",levs1))
plot(spawning,cols1,type="arc",arc_height=0.5,
  ftype="i",lwd=8,fsize=0.6,offset=4)
pp<-get("last_plot.phylo",envir=.PlotPhyloEnv)
cols2<-setNames(c("transparent",palette()[4:5]),
  c("0",levs2))
plot(care,cols2,type="arc",arc_height=0.5,
  ftype="off",lwd=8,xlim=pp$x.lim,ylim=pp$y.lim,
  add=TRUE)
plotTree(bonyfish.tree,type="arc",ftype="off",
  arc_height=0.5*1.05,add=TRUE,xlim=pp$x.lim,
  ylim=pp$y.lim,add=TRUE,lwd=1)
legend("topleft",levs1,lwd=8,col=cols1[2:3],
  title="spawning mode",bty="n")
legend("topright",levs2,lwd=8,col=cols2[2:3],
  title="parental care",bty="n")