Tuesday, August 2, 2022

Follow-up: Layered plotTree.wBars fan-style tree in half-circle arc!

A phytools user, Simon Baeckens asks:

The answer is, what I posted is just a hacky script (not a finished function), so – sure, why not?

Here is the simplest modification of my prior post to plot using the fan-style tree in a semi-circle arc.

First, let's read & transform our data & tree.

library(phytools)
library(geiger)
phryn.tree<-read.tree(file="http://www.phytools.org/Rbook/5/Phrynosomatidae.phy")
phryn.tree$edge.length<-phryn.tree$edge.length*100
iguania.data<-read.csv(file="http://www.phytools.org/Rbook/5/Iguania.csv",
    row.names=1)
chk<-name.check(phryn.tree,iguania.data)
summary(chk)
## 212 taxa are present in the data but not the tree:
##     amcris,
##     anacut,
##     anaen,
##     anahl,
##     analin,
##     analli,
##     ....
## 
## To see complete list of mis-matched taxa, print object.
phryn.data<-iguania.data[phryn.tree$tip.label,]
phryn.norm<-phryn.data/max(phryn.data,na.rm=TRUE)

Now create our plot.

h<-max(nodeHeights(phryn.tree))
m<-ncol(phryn.data)
cols<-RColorBrewer::brewer.pal(n=4,"Spectral")
xlim<-ylim<-1.2*c(-h,h)+c(-1,1)*0.1*m*h+0.02*c(-h,h)
ylim<-c(0,ylim[2])
plotTree(phryn.tree,type="fan",xlim=xlim,ylim=ylim,
    lwd=1,ftype="i",fsize=0.6,part=0.5)
for(i in 1:m){
    tt<-phryn.tree
    tt$edge.length[which(tt$edge[,2]<=Ntip(tt))]<-
        tt$edge.length[which(tt$edge[,2]<=Ntip(tt))]+
        0.25*h+(i-1)*0.1*h
    plotTree(tt,color="transparent",type="fan",xlim=xlim,
        ylim=ylim,lwd=1,ftype="off",add=TRUE,part=0.5)
    pp1<-get("last_plot.phylo",envir=.PlotPhyloEnv)
    tt$edge.length[which(tt$edge[,2]<=Ntip(tt))]<-
        tt$edge.length[which(tt$edge[,2]<=Ntip(tt))]+
        0.09*h
    plotrix::draw.circle(0,0,radius=h+0.25*h+(i-1)*0.1*h,
        border="#505050")
    plotTree(tt,color="transparent",type="fan",xlim=xlim,
        ylim=ylim,lwd=1,ftype="off",add=TRUE,part=0.5)
    pp2<-get("last_plot.phylo",envir=.PlotPhyloEnv)
    par(lend=1)
    for(j in 1:Ntip(phryn.tree)){
        ii<-which(rownames(phryn.norm)==phryn.tree$tip.label[j])
        dx<-(pp2$xx[j]-pp1$xx[j])*phryn.norm[ii,i]
        dy<-(pp2$yy[j]-pp1$yy[j])*phryn.norm[ii,i]
        #lines(pp1$xx[j]+c(0,1.05*dx),pp1$yy[j]+c(0,1.05*dy),lwd=10,
        #   col=par()$fg)
        lines(pp1$xx[j]+c(0,dx),pp1$yy[j]+c(0,dy),lwd=10,
            col=cols[i])
    }
}
xx<-rep(0.85*par()$usr[4],m)
yy<-0.95*par()$usr[4]-1.5*0:(m-1)*strheight("W")
text(xx,yy,colnames(phryn.norm),pos=4,cex=0.8)
scale.bar<-apply(phryn.norm,2,max,na.rm=TRUE)*0.09*h
xx2<-xx-scale.bar
segments(x0=xx,y0=yy,x1=xx2,y1=yy,lwd=10,col=cols)
text(rep(min(xx2),m),yy,paste(formatC(apply(phryn.data,2,max,
    na.rm=TRUE),digits=1,format="f"),"cm",sep=" "),cex=0.8,
    pos=2)

plot of chunk unnamed-chunk-2

That's it!

No comments:

Post a Comment

Note: due to the very large amount of spam, all comments are now automatically submitted for moderation.