Trick to use multiple font styles in a single tip label of a plotted phylogeny

Recently a colleague asked me how he might go about plotting different parts of the tip labels (in his case, species name and museum voucher IDs) using different style fonts.

Technically, one can do this using expression in R (I believe); however, this can get complicated – and there is an easier way!!

To illustrate this, I’ll use a different example – in this case in which my labels consist of Family and species names (genus & specific epithet).

library(phytools)
mammal.tree

## 
## Phylogenetic tree with 68 tips and 67 internal nodes.
## 
## Tip labels:
##   Phocidae_Ommatophoca_rossii, Phocidae_Leptonychotes_weddellii, Phocidae_Monachus_monachus, Phocidae_Halichoerus_grypus, Phocidae_Cystophora_cristata, Otariidae_Arctocephalus_australis, ...
## 
## Rooted; includes branch lengths.

(This tree is modified from vertlife.org, by the way.)

This is how the labels of my tree plot by default using phytools::plotTree.

plotTree(mammal.tree,fsize=0.7,lwd=1)

Now, let’s say, for instance, that I’d like to plot the family names using boldface non-italics font, and the species names in italics.

My trick is that I will: (1) plot the tree without graphing it (for more on this, see Chapter 13 of my recent book with Luke Harmon); (2) split the tip labels of the original tree into the two components listed above; (3) lengthen the tip lengths of the species tree by the widths of the text labels from the family tree; (4) plot the former tree using transparent (or, equivalently, background) colored edge lengths; finally, (5) overplot the latter tree.

This is what our algorithm looks like:

cex<-0.7
plotTree(mammal.tree,fsize=cex,lwd=1,plot=FALSE)
xlim<-get("last_plot.phylo",envir=.PlotPhyloEnv)$x.lim
labs<-strsplit(mammal.tree$tip.label,"_")
t1<-t2<-mammal.tree
t1$tip.label<-sapply(labs,function(x) x[1])
t2$tip.label<-sapply(labs,function(x) paste(x[-1],collapse="_"))
sw<-strwidth(t1$tip.label,cex=cex,font=2)+strwidth(" ",cex=cex)
ind<-sapply(1:Ntip(t2),function(x,e) which(e==x),e=t2$edge[,2])
t2$edge.length[ind]<-t2$edge.length[ind]+sw
plotTree(t2,add=TRUE,fsize=cex,color="transparent",ftype="i",
  xlim=xlim)
plotTree(t1,add=TRUE,fsize=cex,xlim=xlim,ftype="b",lwd=1)

That’s it!