A phytools user last night very helpfully reported that the phytools function reroot, which reroots the tree along an edge, throws an error if the input tree has node labels. Indeed, this seems to be the case. Here is the code supplied by the user (slightly modified) demonstrating the bug:

library(phytools)
set.seed(1) ## just for reproducibility
##  no node labels
tr<-rtree(12)
plotTree(tr)

nod<-fastMRCA(tr,"t6","t10") ## arbitrarily
rtr<-reroot(tr,node.number=nod,position=0.5*tr$edge.length[which(tr$edge[,2]==nod)])
plotTree(rtr) ## works fine

## now try the same with node labels
tr$node.label<-paste("n",1:tr$Nnode,sep="")
plotTree(tr)
nodelabels(tr$node.label)

rtr<-reroot(tr, node.number=nod, position=0.5*tr$edge.length[which(tr$edge[,2]==nod)])

## Error in if (newroot == ROOT) {: argument is of length zero

This morning I was able to get to the bottom of this bug. Basically, the function reroot uses the phytools (mostly internal, but in the namespace) function splitTree to first split the tree at the desired point for re-rooting, then reroots the tree using the split point in the “parent” subtree as the new root. It identifies this split point in the parent tree because it has the tip label of "NA". Unfortunately, if the input tree has node labels, then the new node will be labeled not with "NA", but with the node label of the input tree.

I have now posted a new version of this function with this bug fixed. I accomplished this by checking for tips labeled first with "NA" and then, if none are found, with any of the node labels of the input tree. This will work fine unless any of the node labels are the same as tip labels (or "NA"). This probably should be avoided anyway.

Here is how it works:

detach("package:phytools",unload=TRUE)
## install new phytools with bug fix
install.packages("phytools_0.4-47.tar.gz",type="source",repos=NULL)

## Installing package into 'C:/Users/Liam/Documents/R/win-library/3.1'
## (as 'lib' is unspecified)

library(phytools)
packageVersion("phytools")

## [1] '0.4.47'

rtr<-reroot(tr, node.number=nod, position=0.5*tr$edge.length[which(tr$edge[,2]==nod)])
plotTree(rtr)
nodelabels(rtr$node.label)

Great!

Recently, a phytools user correctly reported a bugin the phytools function reroot to re-root a tree along an edge when the input tree contained node labels. I thought I had identified it's cause and fixed it (details here). Specifically, the problem is caused by the fact that the function drop.tip(...,trim.internal=FALSE) will leave behind "NA" as a tip label for the trimmed clade when node labels are absent; however it will instead use the node labels if they are present. I fixed the (primarily internal) phytools function splitTree for this issue; however I failed to realize that I also needed to update the function drop.clade. I have now done this and posted the updated code here.

Let's try it with the old version & the new one:

library(phytools)
set.seed(1) ## set seed for reproducibility
tree<-rtree(n=26)
tree$tip.label<-LETTERS
plotTree(tree)

node<-37
position=0.5*tree$edge.length[which(tree$edge[,2]==node)]
plotTree(reroot(tree,node,position)) ## works fine

## now try with node labels
tree$node.label<-paste("n",1:tree$Nnode,sep="")
rerooted.tree<-reroot(tree,node,position) ## breaks

## Error in if (newroot == ROOT) {: argument is of length zero

Now let's update to the latest phytools version (not on CRAN) and re-attempt:

detach("package:phytools",unload=TRUE)
install.packages("phytools_0.4-48.tar.gz",type="source",repos=NULL)

## Installing package into 'C:/Users/Liam/Documents/R/win-library/3.1'
## (as 'lib' is unspecified)

library(phytools)
rerooted.tree<-reroot(tree,node,position)
plotTree(rerooted.tree)
nodelabels(rerooted.tree$node.label)

The most recent working version of phytools can always be downloaded here.

That's it.

I have just postedyet another bug fix for the phytools function reroot for trees containing node labels. This bug (reported by a helpful user) had the effect of causing one of the edge lengths descended from the new root to be wrong.

All are basically related to the same underlying issue which is that the ape function drop.tip(...,trim.internal=FALSE) will label the stem of a trimmed clade with the tip label "NA" when node labels are absent, but the node label itself when present. All of the internals used by reroot were originally built around the assumption that the trimmed edge would be labeled "NA". Unfortunately, this created issues for multiple internals - which I have been peeling back & fixing one-by-one.

This update is also in the latest (non-CRAN) phytools version which, as always, can be obtained from the phytools webpage.

Here is a quick demo of the bug & its fix.

First reroot behaving properly for a tree without node labels:

library(phytools)
## simulate a tree
set.seed(1)
tree<-rtree(n=26,tip.label=LETTERS)
plotTree(tree)
nodelabels()

## here with a tree without node labels
t1<-reroot(tree,31,0.5*tree$edge.length[which(tree$edge[,2]==31)])
plotTree(t1)

## we re-rooting in the middle of an edge so
## these should be equal
t1$edge.length[which(t1$edge[,1]==(Ntip(t1)+1))]

## [1] 0.3661569 0.3661569

OK, now here it is misbehaving. The tree is re-rooted in the right spot, but the edge lengths descended from the root are wrong:

## add node labels
tree$node.label<-paste("n",1:tree$Nnode+Ntip(tree),sep="")
plotTree(tree)
nodelabels(tree$node.label)

t2<-reroot(tree,31,0.5*tree$edge.length[which(tree$edge[,2]==31)])
plotTree(t2) ## look at the edge lengths
nodelabels(t2$node.label)

## these should be equal, but they are not
t2$edge.length[which(t1$edge[,1]==(Ntip(t2)+1))]

## [1] 2.2862548 0.3661569

OK, now let's load the fix and try again:

detach("package:phytools", unload=TRUE)
install.packages("phytools_0.4-49.tar.gz",type="source")

## Installing package into 'C:/Users/Liam/Documents/R/win-library/3.1'
## (as 'lib' is unspecified)
## inferring 'repos = NULL' from 'pkgs'

library(phytools)
t2<-reroot(tree,31,0.5*tree$edge.length[which(tree$edge[,2]==31)])
plotTree(t2)
nodelabels(t2$node.label)

## these should be equal
t2$edge.length[which(t1$edge[,1]==(Ntip(t2)+1))]

## [1] 0.3661569 0.3661569

That's it.

Stimulated by a user inquiry, here is a quick re-hash of ancestral character estimation using the phytools function make.simmap when tip states are uncertain.

Firstly, let's simulate some data with the property of uncertainty in the tip values - that is, we do not know the states for some extant taxa in the tree. The way this is expressed is as a prior probability distribution on the states for those tips that we do not know. For instance, if our character has two states "a"& "b", and we are completely ignorant of the values of certain species in the tree, then we might say that the prior probability of being in each of states "a" or "b" was 0.5.

## load phytools
library(phytools)
## simulate stochastic pure-birth tree
tree<-pbtree(n=26,tip.label=LETTERS,scale=1)
## generate character transition matrix
Q<-matrix(c(-1,1,1,-1),2,2)
rownames(Q)<-colnames(Q)<-letters[1:2]
Q

##    a  b
## a -1  1
## b  1 -1

## simulate character
x<-sim.history(tree,Q)$states

## Done simulation(s).

x

##   A   B   C   D   E   F   G   H   I   J   K   L   M   N   O   P   Q   R 
## "b" "b" "b" "b" "b" "b" "b" "b" "b" "b" "b" "a" "a" "a" "b" "b" "b" "b" 
##   S   T   U   V   W   X   Y   Z 
## "b" "b" "b" "a" "a" "a" "a" "a"

Next, we have to add some uncertainty. Arbitrarily, let's say that we do not know the states of five of the twenty-six taxa in our tree. For the simulation, let's choose the five taxa with missing data at random:

## first encode our original data as a matrix
x<-to.matrix(x,seq=letters[1:2])
x

##   a b
## A 0 1
## B 0 1
## C 0 1
## D 0 1
## E 0 1
## F 0 1
## G 0 1
## H 0 1
## I 0 1
## J 0 1
## K 0 1
## L 1 0
## M 1 0
## N 1 0
## O 0 1
## P 0 1
## Q 0 1
## R 0 1
## S 0 1
## T 0 1
## U 0 1
## V 1 0
## W 1 0
## X 1 0
## Y 1 0
## Z 1 0

## now set some of these taxa to be uncertain
x[sample(1:26,5),]<-rep(0.5,2)
x

##     a   b
## A 0.0 1.0
## B 0.0 1.0
## C 0.0 1.0
## D 0.0 1.0
## E 0.0 1.0
## F 0.5 0.5
## G 0.0 1.0
## H 0.5 0.5
## I 0.0 1.0
## J 0.0 1.0
## K 0.0 1.0
## L 1.0 0.0
## M 1.0 0.0
## N 1.0 0.0
## O 0.0 1.0
## P 0.0 1.0
## Q 0.0 1.0
## R 0.5 0.5
## S 0.0 1.0
## T 0.5 0.5
## U 0.0 1.0
## V 1.0 0.0
## W 1.0 0.0
## X 0.5 0.5
## Y 1.0 0.0
## Z 1.0 0.0

Finally, let's generate some stochastic character maps using the phytools function make.simmap:

trees<-make.simmap(tree,x,nsim=100)

## make.simmap is sampling character histories conditioned on the transition matrix
## Q =

##            a          b
## a -0.9951156  0.9951156
## b  0.9951156 -0.9951156

## (estimated using likelihood);
## and (mean) root node prior probabilities
## pi =

##   a   b 
## 0.5 0.5

## Done.

trees

## 100 phylogenetic trees

If we want to obtain the posterior probabilities at nodes or tips, we can use the function describe.simmap:

obj<-describe.simmap(trees)
obj

## 100 trees with a mapped discrete character with states:
##  a, b 
## 
## trees have 7.6 changes between states on average
## 
## changes are of the following types:
##       a,b  b,a
## x->y 3.55 4.05
## 
## mean total time spent in each state is:
##              a         b    total
## raw  2.4524900 5.0739916 7.526482
## prop 0.3258481 0.6741519 1.000000

plot(obj)

The matrices of posterior probabilities at nodes and tips are stored in the two matrices obj$ace and obj$tips, respectively. Check it out:

obj$ace

##       a    b
## 27 0.35 0.65
## 28 0.07 0.93
## 29 0.05 0.95
## 30 0.05 0.95
## 31 0.13 0.87
## 32 0.11 0.89
## 33 0.00 1.00
## 34 0.00 1.00
## 35 0.00 1.00
## 36 0.00 1.00
## 37 0.00 1.00
## 38 0.00 1.00
## 39 0.00 1.00
## 40 0.00 1.00
## 41 0.59 0.41
## 42 1.00 0.00
## 43 0.00 1.00
## 44 0.07 0.93
## 45 0.49 0.51
## 46 0.27 0.73
## 47 0.88 0.12
## 48 0.89 0.11
## 49 0.83 0.17
## 50 0.95 0.05
## 51 1.00 0.00

obj$tips

##      a    b
## A 0.00 1.00
## B 0.00 1.00
## C 0.00 1.00
## D 0.00 1.00
## E 0.00 1.00
## F 0.09 0.91
## G 0.00 1.00
## H 0.01 0.99
## I 0.00 1.00
## J 0.00 1.00
## K 0.00 1.00
## L 1.00 0.00
## M 1.00 0.00
## N 1.00 0.00
## O 0.00 1.00
## P 0.00 1.00
## Q 0.00 1.00
## R 0.20 0.80
## S 0.00 1.00
## T 0.42 0.58
## U 0.00 1.00
## V 1.00 0.00
## W 1.00 0.00
## X 0.86 0.14
## Y 1.00 0.00
## Z 1.00 0.00

Of course, the posterior probabilities at the tips will normally be different than the prior probabilities, as we would expect.

Another possibility, of course, for visualizing the variability across maps at nodes & tips is the phytools function densityMap.

densityMap(trees,outline=TRUE)

## sorry - this might take a while; please be patient

Finally, if we didn't know that the function describe.simmapexisted, it would not be too difficult to get these same values using the function getStates from phytools, as follows:

## first nodes
X<-getStates(trees)
levs<-sort(unique(as.vector(X)))
ace<-t(apply(X,1,function(x,l) summary(factor(x,levels=l)),l=levs))/ncol(X)
ace

##       a    b
## 27 0.35 0.65
## 28 0.07 0.93
## 29 0.05 0.95
## 30 0.05 0.95
## 31 0.13 0.87
## 32 0.11 0.89
## 33 0.00 1.00
## 34 0.00 1.00
## 35 0.00 1.00
## 36 0.00 1.00
## 37 0.00 1.00
## 38 0.00 1.00
## 39 0.00 1.00
## 40 0.00 1.00
## 41 0.59 0.41
## 42 1.00 0.00
## 43 0.00 1.00
## 44 0.07 0.93
## 45 0.49 0.51
## 46 0.27 0.73
## 47 0.88 0.12
## 48 0.89 0.11
## 49 0.83 0.17
## 50 0.95 0.05
## 51 1.00 0.00

## now tips
X<-getStates(trees,"tips")
levs<-sort(unique(as.vector(X)))
tips<-t(apply(X,1,function(x,l) summary(factor(x,levels=l)),l=levs))/ncol(X)
tips

##      a    b
## A 0.00 1.00
## B 0.00 1.00
## C 0.00 1.00
## D 0.00 1.00
## E 0.00 1.00
## F 0.09 0.91
## G 0.00 1.00
## H 0.01 0.99
## I 0.00 1.00
## J 0.00 1.00
## K 0.00 1.00
## L 1.00 0.00
## M 1.00 0.00
## N 1.00 0.00
## O 0.00 1.00
## P 0.00 1.00
## Q 0.00 1.00
## R 0.20 0.80
## S 0.00 1.00
## T 0.42 0.58
## U 0.00 1.00
## V 1.00 0.00
## W 1.00 0.00
## X 0.86 0.14
## Y 1.00 0.00
## Z 1.00 0.00

That's it.

A phytools user recently contacted me with some questions about her analyses and expressed some surprise at having discovered that bounds on the Brownian motion process tended to decrease phylogenetic signal measured using Blomberg et al.'s (2003) K statistic.

K is a measure of phylogenetic signal that is based on a standardized variance ratio - measuring the variance among vs. within clades compared to the ratio expected under Brownian motion. Consequently it has an expected value of 1.0, although the variance for a single simulation condition can be quite high.

Based simply on the logic of what K measures it shouldn't be too difficult to predict what happens to K when bounds are added to the Brownian process. That is, bounds will tend to cause the phenotypic values of species in unrelated clades to be more similar than expected under a pure Brownian process, making variability structured increasingly equally between & among clades. This effect should increase for decreasing bounds, as well as for increasing rate (σ² of the Broanian process), because both will cause evolving lineages to reach the boundaries more often.

This is also pretty easy to demonstrate via simulation. Here I have just simulated under a range of different conditions for the rate & bounds given a single tree, but the results hold generally.

## load packages
library(phytools)
## function to conduct simulation
foo<-function(tree,sig2,range,nsim){
    X<-fastBM(tree,a=range/2,sig2=sig2,bounds=c(0,range),nsim=nsim)
    mean(apply(X,2,phylosig,tree=tree))
}
## simulate tree
tree<-pbtree(n=26,tip.label=LETTERS,scale=1)
## set simulation conditions
sig2<-c(0.1,1:10)
range<-c(0.1,1:10)
nsim<-200
## simulate
K<-sapply(sig2,function(s2,tr,r,n) sapply(r,foo,tree=tr,sig2=s2,
    nsim=n),tr=tree,r=range,n=nsim)
colnames(K)<-sig2
rownames(K)<-range
## plot the result
filled.contour(x=range,y=sig2,K,xlab="range",ylab="rate",
    zlim=c(0,max(K)),color.palette=terrain.colors,
    main="Phylogenetic signal (K) for bounded BM")

Here we can see easily that for increasing rate (vertical axis) and decreasing bounds (horizontal axis), phylogenetic signal decreases - just as we predicted.

Note that, just as we showed in Revell et al. (2008; Syst. Biol.) there is no relationship between σ² and phylogenetic signal, K for unbounded Brownian motion:

foo<-function(tree,sig2,nsim){
    X<-fastBM(tree,sig2=sig2,nsim=nsim)
    apply(X,2,phylosig,tree=tree)
}
sig2<-c(0.001,0.01,0.1,1.0,10,100)
K<-sapply(sig2,foo,tree=tree,nsim=100)
colnames(K)<-sig2
boxplot(K,xlab="rate",ylab="phylogenetic signal (K)",
    main="Phylogenetic signal (K) for unbounded BM")
lines(colMeans(K),lty="dashed")
points(colMeans(K),pch=24)

That's it.

An R-sig-phylo subscriber asked the following yesterday:

I'm searching for a way to plot a huge phylogenetic tree to multiple pages in one searchable pdf file from R…. Does anybody know if this is possible and an effective way of doing this?

Well, my first response was that phytools has a function, splitplotTree, that can be used to split a plotted tree across columns in a single plotting window, or across plotting devices. Consequently, I responded:

One option is to use the function splitplotTree in phytools. By default it plots the split tree in two columns, but there is an option to split it into two windows. Then each plotted tree could be saved as a PDF.

On further thought, I realized that there is a better way. plotSimmap in phytools (and, consequently, plotTree, which uses plotTree, which uses plotSimmap internally) allows the user to control the y-limits of the plot. As a result it would be straightforward to write a simple wrapper that split the tree using a moving window over the plotting area. It also allows us to relatively easily split our tree over more than two pages. The following is an example of what that might look like:

split.plotTree<-function(tree,splits=NULL,file=NULL,...){
    ef<-0.037037037037
    if(!is.null(file)) pdf(file,width=8.5,height=11)
    if(is.null(splits)) splits<-(floor(0.5*Ntip(tree))+0.5)/Ntip(tree)
    S<-matrix(c(0,splits,splits,1+1/Ntip(tree)),length(splits)+1,2)
    S<-cbind(S[,1]+ef*(S[,2]-S[,1]),S[,2]-ef*(S[,2]-S[,1]))
    for(i in nrow(S):1){
        if(is.null(file)&&i<nrow(S)) par(ask=TRUE)
        plotTree(tree,ylim=Ntip(tree)*S[i,],...)
    }
    if(!is.null(file)) oo<-dev.off()
}

Note that in order to avoid having the tips & edges near the bottom of each page plot at the top of the following page, I had to trim ~4% off of the top & bottom of each plot. This is because for a given y range, R will create a plotting area that is 4% on each size larger than the area specified.

OK, now let's try it:

library(phytools)
n<-100
## create realistic tip labels
foo<-function(i) paste(sample(LETTERS,1),"._",paste(sample(letters,round(runif(1,min=4,max=8))),
    collapse=""),sep="")
tree<-pbtree(n=n,tip.label=sapply(1:n,foo))
splits<-c(0.255,0.505,0.755)
split.plotTree(tree,splits,ftype="i",mar=rep(1.1,4),fsize=0.9,lwd=1)

The splits mark the proportions of the plotted graph that I want to be displayed on each page.

We can also send the output to a multi-page PDF:

split.plotTree(tree,splits,ftype="i",mar=rep(1,4),file="split.plotTree.pdf",lwd=1)

The output is here: split.plotTree.pdf.

That's it.

After posting a simple wrapper to split a plotted tree across plotting devices or pages of a PDF file, I received the following inquiry:

Would there be a way to modify this so that annotations like node labels and axes could be applied to both 1/2s of a split tree at the same time? I've been struggling with a similar problem using plot.phylo() and we can get our tree to look like what we want on one page, but splitting it up while keeping node and branch annotations etc is problematic.

This seems hard - but is actually not too difficult. I can just add an argument fn that is a function containing the functions we want to run for each page of our plotted tree.

First, here is the function:

split.plotTree<-function(tree,splits=NULL,file=NULL,fn,...){
    ef<-0.037037037037
    if(!is.null(file)) pdf(file,width=8.5,height=11)
    if(is.null(splits)) splits<-(floor(0.5*Ntip(tree))+0.5)/Ntip(tree)
    S<-matrix(c(0,splits,splits,1+1/Ntip(tree)),length(splits)+1,2)
    S<-cbind(S[,1]+ef*(S[,2]-S[,1]),S[,2]-ef*(S[,2]-S[,1]))
    for(i in nrow(S):1){
        if(is.null(file)&&i<nrow(S)) par(ask=TRUE)
        plotTree(tree,ylim=Ntip(tree)*S[i,],...)
        fn()
    }
    if(!is.null(file)) oo<-dev.off()
}

Now, just for example, let's create a custom function that adds an axis to each subplot, and includes node labels:

foo<-function(){
    nodelabels()
    axis(1,at=c(0,round(max(nodeHeights(tree)),2)))
}

Finally, let's load phytools, simulate a tree, and try it out:

library(phytools)
tree<-pbtree(n=90)
split.plotTree(tree,splits=c(0.3275,0.683),fn=foo,ftype="i",
    mar=c(3,1,1,1))

That's all there is to it.

I just posted some code to do a visualization in R in which we can, interactively, succcessively expand and collapse (to its ancestral node) any subtree of the phylogeny.

Since this is an interactive, animated exercise, it probably makes more sense for me to illustrate how it works with a screenshot video, but the code below illustrates the set up for the video demo.

library(phytools)
packageVersion("phytools")

## [1] '0.4.50'

tree<-pbtree(n=64,scale=1)
foo<-function(i,sep="._") paste(c(sample(LETTERS,1),sep,
    sample(letters,6)),collapse="")
tree$tip.label<-sapply(1:Ntip(tree),foo)
## do not run
# pruned<-collapseTree(tree)

Here is a video screeshot of the demo:

I should mention that this function is inspired by (as well as somewhat of a poor man's copy of) the interactive tree plotter on Gavin Naylor's amazing website sharksrays.org. Even if you have no interest in this tree plotter, the website is really neat so I'd encourage you to check it out.

This function is in a new non-CRAN version of phytools.

Feedback welcome.

In the past 24 hrs or so I have done a few things to speed up the new phytools function collapseTree. This function gives an animated, interactive tree plotter through which users can collapse & expand subtrees of the phylogeny to & from their ancestral nodes. Code of this new version is here.

Since the animation requires that the tree be replotted many times in succession, most of the speed-ups I mentioned involves vectorizing various actions, as well as avoiding, where ever possible, the need to recalculate quantities. Specifically, I vectorized the drawing of edges & arcs on the tree (using segments& draw.arc, respectively), and I allow internally used plotting function, fan to accepted precalculated values for the "pruningwise" reordered "phylo" object and for the node heights of the tree, since these must be recomputed every time the same tree is plotted.

I also created a new, internally used function called circles to replace nodelabels from the ape package for the simple task of plotting circles at the nodes & tips of the phylogeny.

Finally, particularly when the tree is very large, I found that the animation would sometimes “blink” when running. This is because there is a discernible gap in time between different parts of the tree and node labels being plotted. To eliminate that phenomenon, I now use the function dev.hold to hold the elements being sent to the plotting device, and dev.flushto flush them.

This actually may turn out to be a handy feature to add to other plotting functions in the phytools package. For instance, compare (on your own machine, of course):

library(phytools)
tree<-pbtree(n=100)
x<-fastBM(tree)
contMap(tree,x,ftype="off") ## appears gradually

dev.hold()

## [1] 0

contMap(tree,x,ftype="off")

dev.flush() ## appears all at once

## [1] 0

Finally, here is another video showing the use of collapseTree:

packageVersion("phytools")

## [1] '0.4.51'

tree<-pbtree(n=150)
## don't run
# pruned<-collapseTree(tree)

Cool - no blinking!

A phytools user recently asked the following:

“I am trying to plot the results of a phylogenetic PCA generated with your package Phytools. I would especially like to plot the third and fourth components using the "choices” option of the biplot() function in R. My feeling is that this option is not implemented while using your phyl.pca function since I get the message "choices" is not a graphical parameter. Am I right? Is there a way I can plot other components than the default ones?“

In fact, this is correct. Here is the function code for biplot.phyl.pca (originally suggested to me by Joan Maspons):

library(phytools)
biplot.phyl.pca

## function (x, ...) 
## {
##     biplot(x$S, x$L, ...)
## }
## <environment: namespace:phytools>

tree<-pbtree(n=26,tip.label=LETTERS)
X<-fastBM(tree,nsim=4)
obj<-phyl.pca(tree,X)
obj

## Phylogenetic pca
## Starndard deviations:
##       PC1       PC2       PC3       PC4 
## 1.0959134 0.9057384 0.8286637 0.6021671 
## Loads:
##              PC1        PC2        PC3          PC4
## [1,]  0.45746491  0.3875983  0.2376398 -0.764212515
## [2,] -0.05002709  0.3353159 -0.9366821 -0.087676734
## [3,] -0.68744007 -0.6538311 -0.1233330 -0.291066912
## [4,] -0.81927353  0.5421294  0.1867339  0.004131128

biplot(obj)

biplot(obj,choices=c(3,4)) ## doesn't work

## Warning in plot.window(...): "choices" is not a graphical parameter

## Warning in plot.xy(xy, type, ...): "choices" is not a graphical parameter

## Warning in axis(side = side, at = at, labels = labels, ...): "choices" is
## not a graphical parameter

## Warning in axis(side = side, at = at, labels = labels, ...): "choices" is
## not a graphical parameter

## Warning in box(...): "choices" is not a graphical parameter

## Warning in title(...): "choices" is not a graphical parameter

## Warning in text.default(x, xlabs, cex = cex[1L], col = col[1L], ...):
## "choices" is not a graphical parameter

## Warning in plot.window(...): "choices" is not a graphical parameter

## Warning in plot.xy(xy, type, ...): "choices" is not a graphical parameter

## Warning in title(...): "choices" is not a graphical parameter

## Warning in axis(3, col = col[2L], ...): "choices" is not a graphical
## parameter

## Warning in axis(4, col = col[2L], ...): "choices" is not a graphical
## parameter

## Warning in text.default(y, labels = ylabs, cex = cex[2L], col = col[2L], :
## "choices" is not a graphical parameter

It is non-trivial, but fairly straightforward, to modify this to permit use of the argument choices to select PC axes to be plotted. For this I made use of the do.call function:

biplot.phyl.pca<-function(x,...){
    to.do<-list(...)
    if(hasArg(choices)){ 
        choices<-list(...)$choices
        to.do$choices<-NULL
    } else choices<-c(1,2)
    to.do$x<-x$S[,choices]
    to.do$y<-x$L[,choices]
    do.call(biplot,to.do)
}

Let's try it:

biplot(obj) ## standard biplot

biplot(obj,choices=c(3,4))

That's it. Assuming I don't find (and no one points out) an error in this, I will add this to the next version of phytools.

An R-sig-phylo query asked:

“I wondered if anyone had coded a method for converting a phylogenetic tree with polytomies and node labels into a taxonomy (in some form of data table).”

So far as I know, this has not been done - but nor is it very hard, at least in the highly hypothetical circumstances in which every taxonomic level (i.e., Order, Family, Genus, etc.) that is desired in our table is labeled using node labels and every path from the root to any tip has the same number of labels.

Here's a quick demo, using a balanced tree - although it could equally well be a polytomous tree, or a stochastic tree, so long as the aforementioned rule holds.

library(phytools)
## first here is our tree
tree<-stree(n=64,type="balanced")
tree$node.label<-rep("",tree$Nnode)
tree$node.label[1]<-"Order_1"
tree$node.label[66-Ntip(tree)]<-"Family_1"
tree$node.label[97-Ntip(tree)]<-"Family_2"
tree$node.label[68-Ntip(tree)]<-"Genus_1"
tree$node.label[75-Ntip(tree)]<-"Genus_2"
tree$node.label[83-Ntip(tree)]<-"Genus_3"
tree$node.label[90-Ntip(tree)]<-"Genus_4"
tree$node.label[99-Ntip(tree)]<-"Genus_5"
tree$node.label[106-Ntip(tree)]<-"Genus_6"
tree$node.label[114-Ntip(tree)]<-"Genus_7"
tree$node.label[121-Ntip(tree)]<-"Genus_8"
plotTree(tree,fsize=0.65,ftype="i",lwd=1,xlim=c(-0.06,1.1))
nodelabels(node=which(tree$node.label!="")+Ntip(tree),
    text=tree$node.label[which(tree$node.label!="")],cex=0.7)

Now here is the code to pull out the taxonomy:

getAncestors<-phytools:::getAncestors
foo<-function(tip,tree){
    node<-which(tree$tip.label==tip)
    a<-tree$node.label[getAncestors(tree,node,"all")-Ntip(tree)]
    a<-a[length(a):1]
    c(a[a!=""],tip)
}
T<-t(sapply(tree$tip.label,foo,tree=tree))
T

##     [,1]      [,2]       [,3]      [,4] 
## t1  "Order_1" "Family_1" "Genus_1" "t1" 
## t2  "Order_1" "Family_1" "Genus_1" "t2" 
## t3  "Order_1" "Family_1" "Genus_1" "t3" 
## t4  "Order_1" "Family_1" "Genus_1" "t4" 
## t5  "Order_1" "Family_1" "Genus_1" "t5" 
## t6  "Order_1" "Family_1" "Genus_1" "t6" 
## t7  "Order_1" "Family_1" "Genus_1" "t7" 
## t8  "Order_1" "Family_1" "Genus_1" "t8" 
## t9  "Order_1" "Family_1" "Genus_2" "t9" 
## t10 "Order_1" "Family_1" "Genus_2" "t10"
## t11 "Order_1" "Family_1" "Genus_2" "t11"
## t12 "Order_1" "Family_1" "Genus_2" "t12"
## t13 "Order_1" "Family_1" "Genus_2" "t13"
## t14 "Order_1" "Family_1" "Genus_2" "t14"
## t15 "Order_1" "Family_1" "Genus_2" "t15"
## t16 "Order_1" "Family_1" "Genus_2" "t16"
## t17 "Order_1" "Family_1" "Genus_3" "t17"
## t18 "Order_1" "Family_1" "Genus_3" "t18"
## t19 "Order_1" "Family_1" "Genus_3" "t19"
## t20 "Order_1" "Family_1" "Genus_3" "t20"
## t21 "Order_1" "Family_1" "Genus_3" "t21"
## t22 "Order_1" "Family_1" "Genus_3" "t22"
## t23 "Order_1" "Family_1" "Genus_3" "t23"
## t24 "Order_1" "Family_1" "Genus_3" "t24"
## t25 "Order_1" "Family_1" "Genus_4" "t25"
## t26 "Order_1" "Family_1" "Genus_4" "t26"
## t27 "Order_1" "Family_1" "Genus_4" "t27"
## t28 "Order_1" "Family_1" "Genus_4" "t28"
## t29 "Order_1" "Family_1" "Genus_4" "t29"
## t30 "Order_1" "Family_1" "Genus_4" "t30"
## t31 "Order_1" "Family_1" "Genus_4" "t31"
## t32 "Order_1" "Family_1" "Genus_4" "t32"
## t33 "Order_1" "Family_2" "Genus_5" "t33"
## t34 "Order_1" "Family_2" "Genus_5" "t34"
## t35 "Order_1" "Family_2" "Genus_5" "t35"
## t36 "Order_1" "Family_2" "Genus_5" "t36"
## t37 "Order_1" "Family_2" "Genus_5" "t37"
## t38 "Order_1" "Family_2" "Genus_5" "t38"
## t39 "Order_1" "Family_2" "Genus_5" "t39"
## t40 "Order_1" "Family_2" "Genus_5" "t40"
## t41 "Order_1" "Family_2" "Genus_6" "t41"
## t42 "Order_1" "Family_2" "Genus_6" "t42"
## t43 "Order_1" "Family_2" "Genus_6" "t43"
## t44 "Order_1" "Family_2" "Genus_6" "t44"
## t45 "Order_1" "Family_2" "Genus_6" "t45"
## t46 "Order_1" "Family_2" "Genus_6" "t46"
## t47 "Order_1" "Family_2" "Genus_6" "t47"
## t48 "Order_1" "Family_2" "Genus_6" "t48"
## t49 "Order_1" "Family_2" "Genus_7" "t49"
## t50 "Order_1" "Family_2" "Genus_7" "t50"
## t51 "Order_1" "Family_2" "Genus_7" "t51"
## t52 "Order_1" "Family_2" "Genus_7" "t52"
## t53 "Order_1" "Family_2" "Genus_7" "t53"
## t54 "Order_1" "Family_2" "Genus_7" "t54"
## t55 "Order_1" "Family_2" "Genus_7" "t55"
## t56 "Order_1" "Family_2" "Genus_7" "t56"
## t57 "Order_1" "Family_2" "Genus_8" "t57"
## t58 "Order_1" "Family_2" "Genus_8" "t58"
## t59 "Order_1" "Family_2" "Genus_8" "t59"
## t60 "Order_1" "Family_2" "Genus_8" "t60"
## t61 "Order_1" "Family_2" "Genus_8" "t61"
## t62 "Order_1" "Family_2" "Genus_8" "t62"
## t63 "Order_1" "Family_2" "Genus_8" "t63"
## t64 "Order_1" "Family_2" "Genus_8" "t64"

In this case, that's all there is to it. If the number of labels is different in different paths then we will end up with something much messier. For instance:

tree$node.label[122-Ntip(tree)]<-"Subgenus_1"
tree$node.label[125-Ntip(tree)]<-"Subgenus_2"
plotTree(tree,fsize=0.65,ftype="i",lwd=1,xlim=c(-0.06,1.1))
nodelabels(node=which(tree$node.label!="")+Ntip(tree),
    text=tree$node.label[which(tree$node.label!="")],cex=0.7)

T<-sapply(tree$tip.label,foo,tree=tree)
T

## $t1
## [1] "Order_1"  "Family_1" "Genus_1"  "t1"      
## 
## $t2
## [1] "Order_1"  "Family_1" "Genus_1"  "t2"      
## 
## $t3
## [1] "Order_1"  "Family_1" "Genus_1"  "t3"      
## 
## $t4
## [1] "Order_1"  "Family_1" "Genus_1"  "t4"      
## 
## $t5
## [1] "Order_1"  "Family_1" "Genus_1"  "t5"      
## 
## $t6
## [1] "Order_1"  "Family_1" "Genus_1"  "t6"      
## 
## $t7
## [1] "Order_1"  "Family_1" "Genus_1"  "t7"      
## 
## $t8
## [1] "Order_1"  "Family_1" "Genus_1"  "t8"      
## 
## $t9
## [1] "Order_1"  "Family_1" "Genus_2"  "t9"      
## 
## $t10
## [1] "Order_1"  "Family_1" "Genus_2"  "t10"     
## 
## $t11
## [1] "Order_1"  "Family_1" "Genus_2"  "t11"     
## 
## $t12
## [1] "Order_1"  "Family_1" "Genus_2"  "t12"     
## 
## $t13
## [1] "Order_1"  "Family_1" "Genus_2"  "t13"     
## 
## $t14
## [1] "Order_1"  "Family_1" "Genus_2"  "t14"     
## 
## $t15
## [1] "Order_1"  "Family_1" "Genus_2"  "t15"     
## 
## $t16
## [1] "Order_1"  "Family_1" "Genus_2"  "t16"     
## 
## $t17
## [1] "Order_1"  "Family_1" "Genus_3"  "t17"     
## 
## $t18
## [1] "Order_1"  "Family_1" "Genus_3"  "t18"     
## 
## $t19
## [1] "Order_1"  "Family_1" "Genus_3"  "t19"     
## 
## $t20
## [1] "Order_1"  "Family_1" "Genus_3"  "t20"     
## 
## $t21
## [1] "Order_1"  "Family_1" "Genus_3"  "t21"     
## 
## $t22
## [1] "Order_1"  "Family_1" "Genus_3"  "t22"     
## 
## $t23
## [1] "Order_1"  "Family_1" "Genus_3"  "t23"     
## 
## $t24
## [1] "Order_1"  "Family_1" "Genus_3"  "t24"     
## 
## $t25
## [1] "Order_1"  "Family_1" "Genus_4"  "t25"     
## 
## $t26
## [1] "Order_1"  "Family_1" "Genus_4"  "t26"     
## 
## $t27
## [1] "Order_1"  "Family_1" "Genus_4"  "t27"     
## 
## $t28
## [1] "Order_1"  "Family_1" "Genus_4"  "t28"     
## 
## $t29
## [1] "Order_1"  "Family_1" "Genus_4"  "t29"     
## 
## $t30
## [1] "Order_1"  "Family_1" "Genus_4"  "t30"     
## 
## $t31
## [1] "Order_1"  "Family_1" "Genus_4"  "t31"     
## 
## $t32
## [1] "Order_1"  "Family_1" "Genus_4"  "t32"     
## 
## $t33
## [1] "Order_1"  "Family_2" "Genus_5"  "t33"     
## 
## $t34
## [1] "Order_1"  "Family_2" "Genus_5"  "t34"     
## 
## $t35
## [1] "Order_1"  "Family_2" "Genus_5"  "t35"     
## 
## $t36
## [1] "Order_1"  "Family_2" "Genus_5"  "t36"     
## 
## $t37
## [1] "Order_1"  "Family_2" "Genus_5"  "t37"     
## 
## $t38
## [1] "Order_1"  "Family_2" "Genus_5"  "t38"     
## 
## $t39
## [1] "Order_1"  "Family_2" "Genus_5"  "t39"     
## 
## $t40
## [1] "Order_1"  "Family_2" "Genus_5"  "t40"     
## 
## $t41
## [1] "Order_1"  "Family_2" "Genus_6"  "t41"     
## 
## $t42
## [1] "Order_1"  "Family_2" "Genus_6"  "t42"     
## 
## $t43
## [1] "Order_1"  "Family_2" "Genus_6"  "t43"     
## 
## $t44
## [1] "Order_1"  "Family_2" "Genus_6"  "t44"     
## 
## $t45
## [1] "Order_1"  "Family_2" "Genus_6"  "t45"     
## 
## $t46
## [1] "Order_1"  "Family_2" "Genus_6"  "t46"     
## 
## $t47
## [1] "Order_1"  "Family_2" "Genus_6"  "t47"     
## 
## $t48
## [1] "Order_1"  "Family_2" "Genus_6"  "t48"     
## 
## $t49
## [1] "Order_1"  "Family_2" "Genus_7"  "t49"     
## 
## $t50
## [1] "Order_1"  "Family_2" "Genus_7"  "t50"     
## 
## $t51
## [1] "Order_1"  "Family_2" "Genus_7"  "t51"     
## 
## $t52
## [1] "Order_1"  "Family_2" "Genus_7"  "t52"     
## 
## $t53
## [1] "Order_1"  "Family_2" "Genus_7"  "t53"     
## 
## $t54
## [1] "Order_1"  "Family_2" "Genus_7"  "t54"     
## 
## $t55
## [1] "Order_1"  "Family_2" "Genus_7"  "t55"     
## 
## $t56
## [1] "Order_1"  "Family_2" "Genus_7"  "t56"     
## 
## $t57
## [1] "Order_1"    "Family_2"   "Genus_8"    "Subgenus_1" "t57"       
## 
## $t58
## [1] "Order_1"    "Family_2"   "Genus_8"    "Subgenus_1" "t58"       
## 
## $t59
## [1] "Order_1"    "Family_2"   "Genus_8"    "Subgenus_1" "t59"       
## 
## $t60
## [1] "Order_1"    "Family_2"   "Genus_8"    "Subgenus_1" "t60"       
## 
## $t61
## [1] "Order_1"    "Family_2"   "Genus_8"    "Subgenus_2" "t61"       
## 
## $t62
## [1] "Order_1"    "Family_2"   "Genus_8"    "Subgenus_2" "t62"       
## 
## $t63
## [1] "Order_1"    "Family_2"   "Genus_8"    "Subgenus_2" "t63"       
## 
## $t64
## [1] "Order_1"    "Family_2"   "Genus_8"    "Subgenus_2" "t64"

Perhaps we could still post-process this - but it would obviously be more difficult. Note that there is no difficult if genera are at different temporal depths in the tree - so longer as there is the same number of named levels between the root & any tip.

That's all.

We are pleased to announce a new graduate-level intensive short course on the use of R for phylogenetic comparative analysis. The course will be four days in length and will take place at the Hotel Ilha Flata in Ilhabela, Sao Paulo State, Brazil, from the 2nd to the 5th of July, 2015. This course is funded by the National Science Foundation. The course is free of cost; and accommodation at the course venue, as well as breakfast & lunch on all course days, is included for all accepted students. There will be a small number of travel stipends available for qualified students and post-docs. Applicants are welcome from any country, but are especially encouraged from the Latin American region.

Topics covered will include: an introduction to the R environment and programming language, tree manipulation, independent contrasts and phylogenetic generalized least squares, ancestral state reconstruction, models of character evolution, diversification analysis, and community phylogenetic analysis. Course instructors will include Dr. Liam Revell (University of Massachusetts Boston), Dr. Luke Harmon (University of Idaho), and Dr. Mike Alfaro (University of California, Los Angeles). Instruction in the course will be primarily in English, thus all students must have a basic working knowledge of scientific English.

To apply for the course, please submit your CV along with a short (maximum 1 page) description of your research interests, background, and reasons for taking the course. Admission is competitive, and preference will go towards students with background in phylogenetics and a compelling motivation for taking the course. Applications should be submitted by email to ilhabela.phylogenetics.course@gmail.com by May 1st, 2015. Questions can be directed to liam.revell@umb.edu (or posted in the comments section, below).

An R-sig-phylo user asked the following:

“Is there an easy way to get R to automatically rotate the nodes of a phylogeny to match an arbitrary ordering of the tips?…. Say I have a particular taxonomic order, such as: SpeciesA, SpeciesC, SpeciesB…. And I want to rotate the nodes of ((C,B),A) to match it - ie to automatically rotate the nodes to give (A(C,B))”

Well, there are some functions in ape that do something related to this (or perhaps this precisely) - I'm thinking rotateConstr and perhaps cophyloplot, but phytools also has a function, minRotate, used primarily internally in phylo.to.map, which attempts to do this. It does it via a simple, greedy algorithm of performing a pre-order traversal of the tree, rotating each node, and accepting the rotation if it improves the objective function which is the match between the desired order and the realized order.

Remarkably, this seems to be surprisingly effective at finding the original order if a set of random rotations are applied to the nodes of a tree.

So, for example:

library(phytools)
tree<-pbtree(n=26,tip.label=LETTERS)
plotTree(tree)

## random set of 100 rotations
nn<-sample(1:tree$Nnode+Ntip(tree),100,replace=TRUE)
for(i in 1:length(nn)) tree<-read.tree(text=write.tree(rotate(tree,nn[i])))
## tree all scrambled up
plotTree(tree)

## original order
x<-setNames(1:Ntip(tree),LETTERS)
unscrambled<-minRotate(tree,x)

## objective: 48
## objective: 48
## objective: 48
## objective: 44
## objective: 40
## objective: 40
## objective: 40
## objective: 36
## objective: 36
## objective: 34
## objective: 22
## objective: 20
## objective: 18
## objective: 14
## objective: 10
## objective: 10
## objective: 10
## objective: 10
## objective: 8
## objective: 6
## objective: 6
## objective: 2
## objective: 2
## objective: 0
## objective: 0

plotTree(unscrambled)

This even seems to work for larger trees:

tree<-pbtree(n=200)
x<-setNames(1:200,tree$tip.label)
## random rotations
nn<-sample(1:tree$Nnode+Ntip(tree),100,replace=TRUE)
for(i in 1:length(nn)) tree<-read.tree(text=write.tree(rotate(tree,nn[i])))
## the objective function going to zero indicated fully
## unscrambled
unscrambled<-minRotate(tree,x)

## objective: 6842
## objective: 6842
## objective: 6034
## objective: 6034
## objective: 6032
## objective: 6032
## objective: 6006
## objective: 5948
## objective: 5948
## objective: 5948
## objective: 5948
## objective: 5948
## objective: 5948
## objective: 5948
## objective: 5948
## objective: 5946
## objective: 5942
## objective: 5942
## objective: 5942
## objective: 5942
## objective: 5872
## objective: 5872
## objective: 5872
## objective: 5872
## objective: 5864
## objective: 5864
## objective: 5864
## objective: 5864
## objective: 5864
## objective: 5864
## objective: 5864
## objective: 5864
## objective: 5860
## objective: 5860
## objective: 5848
## objective: 5848
## objective: 5846
## objective: 5840
## objective: 5840
## objective: 5840
## objective: 5838
## objective: 5836
## objective: 5836
## objective: 5836
## objective: 5836
## objective: 5836
## objective: 5836
## objective: 5836
## objective: 5834
## objective: 5822
## objective: 5820
## objective: 5820
## objective: 5820
## objective: 5818
## objective: 4994
## objective: 4994
## objective: 4994
## objective: 4856
## objective: 4856
## objective: 4854
## objective: 4854
## objective: 4844
## objective: 4844
## objective: 4842
## objective: 4842
## objective: 4842
## objective: 4842
## objective: 4840
## objective: 4836
## objective: 4836
## objective: 4834
## objective: 4834
## objective: 4834
## objective: 4834
## objective: 4834
## objective: 4832
## objective: 4828
## objective: 4828
## objective: 4828
## objective: 4828
## objective: 4826
## objective: 4824
## objective: 4824
## objective: 4824
## objective: 4824
## objective: 4824
## objective: 4824
## objective: 4824
## objective: 4824
## objective: 4820
## objective: 4820
## objective: 4820
## objective: 4820
## objective: 4818
## objective: 4810
## objective: 4810
## objective: 4810
## objective: 4810
## objective: 2498
## objective: 2498
## objective: 2498
## objective: 2498
## objective: 2498
## objective: 2492
## objective: 2492
## objective: 2490
## objective: 2488
## objective: 2486
## objective: 2324
## objective: 2324
## objective: 2324
## objective: 2324
## objective: 2324
## objective: 2320
## objective: 2320
## objective: 2320
## objective: 2320
## objective: 2320
## objective: 2316
## objective: 2316
## objective: 2314
## objective: 2314
## objective: 2314
## objective: 2308
## objective: 2308
## objective: 2306
## objective: 2304
## objective: 2300
## objective: 2300
## objective: 2294
## objective: 2294
## objective: 2294
## objective: 172
## objective: 172
## objective: 172
## objective: 172
## objective: 172
## objective: 172
## objective: 172
## objective: 172
## objective: 172
## objective: 172
## objective: 172
## objective: 172
## objective: 172
## objective: 170
## objective: 170
## objective: 170
## objective: 170
## objective: 170
## objective: 170
## objective: 170
## objective: 170
## objective: 170
## objective: 170
## objective: 168
## objective: 168
## objective: 168
## objective: 164
## objective: 164
## objective: 160
## objective: 160
## objective: 158
## objective: 158
## objective: 158
## objective: 28
## objective: 28
## objective: 28
## objective: 28
## objective: 26
## objective: 24
## objective: 24
## objective: 24
## objective: 24
## objective: 24
## objective: 24
## objective: 24
## objective: 24
## objective: 22
## objective: 20
## objective: 18
## objective: 10
## objective: 10
## objective: 10
## objective: 10
## objective: 10
## objective: 10
## objective: 10
## objective: 10
## objective: 10
## objective: 10
## objective: 10
## objective: 10
## objective: 6
## objective: 6
## objective: 0
## objective: 0
## objective: 0
## objective: 0

I have no idea whether this will work in general - nor if this strategy will minimize the objective function if a perfect match does not exist. Nonetheless….

That's all!

A phytools user, David Labonte from the University of Cambridge, recently reported the following bug with the phytools function fastAnc:

“I am using your fastAnc function to estimate ancestral states of a continuous variable, and it runs smoothly, however only if CI=FALSE. I also noted that it returns a longer variance than ancestral state estimation vector. Notably, this problem only arises for non-dichotomous trees.”

David also was kind enough to provide the following example which reproduces the error very nicely (modified slightly):

library(phytools)
set.seed(1)
tree<-pbtree(n=10,scale=1)
plotTree(tree,node.numbers=TRUE)

x<-fastBM(tree)
fastAnc(tree,x,vars=TRUE,CI=TRUE) ## runs smoothly without error

## $ace
##          11          12          13          14          15          16 
## -0.35538758 -0.39739912 -0.32825378 -0.51263348 -0.32987276 -0.13938453 
##          17          18          19 
## -0.14780235 -0.07371257 -0.09712277 
## 
## $var
##          11          12          13          14          15          16 
## 0.081863455 0.063948796 0.045742058 0.019817948 0.006889495 0.027865560 
##          17          18          19 
## 0.003468311 0.022557094 0.009799787 
## 
## $CI95
##          [,1]        [,2]
## 11 -0.9161787  0.20540351
## 12 -0.8930459  0.09824762
## 13 -0.7474467  0.09093912
## 14 -0.7885549 -0.23671206
## 15 -0.4925586 -0.16718692
## 16 -0.4665670  0.18779789
## 17 -0.2632314 -0.03237331
## 18 -0.3680854  0.22066021
## 19 -0.2911508  0.09690522

tree<-collapse.to.star(tree,fastMRCA(tree,"t6","t9"))
plotTree(tree,node.numbers=TRUE)

fastAnc(tree,x) ## works no problem

##         11         12         13         14         15         16 
## -0.3498724 -0.3911156 -0.3188186 -0.5111098 -0.3295891 -0.1216447

fastAnc(tree,x,vars=TRUE) ## works, but vars is wrong length

## $ace
##         11         12         13         14         15         16 
## -0.3498724 -0.3911156 -0.3188186 -0.5111098 -0.3295891 -0.1216447 
## 
## $var
##          11          12          13          14          15          16 
## 0.077702044 0.060153127 0.040920299 0.018985301 0.006625218 0.015899879

fastAnc(tree,x,vars=TRUE,CI=TRUE) ## doesn't work at all

## $ace
##         11         12         13         14         15         16 
## -0.3498724 -0.3911156 -0.3188186 -0.5111098 -0.3295891 -0.1216447 
## 
## $var
##          11          12          13          14          15          16 
## 0.077702044 0.060153127 0.040920299 0.018985301 0.006625218 0.015899879 
## 
## $CI95
##          [,1]        [,2]
## 11 -0.8962241  0.19647933
## 12 -0.8718278  0.08959662
## 13 -0.7153024  0.07766520
## 14 -0.7811727 -0.24104701
## 15 -0.4891242 -0.17005403
## 16 -0.3687903  0.12550100

Even better, David solved the bug by correctly identifying the error in the code. In his own words, he says:

“I looked through the code of the function, and while I am certainly not a R coding expert, I believe the problem lies in line 28:

27    if (vars || CI) {
28        v[as.character(ancNames[, 2])]
29        names(v) <- ancNames[, 1]
30    }

analogous to the previous lines, I think this should read

27    if (vars || CI) {
28        v <- v[as.character(ancNames[, 2])]
29        names(v) <- ancNames[, 1]
30    }

This is exactly correct, and if we fix this then we find that the function now works perfectly:

source("fastAnc.R")
fastAnc(tree,x,vars=TRUE,CI=TRUE)

## $ace
##         11         12         13         14         15         16 
## -0.3498724 -0.3911156 -0.3188186 -0.5111098 -0.3295891 -0.1216447 
## 
## $var
##          11          12          13          14          15          16 
## 0.077702044 0.060153127 0.040920299 0.018985301 0.006625218 0.015899879 
## 
## $CI95
##          [,1]        [,2]
## 11 -0.8962241  0.19647933
## 12 -0.8718278  0.08959662
## 13 -0.7153024  0.07766520
## 14 -0.7811727 -0.24104701
## 15 -0.4891242 -0.17005403
## 16 -0.3687903  0.12550100

Cool! If only fixing all the bugs in phytools was this easy!

There has been a little bit of discussion today on R-sig-phylo listserve about transforming branch lengths.

One thing that wasn't mentioned was the possibility of sampling branch lengths under a model. I thought it would be straightforward to sample branch lengths under a Yule model (that is, a pure-birth speciation model).

The following is code that does this. (Set plot=TRUE to see a cool animation of the tree being 'grown' from left to right.)

pb_edgelength<-function(tree,b=1,plot=TRUE,...){
    ll<-rexp(n=Ntip(tree)-1,rate=2:Ntip(tree)*b)
    tree$edge.length<-rep(0,nrow(tree$edge))
    live.nodes<-Descendants(tree,Ntip(tree)+1,"children")
    tips<-vector()
    for(i in 1:length(ll)){
        tips<-c(tips,live.nodes[live.nodes<=Ntip(tree)])
        live.nodes<-setdiff(live.nodes,tips)
        ii<-which(tree$edge[,2]%in%c(live.nodes,tips))
        tree$edge.length[ii]<-tree$edge.length[ii]+ll[i]
        node<-if(length(live.nodes)<=1) live.nodes else 
            sample(live.nodes,1) ## choose one node
        live.nodes<-c(setdiff(live.nodes,node),
            Descendants(tree,node,"children"))
        if(plot) plotTree(tree,...)
    }
    tree
}

OK, now let's try it out with a tree obtained using rtree from the ape package:

library(phytools)
library(phangorn)
tree<-rtree(n=100,br=NULL) ## no branch lengths
t.pb<-pb_edgelength(tree,plot=FALSE)
plotTree(t.pb,ftype="off")

par(mar=c(5.1,4.1,2.1,2.1))
obj<-ltt(t.pb)

obj$gamma

## [1] -0.1807099

Compare this to Grafen's edge lengths from compute.brlen:

t.grafen<-compute.brlen(tree)
plotTree(t.grafen,ftype="off")

par(mar=c(5.1,4.1,2.1,2.1))
obj<-ltt(t.grafen)

obj$gamma

## [1] 6.732706

Obviously, the branching times from Grafen's branch length transformation are very different from those obtained under a Yule process!

That's it, really.

In a recent R-sig-phylo discussion a user askedif it would be reasonable to use branches sampled assuming a Yule process in phylogenetic regression under conditions in which the branch lengths of the tree are unknown. Although I supplied a functiondesigned to sample branching times on an arbitrary topology given this process, I could not answer the question of whether it was a good idea (or not) to use Yule process edge lengths when the topology was known, but branch lengths are not, even if it is reasonable to assume that the tree arose under a pure-birth process.

Here, I attempt to briefly explore that question.

First, my function to sample edges lengths under a Yule process (from last time):

yuleEdges<-function(tree,b=1,plot=TRUE,...){
    ll<-rexp(n=Ntip(tree)-1,rate=2:Ntip(tree)*b)
    tree$edge.length<-rep(0,nrow(tree$edge))
    live.nodes<-Descendants(tree,Ntip(tree)+1,"children")
    tips<-vector()
    for(i in 1:length(ll)){
        tips<-c(tips,live.nodes[live.nodes<=Ntip(tree)])
        live.nodes<-setdiff(live.nodes,tips)
        ii<-which(tree$edge[,2]%in%c(live.nodes,tips))
        tree$edge.length[ii]<-tree$edge.length[ii]+ll[i]
        node<-if(length(live.nodes)<=1) live.nodes else 
            sample(live.nodes,1) ## choose one node
        live.nodes<-c(setdiff(live.nodes,node),
            Descendants(tree,node,"children"))
        if(plot) plotTree(tree,...)
    }
    tree
}

Now, let's simulate some data. First, let's try uncorrelated data. We can thus explore bias & variance in the estimate of the contrasts/PGLS regression slope (it should be zero), as well as type I error.

## load libraries
library(phytools)
library(phangorn)
library(ape)
## simulate 200 pure-birth trees:
trees<-ttrees<-pbtree(n=50,scale=1,nsim=200)
## ttrees contains the trees with their original branch lengths
## we'll perform manipulations on trees
foo<-function(tree){
    obj<-fastBM(tree,nsim=2)
    colnames(obj)<-c("x","y")
    as.data.frame(obj)
}
xy<-lapply(ttrees,foo)

Next, as a control for our experiment, let's fit contrasts regressions (PGLS,here) to each of these, using the known, true branch lengths. We'll just pull out the slope, β₁ and the P-value for each regression:

library(nlme)
fit.model<-function(tree,data){
    data$v<-diag(vcv.phylo(tree))
    fit<-gls(y~x,data=data,correlation=corBrownian(1,tree),
        weights=varFixed(~v))
    setNames(c(coefficients(fit)[2],anova(fit)$"p-value"[2]),
        c("beta","p-value"))
}
fit.true<-t(mapply(fit.model,trees,xy))
mean(fit.true[,1]) ## should be zero

## [1] -0.005196606

## should be uniform on [0,1]
hist(fit.true[,2],freq=FALSE,xlab="P-value",
    main="P-values, known branch lengths") 

mean(fit.true[,2]<=0.05) ## should be about 0.05

## [1] 0.035

OK, now imagine we are in a situation without branch lengths. We're going to consider a few different possibilities:

(1) All branch lengths set equal to 1.0.

(2) Grafen's (1989) branch lengths.

(3) Branch lengths randomly sampled under a Yule process.

First (1), setting all branch lengths to zero:

foo<-function(tree){
    tree$edge.length<-rep(1,nrow(tree$edge))
    tree
}
trees<-lapply(ttrees,foo)
class(trees)<-"multiPhylo"
fit.equal<-t(mapply(fit.model,trees,xy))
mean(fit.equal[,1]) ## should be zero

## [1] -0.006076158

## should be uniform on [0,1]
hist(fit.equal[,2],freq=FALSE,xlab="P-value",
    main="P-values, all branch lengths 1.0")

mean(fit.equal[,2]<=0.05) ## should be 0.05

## [1] 0.125

Now (2), using Grafen's (1989) branch lengths:

trees<-lapply(ttrees,compute.brlen)
class(trees)<-"multiPhylo"
fit.grafen<-t(mapply(fit.model,trees,xy))
mean(fit.grafen[,1]) ## should be zero

## [1] -0.007811392

## should be uniform on [0,1]
par(mar=c(5.1,4.1,4.1,2.1))
hist(fit.grafen[,2],freq=FALSE,xlab="P-value",
    main="P-values, Grafen edge lengths") 

mean(fit.grafen[,2]<=0.05) ## should be 0.05

## [1] 0.125

Finally, (3), branch lengths sampled under a Yule process. Now for this, rather than using one set of branch lengths, for each tree we should simulate a set of branch lengths and then average our inference over this set. This is logical, because any individual set of branch lengths will be wrong, but perhaps by computing the variance among our estimated parameter and adding it to the mean variance of each estimate (under the law of total variance) should give us the correct variance of our estimator. Let's do this:

## this function simulates 100 sets of edge lengths, fits the model
## to each of them using PGLS, and extracts the coefficient & variance
## then averages the variance across trees, adds this to the variance
## among trees, and computes a p-value for the parameter from the 
## t-distribution
yuleApply<-function(tree,data,nrep=100){
    trees<-replicate(nrep,yuleEdges(tree,plot=FALSE),simplify=FALSE)
    class(trees)<-"multiPhylo"
    gls.fit<-function(tree,data){
        obj<-gls(y~x,data=data,correlation=corBrownian(1,tree))
        setNames(c(coefficients(obj)[2],obj$varBeta[2,2]),
            c("beta","varBeta"))
    }
    fit<-t(sapply(trees,gls.fit,data=data))
    b<-mean(fit[,"beta"])
    v<-var(fit[,"beta"])+mean(fit[,"varBeta"])
    p<-2*pt(abs(b/sqrt(v)),df=Ntip(tree)-1,lower.tail=FALSE)
    setNames(c(b,v,p),c("beta","varBeta","p-value"))
}
fit.yule<-t(mapply(yuleApply,ttrees,xy))
mean(fit.yule[,1]) ## should be zero

## [1] -0.03133003

## should be uniform on [0,1]
hist(fit.yule[,3],freq=FALSE,xlab="P-value",
    main="P-values, Yule branch lengths")

mean(fit.yule[,3]<=0.05) ## should be 0.05

## [1] 0

So, unless I messed something up here, it looks as though simulating edge lengths under a Yule process, though unbiased, is excessively conservative.

Next, let's try the situation in which x and y are genuinely correlated. Again, we start with the data generation, say with β₁ = 0.4:

foo<-function(tree,beta,vare){
    x<-fastBM(tree)
    e<-fastBM(tree,sig2=vare)
    y<-beta*x+e
    data.frame(x,y)
}
xy<-lapply(ttrees,foo,beta=0.4,vare=1.2)

First, with the true edge lengths:

fit.true<-t(mapply(fit.model,trees,xy))
mean(fit.true[,1]) ## should be 0.4

## [1] 0.3856536

## this is power now, rather than type I error
mean(fit.true[,2]<=0.05)

## [1] 0.615

Now all edge lengths to 1.0:

foo<-function(tree){
    tree$edge.length<-rep(1,nrow(tree$edge))
    tree
}
trees<-lapply(ttrees,foo)
class(trees)<-"multiPhylo"
fit.equal<-t(mapply(fit.model,trees,xy))
mean(fit.equal[,1]) ## should be 0.4

## [1] 0.3946721

mean(fit.equal[,2]<=0.05) ## power

## [1] 0.605

Now Grafen's edge lengths with compute.brlen:

trees<-lapply(ttrees,compute.brlen)
class(trees)<-"multiPhylo"
fit.grafen<-t(mapply(fit.model,trees,xy))
mean(fit.grafen[,1]) ## should be 0.4

## [1] 0.3856536

mean(fit.grafen[,2]<=0.05) ## power

## [1] 0.615

Now, branching times sampled under a Yule process, as before:

fit.yule<-t(mapply(yuleApply,ttrees,xy))
mean(fit.yule[,1]) ## should be 0.4

## [1] 0.3870531

mean(fit.yule[,3]<=0.05) ## power

## [1] 0.145

So, there you have it. Although it would seem to be the case that sampling branching times under which the known true branches arose, a Yule process, would be a good strategy when the branch lengths are unknown - this has the effect of leading to a type I error rate considerably below the nominal rate, as well as to low power relative to other kinds of arbitrary branch lengths. Who knew!

I just posted a new version of the phytools functin collapseTree. This function is an interactive function for collapsing (& expanding) subtrees on a phylogeny.

This version fixes two bugs in earlier versions. Firstly, prior versions crashed if the user clicked on the root node (which is an attempt to collapse the tree into a single node). This is still not permitted, but the result is that nothing happens and a message is printed. Secondly, prior versions also crashed under certain conditions when the tree was collapsed into two tips. This is actually due to a bug in how the environmental variable "last_plot.phylo" was created. This bug is now fixed in both collapseTree and plotSimmap / plotTree.

Since this function creates an animation there is no point in try to illustrate it here, but the following shows a video of it in use, with these bugs fixed. It also may seem smoother because it is being plotted user a faster machine than before.

This is also in a new non-CRAN version of phytools, and I am hoping to submit an update of phytools to CRAN soon.

Today I was asked the following question (slightly paraphrased):

“How do I indentify the node defining the youngest subtree with N (for arbitrary N, in his case it was 5) descendant taxa?”

This is pretty easy. For demonstrative purposes, let's first simulate a tree:

library(phytools)
## simulate tree
tree<-pbtree(n=26,tip.label=LETTERS)

Now let's count the number of tips descended from each internal node of the tree:

## number of descendant taxa by node
N<-setNames(sapply(1:tree$Nnode+Ntip(tree),
    function(x,tree) sum(getDescendants(tree,x)<=Ntip(tree)),tree=tree),
    1:tree$Nnode+Ntip(tree))
## we can plot them to make sure we got it right
plotTree(tree,mar=c(2.1,0.1,0.1,0.1))
nodelabels(N)

Next, we can compute the depth of each node. We can do this in more than one way. Here, I have an sapply call around nodeheight, but for a larger tree I would use one call to nodeHeights.

## node depths
d<-setNames(max(nodeHeights(tree))-
    sapply(1:tree$Nnode+Ntip(tree),nodeheight,tree=tree),
    1:tree$Nnode+Ntip(tree))
## again, let's check them by plotting
plotTree(tree,mar=c(2.1,0.1,0.1,0.1))
nodelabels(round(d,2))
axis(1,at=round(0:5/5*max(nodeHeights(tree)),2))

Finally, let's find the most recent node (or nodes) with n=5or more descendant tips:

## which node is the youngest node to have n=5 or more 
## descendant taxa
n<-5
node<-as.numeric(names(which(d[N>=n]==min(d[N>=n]))))

Let's check it visually:

plotTree(tree,mar=c(2.1,0.1,0.1,0.1))
axis(1,at=round(0:5/5*max(nodeHeights(tree)),2))
ii<-which(names(d)==node)
lines(max(nodeHeights(tree))-c(d[ii],d[ii]),
    y=par()$usr[3:4],lty="dashed",col="red")
nodelabels(node=node,"X")

That's it!

I just posted a new version of phytools. The main updates of this version is that a number of phytools functions (plotSimmap, plotTree, fancyTree, contMap, densityMap, and phenogram) now have the option of hold the output to the graphical device using dev.hold before plotting. Depending on your operating system, this may have the effect of delaying the plot from starting to appear - but then all the elements should appear all at once. This is really only important for computationally intensive methods and for very large trees. (It can also be turned off if the user wants to see the plot appear gradually. It takes just as long anyway, so sometimes it is nice to have something to look at!)

Obviously, it is not possible in the blog to illustrate the effect of turning this option on - all you get to see is the final plotted object anyway - but I thought this would be a nice moment to remind me readers (all 2 or 3 of you) what some of the above functions can do.

1. plotSimmap

Obviously, plotSimmap plots stochastic character mapped trees, or other trees that have been stored in the type of object created by read.simmap& make.simmap (among the other functions that work with this type of object). Here is a demo of what this kind of plot looks like:

library(phytools)
data(anoletree)
plotSimmap(anoletree,type="fan",fsize=0.7,ftype="i")

## no colors provided. using the following legend:
##        CG        GB        TC        TG        Tr        Tw 
##   "black"     "red"  "green3"    "blue"    "cyan" "magenta"

## setEnv=TRUE for this type is experimental. please be patient with bugs

ss<-sort(unique(getStates(anoletree)))
add.simmap.legend(colors=setNames(palette()[1:length(ss)],ss),prompt=FALSE,
    x=-9.3,y=-6)

2. plotTree

This is just a wrapper for plotSimmap that plots a tree without a mapped character, but includes all the user options as in plotSimmap.

3. phenogram

This function plots a projection of the tree into a space defined by time since the root on the horizontal axis and phenotype for a continuously valued trait on the vertical. It can work with user-supplied or reconstructed trait values at internal nodes. Here is what that looks like:

## simulate tree & data
tree<-pbtree(n=26,tip.label=LETTERS)
x<-fastBM(tree)
phenogram(tree,x,fsize=0.8)

In this version I have also updated the default settings to spread.labels=FALSE - because these plots are much more aesthetically pleasing (and readable) than the alternative:

phenogram(tree,x,fsize=0.8,spread.labels=FALSE)

4. fancyTree

fancyTree does a range of idiosyncratic visualizations, but the methods that I have updated are "phenogram95" and "scattergram".

"phenogram95" uses transparency to plot a 95% (by default) high probability density traitgram. For example:

fancyTree(tree,"phenogram95",x=x)

## Computing density traitgram...

This in particular is a method were the plot used to appear very gradually on the graphical device!

"scattergram" does a phylogenetic scatterplot matrix with continuous character maps on the tree (see below for more info) on the diagonal, and phylmorphospaces (two-dimensional projections of the tree into morphospace) in off-diagonal matrix positions. Here is a demo once again:

## simulate uncorrelated character data
X<-fastBM(tree,nsim=4)
## name columns, just for fun
colnames(X)<-c("size","forelimb","hindlimb","mass")
fancyTree(tree,type="scattergram",X=X)

## Computing multidimensional phylogenetic scatterplot matrix...

5. densityMap and contMap

Well, we've already seen contMap in use. This is just a visualization method in which a continuous character trait value is projected directly onto the edges of the tree. So, for example:

tree<-pbtree(n=100)
x<-fastBM(tree)
obj<-contMap(tree,x,fsize=c(0.5,1))

contMap returns an object of class "contMap" which can easily be replotted with different settings, e.g.:

plot(obj,type="fan")

A related method is the stochastic character map density method of densityMap. I won't get into the details here, but this is just an approach to visualize the posterior probability density along edges and nodes from a statistical ancestral state reconstruction method called stochastic character mapping. Here, once again, is an example using simulated data:

tree<-pbtree(n=26,tip.label=LETTERS[26:1],scale=1)
Q<-matrix(c(-1.25,1.25,1.25,-1.25),2,2)
rownames(Q)<-colnames(Q)<-letters[1:2]
tree<-sim.history(tree,Q)

## Done simulation(s).

cols<-setNames(c("blue","red"),letters[1:2])
plotSimmap(tree,colors=cols,lwd=3) ## simulated true history
add.simmap.legend(colors=cols,x=0,y=3,prompt=FALSE)

x<-tree$states ## states
x

##   Z   Y   X   W   V   U   T   S   R   Q   P   O   N   M   L   K   J   I 
## "a" "a" "a" "a" "a" "a" "a" "a" "a" "a" "a" "a" "a" "a" "a" "b" "b" "b" 
##   H   G   F   E   D   C   B   A 
## "b" "b" "a" "b" "a" "a" "a" "a"

mtrees<-make.simmap(tree,x,nsim=100)

## make.simmap is sampling character histories conditioned on the transition matrix
## Q =

##            a          b
## a -0.5107549  0.5107549
## b  0.5107549 -0.5107549

## (estimated using likelihood);
## and (mean) root node prior probabilities
## pi =

##   a   b 
## 0.5 0.5

## Done.

obj<-densityMap(mtrees)

## sorry - this might take a while; please be patient

plot(obj,lwd=5,outline=TRUE,direction="leftwards")

OK, that's it. I'm hoping to get a CRAN update out soon, but for now this latest version of phytools can be downloaded from phytools.org or, more specifically, here.

I have just submitted a new version of phytools (0.4-56) to CRAN. Fingers crossed that it survives scrutiny & is accepted; however in the meantime it can be downloaded from the phytools page.

In a different post I will detail the updates (which are many) from both the previous CRAN version and from other recent non-CRAN phytools releases; however one feature that has been added is a modification to the phytools function plotTree.wBars to permit tip labels to be plotted. This function adds bars for a continuous trait to the tips of the tree. Here is a quick demo with the default conditions:

library(phytools)
packageVersion("phytools")

## [1] '0.4.56'

## make realistic looking tip labels
tip.label<-replicate(60,paste(sample(LETTERS,1),"._",
    paste(sample(letters,round(runif(n=1,min=4,max=8))),
    collapse=""),sep=""))
## simulate tree
tree<-pbtree(n=60,tip.label=tip.label,scale=1)
## simulate positive trait data - negative values are 
## permitted, and I will show that below
x<-abs(fastBM(tree))
## finally, plot without tree labels
plotTree.wBars(tree,x,scale=0.2)

Although I received lots of positive feedback about this function, users wanted to be able to include tip labels (very reasonably, I must admit). The only added complication with this is that we now have to compute not only how much space we need for the phylogeny & the trait data to be plotted, but also how much space is required to plot the tip labels. This is more complicated that it sounds, even, because the amount of space required for the tip labels cannot be found without first creating the plotting device.

The code for the updated version of plotTree.wBars is here.

Here is how it looks, for the same data & tree:

plotTree.wBars(tree,x,scale=0.2,tip.labels=TRUE,fsize=0.6)

For larger trees especially, we may want to plot our tree in a fan style. This also works with tip labels, for instance as follows:

tip.label<-replicate(200,paste(sample(LETTERS,1),"._",
    paste(sample(letters,round(runif(n=1,min=4,max=8))),
    collapse=""),sep=""))
tree<-pbtree(n=200,tip.label=tip.label,scale=1)
x<-abs(fastBM(tree))
plotTree.wBars(tree,x,fsize=0.4,scale=0.1,tip.labels=TRUE,type="fan",lwd=1)

I'm sure I've demonstrated this before, but it is fairly straightforward to combine plotTree.wBars with other phytools plotting methods, such as contMap - continuous character mapping onto the tree. So for example:

## create an object of class "contMap"
obj<-contMap(tree,x,plot=FALSE)
plotTree.wBars(obj$tree,x,fsize=0.4,scale=0.1,tip.labels=TRUE,
    type="fan",method="plotSimmap",colors=obj$cols)
add.color.bar(0.8,cols=obj$cols,title="trait value",obj$lims,digits=2,
    prompt=FALSE,x=0.9*par()$usr[1],y=0.9*par()$usr[4])

You might notice lots of 'aliasing' in this plot. Obviously, we wouldn't want this for publication. We can easily avoid it by exporting to PDF or other lossless formats from within R. In this case, we could simply do:

pdf(file="28Apr15-post.pdf")
plotTree.wBars(obj$tree,x,fsize=0.4,scale=0.1,tip.labels=TRUE,
    type="fan",method="plotSimmap",colors=obj$cols)
add.color.bar(0.8,cols=obj$cols,title="trait value",obj$lims,digits=2,
    prompt=FALSE,x=0.9*par()$usr[1],y=0.9*par()$usr[4])
dev.off()

## png 
##   2

You can see this product here: 28Apr15-post.pdf.

Finally, we can plot negative values. So, again with a smaller tree:

tip.label<-replicate(60,paste(sample(LETTERS,1),"._",
    paste(sample(letters,round(runif(n=1,min=4,max=8))),
    collapse=""),sep=""))
tree<-pbtree(n=60,tip.label=tip.label,scale=1)
x<-fastBM(tree)
plotTree.wBars(tree,x,scale=0.2,tip.labels=TRUE,fsize=0.6)

## or
obj<-contMap(tree,x,plot=FALSE)
plotTree.wBars(obj$tree,x,fsize=0.6,scale=0.2,tip.labels=TRUE,
    method="plotSimmap",colors=obj$cols)

OK, that's it.