Hacky solution to plot a phylogeny in multiple styles (with linking lines) where the tips line up on their distal ends using phytools

The following is a somewhat hacky method to draw a circular phylogenetic tree with linking lines to the tip labels, but in which the labels line up at their distal ends.

data("liolaemid.tree")
XLIM<-c(-50,50)
YLIM<-c(-50,50)
par(fg="transparent")
CEX<-0.4
plotTree(liolaemid.tree,type="fan",fsize=CEX,ftype="i",
  xlim=XLIM,ylim=YLIM,color="transparent")
par(fg="black")
tmp<-liolaemid.tree
h<-sapply(1:Ntip(liolaemid.tree),nodeheight,tree=liolaemid.tree)
hh<-max(strwidth(liolaemid.tree$tip.label,cex=CEX,font=3))/max(h)
bmp<-max(h)+hh*max(h)-strwidth(liolaemid.tree$tip.label,cex=CEX)-h
for(i in 1:Ntip(tmp)) tmp$edge.length[which(tmp$edge[,2]==i)]<-
  tmp$edge.length[which(tmp$edge[,2]==i)]+bmp[i]
par(lty="dotted")
plotTree(tmp,lwd=1,type="fan",fsize=CEX,xlim=XLIM,ylim=YLIM,
  add=TRUE,ftype="i")
par(lty="solid")
plotTree(liolaemid.tree,type="fan",ftype="off",add=TRUE,
  xlim=XLIM,ylim=YLIM,lwd=3,color=palette()[4])

You can see that it’s slightly imperfect, largely due to strwidth not giving exactly the correct string width in user units from our graphical device. (strwidth seems to be especially bad for strings with special characters, such as . or numbers.)

It works for other plotting styles as well. In this case, I’ll use a "simmap" object, but in which the tip labels are only letters.

data("anoletree")
XLIM<-c(-8,8)
YLIM<-c(0,8)
par(fg="transparent")
CEX<-0.8
plotTree(as.phylo(anoletree),type="fan",fsize=CEX,ftype="i",
  xlim=XLIM,ylim=YLIM,color="transparent",part=0.5)
par(fg="black")
tmp<-as.phylo(anoletree)
h<-sapply(1:Ntip(anoletree),nodeheight,tree=anoletree)
hh<-max(strwidth(anoletree$tip.label,cex=CEX,font=3))/max(h)
bmp<-max(h)+hh*max(h)-strwidth(anoletree$tip.label,cex=CEX)-h
for(i in 1:Ntip(tmp)) tmp$edge.length[which(tmp$edge[,2]==i)]<-
  tmp$edge.length[which(tmp$edge[,2]==i)]+bmp[i]
par(lty="dotted")
plotTree(tmp,lwd=1,type="fan",fsize=CEX,xlim=XLIM,ylim=YLIM,
  add=TRUE,ftype="i",part=0.5)
par(lty="solid")
cols<-setNames(RColorBrewer::brewer.pal(6,"Accent"),
  sort(unique(getStates(anoletree))))
plot(anoletree,type="fan",ftype="off",add=TRUE,
  xlim=XLIM,ylim=YLIM,lwd=3,colors=cols,outline=TRUE,
  part=0.5)

Here’s one last example.

data("salamanders")
salamanders$edge.length<-runif(n=nrow(salamanders$edge))
XLIM<-c(0,1.2*max(nodeHeights(salamanders)))
YLIM<-c(1,Ntip(salamanders))
par(fg="transparent")
CEX<-0.8
plotTree(salamanders,fsize=CEX,ftype="i",xlim=XLIM,ylim=YLIM,
  color="transparent")
par(fg="black")
tmp<-salamanders
h<-sapply(1:Ntip(salamanders),nodeheight,tree=salamanders)
hh<-max(strwidth(salamanders$tip.label,cex=CEX,font=3))/max(h)
bmp<-max(h)+hh*max(h)-strwidth(salamanders$tip.label,cex=CEX)-h
for(i in 1:Ntip(tmp)) tmp$edge.length[which(tmp$edge[,2]==i)]<-
  tmp$edge.length[which(tmp$edge[,2]==i)]+bmp[i]
par(lty="dotted")
plotTree(tmp,lwd=1,fsize=CEX,xlim=XLIM,ylim=YLIM,
  add=TRUE,ftype="i")
par(lty="solid")
plotTree(salamanders,ftype="off",add=TRUE,xlim=XLIM,ylim=YLIM,
  lwd=5,color="black")
plotTree(salamanders,ftype="off",add=TRUE,xlim=XLIM,ylim=YLIM,
  lwd=3,color="white")