New function to add tip labels to a tree connected via linking lines

I posted some neat code earlier today to demonstrate, first, how to plot some but not all tip labels, and, second, how to space out these tip labels & connect them to the correct corresponding tips using various types of linking lines.

The following is a simple function to formalize this exercise:

linklabels<-function(text,tips,link.type=c("bent","curved","straight"),
    ...){
    lastPP<-get("last_plot.phylo",envir=.PlotPhyloEnv)
    if(!(lastPP$direction%in%c("leftwards","rightwards")))
        stop("direction should be \"rightwards\" or \"leftwards\".")
    if(hasArg(cex)) cex<-list(...)$cex
    else cex<-1
    if(hasArg(col)) col<-list(...)$col
    else col<-"black"
    if(hasArg(lty)) lty<-list(...)$lty
    else lty<-"dashed"
    if(hasArg(lwd)) lwd<-list(...)$lwd
    else lwd<-1
    if(hasArg(link.offset)) link.offset<-list(...)$link.offset
    else link.offset<-0.1*max(lastPP$xx)
    if(hasArg(font)) font<-list(...)$font
    else font<-3
    link.type<-link.type[1]
    xpos<-lastPP$xx[tips]+strwidth("i")
    ypos<-lastPP$yy[tips]
    xmax<-rep(max(lastPP$xx),length(tips))+link.offset
    ylab<-seq(1,lastPP$Ntip,by=(lastPP$Ntip-1)/(length(tips)-1))
    ylab<-ylab[rank(ypos)]
    text(xmax,ylab,gsub("_"," ",text),pos=4,font=font,cex=cex,
        offset=0)
    if(link.type=="curved"){
        for(i in 1:length(tips))
            drawCurve(c(xpos[i],xmax[i]),c(ypos[i],ylab[i]),
                scale=0.05,lty=lty,col=col,lwd=lwd)
    } else if(link.type=="bent"){
        tipmax<-max(lastPP$xx)
        for(i in 1:length(tips)){
            ff<-strwidth("W")
            segments(xpos[i],ypos[i],tipmax+link.offset/2,ypos[i],
                lty=lty,col=col,lwd=lwd)
            segments(tipmax+link.offset/2,ypos[i],tipmax+
                link.offset/2+ff,ylab[i],lty=lty,col=col,lwd=lwd)
            segments(tipmax+link.offset/2+ff,ylab[i],xmax[i],ylab[i],
                lty=lty,col=col,lwd=lwd)
        }
    } else if(link.type=="straight")
        segments(xpos,ypos,xmax,ylab,lty=lty,col=col)
}

This theoretically works with left & right facing trees - but so far it has only been tested with the latter. It should also work with trees plotted via any plotting function that exports the environmental variable "last_plot.phylo" to the environment .PlotPhyloEnv (this is most of the plotting function of phytools & ape).

Let's try it:

data(anoletree)
text<-sample(anoletree$tip.label,20)
text

##  [1] "Anolis_singularis"   "Anolis_cupeyalensis" "Anolis_ahli"        
##  [4] "Anolis_chlorocyanus" "Anolis_cuvieri"      "Anolis_marron"      
##  [7] "Anolis_luteogularis" "Anolis_marcanoi"     "Anolis_occultus"    
## [10] "Anolis_whitemani"    "Anolis_noblei"       "Anolis_allisoni"    
## [13] "Anolis_smallwoodi"   "Anolis_aliniger"     "Anolis_garmani"     
## [16] "Anolis_brevirostris" "Anolis_rubribarbus"  "Anolis_krugi"       
## [19] "Anolis_alfaroi"      "Anolis_grahami"

## get tip node numbers
tips<-sapply(text,function(x,y) which(y==x),y=anoletree$tip.label)
states<-mapped.states(anoletree)
cols<-setNames(palette()[1:length(states)],states)
plot(anoletree,xlim=c(0,9),ylim=c(-4,Ntip(anoletree)),ftype="off")

## no colors provided. using the following legend:
##        CG        GB        TC        TG        Tr        Tw 
##   "black"     "red"  "green3"    "blue"    "cyan" "magenta"

add.simmap.legend(colors=cols,prompt=FALSE,x=0,y=-4,vertical=FALSE)
linklabels(text,tips)

We can also used link.type="curved" (or "straight", but what's the fun in the that). For instance:

drawCurve<-phytools:::drawCurve
plot(anoletree,xlim=c(0,9),ylim=c(-4,Ntip(anoletree)),ftype="off")

## no colors provided. using the following legend:
##        CG        GB        TC        TG        Tr        Tw 
##   "black"     "red"  "green3"    "blue"    "cyan" "magenta"

add.simmap.legend(colors=cols,prompt=FALSE,x=0,y=-4,vertical=FALSE)
linklabels(text,tips,link.type="curved")

(We had to define drawCurve<-phytools:::drawCurve only because we are loading the source of linklabels - it is not yet in the name space of phytools.)

You get the idea.