Permalink
Browse files

update permitted plotting directions for plotSimmap

  • Loading branch information...
1 parent b3055f6 commit 59f8ae8afce1aabfe760dce8e96ac265956989ae @liamrevell committed Feb 12, 2017
Showing with 148 additions and 17 deletions.
  1. +4 −4 DESCRIPTION
  2. +143 −12 R/plotSimmap.R
  3. +1 −1 man/plotSimmap.Rd
View
@@ -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 <liam.revell@umb.edu>
@@ -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
View
@@ -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]
View
@@ -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.}

0 comments on commit 59f8ae8

Please sign in to comment.