From 59f8ae8afce1aabfe760dce8e96ac265956989ae Mon Sep 17 00:00:00 2001 From: "Liam J. Revell" Date: Sun, 12 Feb 2017 12:34:11 -0500 Subject: [PATCH] update permitted plotting directions for plotSimmap --- DESCRIPTION | 8 +-- R/plotSimmap.R | 155 ++++++++++++++++++++++++++++++++++++++++++---- man/plotSimmap.Rd | 2 +- 3 files changed, 148 insertions(+), 17 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index b44634dc..b9c0174f 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: phytools -Version: 0.5-74 -Date: 2017-02-09 +Version: 0.5-75 +Date: 2017-02-12 Title: Phylogenetic Tools for Comparative Biology (and Other Things) Author: Liam J. Revell Maintainer: Liam J. Revell @@ -56,6 +56,6 @@ Description: Package contains various functions for phylogenetic analysis. research. License: GPL (>= 2) URL: http://github.com/liamrevell/phytools -Packaged: 2017-02-09 12:00:00 EST +Packaged: 2017-02-12 12:00:00 EST Repository: -Date/Publication: 2017-02-09 12:00:00 EST +Date/Publication: 2017-02-12 12:00:00 EST diff --git a/R/plotSimmap.R b/R/plotSimmap.R index 7215e6d7..8b41c691 100644 --- a/R/plotSimmap.R +++ b/R/plotSimmap.R @@ -33,26 +33,160 @@ plotSimmap<-function(tree,colors=NULL,fsize=1.0,ftype="reg",lwd=2, if(is.null(mar)) mar=rep(0.1,4) if(hold) null<-dev.hold() if(type=="phylogram"){ - plotPhylogram(tree,colors,fsize,ftype,lwd,pts,node.numbers,mar,add,offset, - direction,setEnv,xlim,ylim,nodes,tips,split.vertical,lend,asp) + if(direction%in%c("upwards","downwards")) + updownPhylogram(tree,colors,fsize,ftype,lwd,pts,node.numbers,mar,add,offset, + direction,setEnv,xlim,ylim,nodes,tips,split.vertical,lend,asp) + else plotPhylogram(tree,colors,fsize,ftype,lwd,pts,node.numbers,mar,add,offset, + direction,setEnv,xlim,ylim,nodes,tips,split.vertical,lend,asp) } else if(type=="fan"){ plotFan(tree,colors,fsize,ftype,lwd,mar,add,part,setEnv,xlim,ylim,tips, maxY,lend) } if(hold) null<-dev.flush() } -} +} # function to plot simmap tree in type "phylogram" # written by Liam J. Revell 2011-2015 -plotPhylogram<-function(tree,colors,fsize,ftype,lwd,pts,node.numbers,mar, +updownPhylogram<-function(tree,colors,fsize,ftype,lwd,pts,node.numbers,mar, add,offset,direction,setEnv,xlim,ylim,placement,tips,split.vertical,lend, asp){ + if(split.vertical&&!setEnv){ + cat("split.vertical requires setEnv=TRUE. Setting split.vertical to FALSE.\n") + spit.vertical<-FALSE + } # set offset fudge (empirically determined) + offsetFudge<-1.37 + # reorder + cw<-reorderSimmap(tree) + pw<-reorderSimmap(tree,"postorder") + # count nodes and tips + n<-Ntip(cw) + m<-cw$Nnode + # Y coordinates for nodes + Y<-matrix(NA,m+n,1) + # first, assign y coordinates to all the tip nodes + if(is.null(tips)) Y[cw$edge[cw$edge[,2]<=n,2]]<-1:n + else Y[cw$edge[cw$edge[,2]<=n,2]]<-if(is.null(names(tips))) + tips[sapply(1:Ntip(cw),function(x,y) which(y==x),y=cw$edge[cw$edge[,2]<=n,2])] + else tips[gsub(" ","_",cw$tip.label)] + # get Y coordinates of the nodes + nodes<-unique(pw$edge[,1]) + for(i in 1:m){ + if(placement=="intermediate"){ + desc<-pw$edge[which(pw$edge[,1]==nodes[i]),2] + Y[nodes[i]]<-(min(Y[desc])+max(Y[desc]))/2 + } else if(placement=="centered"){ + desc<-getDescendants(pw,nodes[i]) + desc<-desc[desc<=Ntip(pw)] + Y[nodes[i]]<-(min(Y[desc])+max(Y[desc]))/2 + } else if(placement=="weighted"){ + desc<-pw$edge[which(pw$edge[,1]==nodes[i]),2] + n1<-desc[which(Y[desc]==min(Y[desc]))] + n2<-desc[which(Y[desc]==max(Y[desc]))] + v1<-pw$edge.length[which(pw$edge[,2]==n1)] + v2<-pw$edge.length[which(pw$edge[,2]==n2)] + Y[nodes[i]]<-((1/v1)*Y[n1]+(1/v2)*Y[n2])/(1/v1+1/v2) + } else if(placement=="inner"){ + desc<-getDescendants(pw,nodes[i]) + desc<-desc[desc<=Ntip(pw)] + mm<-which(abs(Y[desc]-median(Y[1:Ntip(pw)]))==min(abs(Y[desc]- + median(Y[1:Ntip(pw)])))) + if(length(mm>1)) mm<-mm[which(Y[desc][mm]==min(Y[desc][mm]))] + Y[nodes[i]]<-Y[desc][mm] + } + } + # compute node heights + H<-nodeHeights(cw) + # open plot + par(mar=mar) + if(is.null(offset)) offset<-0.2*lwd/3+0.2/3 + if(!add) plot.new() + ### + if(is.null(ylim)){ + pp<-par("pin")[2] + sw<-fsize*(max(strwidth(cw$tip.label,units="inches")))+ + offsetFudge*fsize*strwidth("W",units="inches") + alp<-optimize(function(a,H,sw,pp) (a*1.04*max(H)+sw-pp)^2,H=H,sw=sw,pp=pp, + interval=c(0,1e6))$minimum + ylim<-if(direction=="downwards") c(min(H)-sw/alp,max(H)) else c(min(H),max(H)+sw/alp) + } + if(is.null(xlim)) xlim=range(Y) + if(direction=="downwards") H<-max(H)-H + plot.window(xlim=xlim,ylim=ylim,asp=asp) + #### + if(!split.vertical){ + for(i in 1:m) lines(Y[cw$edge[which(cw$edge[,1]==nodes[i]),2]], + H[which(cw$edge[,1]==nodes[i]),1], + col=colors[names(cw$maps[[match(nodes[i], + cw$edge[,1])]])[1]],lwd=lwd) + } + for(i in 1:nrow(cw$edge)){ + x<-H[i,1] + for(j in 1:length(cw$maps[[i]])){ + if(direction=="downwards") + lines(c(Y[cw$edge[i,2]],Y[cw$edge[i,2]]),c(x,x-cw$maps[[i]][j]), + col=colors[names(cw$maps[[i]])[j]],lwd=lwd,lend=lend) + else lines(c(Y[cw$edge[i,2]],Y[cw$edge[i,2]]),c(x,x+cw$maps[[i]][j]), + col=colors[names(cw$maps[[i]])[j]],lwd=lwd,lend=lend) + if(pts) points(c(Y[cw$edge[i,2]],Y[cw$edge[i,2]]),c(x,x+cw$maps[[i]][j]), + pch=20,lwd=(lwd-1)) + x<-x+if(direction=="downwards") -cw$maps[[i]][j] else cw$maps[[i]][j] + j<-j+1 + } + } + if(node.numbers){ + symbols(mean(Y[cw$edge[cw$edge[,1]==(Ntip(cw)+1),2]]), + if(direction=="downwards") max(H) else 0, + rectangles=matrix(c(1.2*fsize*strwidth(as.character(Ntip(cw)+1)), + 1.4*fsize*strheight(as.character(Ntip(cw)+1))),1,2),inches=FALSE, + bg="white",add=TRUE) + text(mean(Y[cw$edge[cw$edge[,1]==(Ntip(cw)+1),2]]), + if(direction=="downwards") max(H) else 0,Ntip(cw)+1, + cex=fsize) + for(i in 1:nrow(cw$edge)){ + x<-H[i,2] + if(cw$edge[i,2]>Ntip(cw)){ + symbols(Y[cw$edge[i,2]],x, + rectangles=matrix(c(1.2*fsize*strwidth(as.character(cw$edge[i,2])), + 1.4*fsize*strheight(as.character(cw$edge[i,2]))),1,2),inches=FALSE, + bg="white",add=TRUE) + text(Y[cw$edge[i,2]],x,cw$edge[i,2],cex=fsize) + } + } + } + if(direction=="downwards") pos<-if(par()$usr[3]>par()$usr[4]) 2 else 4 + if(direction=="upwards") pos<-if(par()$usr[3]>par()$usr[4]) 2 else 4 + for(i in 1:n) if(ftype){ + text(labels=cw$tip.label[i],Y[i], + H[which(cw$edge[,2]==i),2]+if(direction=="downwards") + -offset*mean(strwidth(LETTERS)) else offset*mean(strwidth(LETTERS)), + pos=pos,offset=0,cex=fsize,font=ftype, + srt=if(direction=="downwards") 270 else 90) + } + if(setEnv){ + PP<-list(type="phylogram",use.edge.length=TRUE,node.pos=1, + show.tip.label=if(ftype) TRUE else FALSE,show.node.label=FALSE, + font=ftype,cex=fsize,adj=0,srt=0,no.margin=FALSE,label.offset=offset, + x.lim=xlim,y.lim=ylim, + direction=direction,tip.color="black",Ntip=Ntip(cw),Nnode=cw$Nnode, + edge=cw$edge,xx=Y[,1],yy=sapply(1:(Ntip(cw)+cw$Nnode), + function(x,y,z) y[match(x,z)],y=H,z=cw$edge)) + assign("last_plot.phylo",PP,envir=.PlotPhyloEnv) + } + if(split.vertical) splitEdgeColor(cw,colors,lwd) +} + +# function to plot simmap tree in type "phylogram" +# written by Liam J. Revell 2011-2015 +plotPhylogram<-function(tree,colors,fsize,ftype,lwd,pts,node.numbers,mar, + add,offset,direction,setEnv,xlim,ylim,placement,tips,split.vertical,lend, + asp){ if(split.vertical&&!setEnv){ cat("split.vertical requires setEnv=TRUE. Setting split.vertical to FALSE.\n") spit.vertical<-FALSE } + # set offset fudge (empirically determined) offsetFudge<-1.37 # reorder cw<-reorderSimmap(tree) @@ -109,12 +243,7 @@ plotPhylogram<-function(tree,colors,fsize,ftype,lwd,pts,node.numbers,mar, xlim<-if(direction=="leftwards") c(min(H)-sw/alp,max(H)) else c(min(H),max(H)+sw/alp) } if(is.null(ylim)) ylim=range(Y) - if(direction=="leftwards"){ - H<-max(H)-H - ## H<-H[,2:1] - ## plot.window(xlim=xlim[2:1],ylim=ylim) - ## plot.window(xlim=xlim,ylim=ylim) - } + if(direction=="leftwards") H<-max(H)-H plot.window(xlim=xlim,ylim=ylim,asp=asp) #### if(!split.vertical){ @@ -137,11 +266,13 @@ plotPhylogram<-function(tree,colors,fsize,ftype,lwd,pts,node.numbers,mar, } } if(node.numbers){ - symbols(0,mean(Y[cw$edge[cw$edge[,1]==(Ntip(cw)+1),2]]), + symbols(if(direction=="leftwards") max(H) else 0, + mean(Y[cw$edge[cw$edge[,1]==(Ntip(cw)+1),2]]), rectangles=matrix(c(1.2*fsize*strwidth(as.character(Ntip(cw)+1)), 1.4*fsize*strheight(as.character(Ntip(cw)+1))),1,2),inches=FALSE, bg="white",add=TRUE) - text(0,mean(Y[cw$edge[cw$edge[,1]==(Ntip(cw)+1),2]]),Ntip(cw)+1, + text(if(direction=="leftwards") max(H) else 0, + mean(Y[cw$edge[cw$edge[,1]==(Ntip(cw)+1),2]]),Ntip(cw)+1, cex=fsize) for(i in 1:nrow(cw$edge)){ x<-H[i,2] diff --git a/man/plotSimmap.Rd b/man/plotSimmap.Rd index a911462f..281b51f9 100644 --- a/man/plotSimmap.Rd +++ b/man/plotSimmap.Rd @@ -23,7 +23,7 @@ plotSimmap(tree, colors=NULL, fsize=1.0, ftype="reg", lwd=2, pts=FALSE, \item{mar}{vector containing the margins for the plot to be passed to \code{\link{par}}. If not specified, the default margins are [0.1,0.1,0.1,0.1].} \item{add}{a logical value indicating whether or not to add the plotted tree to the current plot (\code{TRUE}) or create a new plot (\code{FALSE}, the default).} \item{offset}{offset for the tip labels. Primarily to be used internally by \code{\link{densityMap}}.} - \item{direction}{plotting direction. Options are \code{"rightwards"} (the default) and \code{"leftwards"}. Note that for some reason that is not totally clear, \code{node.numbers=TRUE} does not work for \code{direction="leftwards"}.} + \item{direction}{plotting direction. Options are \code{"rightwards"} (the default), \code{"leftwards"}, \code{"upwards"} or \code{"downwards"}. For \code{method="fan"} \code{direction} is ignored.} \item{type}{plot type. Can be \code{"phylogram"} or \code{"fan"}. Only a subset of options are presently available for \code{type="fan"}.} \item{setEnv}{logical value indicating whether or not to set the environment \code{.PlotPhyloEnv}. Setting this to \code{TRUE} (the default) will allow compatibility with ape labeling functions such as \code{\link{nodelabels}}.} \item{part}{value between 0 and 1 for \code{type="fan"} indicating what fraction of the full circular tree to use as plotting area. For instance, \code{part=0.5} will plot a half fan phylogeny. It also affects the axis scaling used.}