Skip to content

Commit

Permalink
update permitted plotting directions for plotSimmap
Browse files Browse the repository at this point in the history
  • Loading branch information
@liamrevell
liamrevell committed Feb 12, 2017
1 parent b3055f6 commit 59f8ae8
Show file tree
Hide file tree
Showing 3 changed files with 148 additions and 17 deletions.
8 changes: 4 additions & 4 deletions DESCRIPTION
View file
@@ -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>
Expand Down Expand Up @@ -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
155 changes: 143 additions & 12 deletions R/plotSimmap.R
View file
Expand Up @@ -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)
Expand Down Expand Up @@ -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){
Expand All @@ -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]
Expand Down
2 changes: 1 addition & 1 deletion man/plotSimmap.Rd
View file
Expand Up @@ -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.}
Expand Down

0 comments on commit 59f8ae8

Please sign in to comment.