up- or down-facing contMap & densityMap plots

liamrevell · Feb 13, 2017 · 11f7760 · 11f7760
1 parent 2381744
commit 11f7760
Show file tree

Hide file tree

Showing 4 changed files with 44 additions and 17 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: phytools
-Version: 0.5-75
+Version: 0.5-76
-Date: 2017-02-12
+Date: 2017-02-13
 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-12 12:00:00 EST
+Packaged: 2017-02-13 12:00:00 EST
 Repository: 
-Date/Publication: 2017-02-12 12:00:00 EST
+Date/Publication: 2017-02-13 12:00:00 EST
diff --git a/R/contMap.R b/R/contMap.R
@@ -1,5 +1,5 @@
-# function plots reconstructed values for ancestral characters along the edges of the tree
+## function plots reconstructed values for ancestral characters along the edges of the tree
-# written by Liam J. Revell 2012, 2013, 2014, 2015, 2016
+## written by Liam J. Revell 2012-2017
 contMap<-function(tree,x,res=100,fsize=NULL,ftype=NULL,lwd=4,legend=NULL,
 	lims=NULL,outline=TRUE,sig=3,type="phylogram",direction="rightwards",
 	plot=TRUE,...){

diff --git a/R/densityMap.R b/R/densityMap.R
@@ -131,14 +131,29 @@ plot.densityMap<-function(x,...){
 	}
 	if(hold) null<-dev.hold()
 	if(type=="phylogram"){
+		if(direction%in%c("upwards","downwards")&&legend){
+			par(mar=mar)
+			plot.new()
+		}
 		N<-length(tree$tip.label)
-		if(legend&&is.null(ylim)) ylim<-c(1-0.12*(N-1),N)
+		if(legend&&is.null(ylim)){
-		else if(is.null(ylim)) ylim<-NULL
+			if(direction%in%c("rightwards","leftwards")) ylim<-c(1-0.12*(N-1),N)
+			else {
+				pp<-par("pin")[2]
+				sw<-(fsize*(max(strwidth(x$tree$tip.label,units="inches")))+
+					1.37*fsize*strwidth("W",units="inches"))[1]
+				alp<-optimize(function(a,H,sw,pp) (a*1.2*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-0.16*max(H),max(H)) else 
+					c(min(H)-0.16*max(H),max(H)+sw/alp)
+			}
+		} else if(is.null(ylim)) ylim<-NULL
 		if(outline){
 			par(col="transparent")
 			plotTree(tree,fsize=fsize[1],lwd=lwd[1]+2,
 				offset=offset+0.2*lwd[1]/3+0.2/3,ftype=ftype[1],xlim=xlim,
-				ylim=ylim,mar=mar,direction=direction,hold=FALSE)
+				ylim=ylim,mar=mar,direction=direction,hold=FALSE,
+				add=FALSE,direction%in%c("upwards","downwards")&&legend)
 			par(col="black")
 		}
 		plotSimmap(tree,cols,pts=FALSE,lwd=lwd[1],fsize=fsize[1],mar=mar,ftype=ftype[1],add=outline,
@@ -150,11 +165,23 @@ plot.densityMap<-function(x,...){
 				dig
 			}
 			dig<-max(sapply(strsplit(leg.txt[c(1,3)],split=""),ff))
-			add.color.bar(legend,cols,title=leg.txt[2],lims<-as.numeric(leg.txt[c(1,3)]),
+			print(dig)
-				digits=dig,prompt=FALSE,x=if(direction=="leftwards") max(H)-legend else 0,
+			if(direction%in%c("rightwards","leftwards"))
-				y=1-0.08*(N-1),lwd=lwd[2],
+				add.color.bar(legend,cols,title=leg.txt[2],lims<-as.numeric(leg.txt[c(1,3)]),
-				fsize=fsize[2],
+					digits=dig,prompt=FALSE,x=if(direction=="leftwards") max(H)-legend else 0,
-				direction=if(!is.null(xlim)) if(xlim[2]<xlim[1]) "leftwards" else "rightwards" else "rightwards")
+					y=1-0.08*(N-1),lwd=lwd[2],
+					fsize=fsize[2],
+					direction=if(!is.null(xlim)) if(xlim[2]<xlim[1]) "leftwards" else 
+					"rightwards" else "rightwards")
+			else if(direction%in%c("upwards","downwards")){
+				print(legend)
+				sf<-abs(diff(par()$usr[1:2])/diff(par()$usr[3:4]))*
+					par()$pin[2]/par()$pin[1]
+				add.color.bar(legend*sf,cols,title=leg.txt[2],lims<-as.numeric(leg.txt[c(1,3)]),
+					digits=dig,prompt=FALSE,x=1,y=ylim[1]+0.04*max(nodeHeights(x$tree)),lwd=lwd[2],
+					fsize=fsize[2],direction="rightwards",subtitle=paste("length=",round(legend,
+					3),sep=""))
+			}
 		}
 	} else if(type=="fan"){
 		if(outline){

diff --git a/R/plotSimmap.R b/R/plotSimmap.R
@@ -1,5 +1,5 @@
 ## functions plot stochastic character mapped trees
-## written by Liam Revell 2011-2016
+## written by Liam Revell 2011-2017
 
 plotSimmap<-function(tree,colors=NULL,fsize=1.0,ftype="reg",lwd=2,
 	pts=FALSE,node.numbers=FALSE,mar=NULL,add=FALSE,offset=NULL,direction="rightwards",
@@ -46,8 +46,8 @@ plotSimmap<-function(tree,colors=NULL,fsize=1.0,ftype="reg",lwd=2,
 	}
 }
 
-# function to plot simmap tree in type "phylogram"
+## function to plot simmap tree in type "phylogram"
-# written by Liam J. Revell 2011-2015
+## written by Liam J. Revell 2011-2017
 updownPhylogram<-function(tree,colors,fsize,ftype,lwd,pts,node.numbers,mar,
 	add,offset,direction,setEnv,xlim,ylim,placement,tips,split.vertical,lend,
 	asp){