Tuesday, May 10, 2016

Average trees in 'tree space'

I have just been messing around with visualizing treespace (or, more accurately, a projection of the distances between trees into Euclidean space).

What I'm going to show is a distribution of trees, and the average from this distribution by some measure, projected into a one or two dimensional tree-space. Here I'll use 'quadratic path difference,' which is a measure of the degree to which the implied distances between taxa for two trees differ one from the other. I'm also going to overlay the “average” tree by the same criterion, which can be obtained by computing the least-squares tree from the mean patristic distances implied by the set of input trees.

Here is the result of a couple of experiments.

Firstly, with one set of trees sampled by performing random NNIs from a single starting tree:

library(phytools)
library(phangorn)
library(ks)

## helper function to use later
mt<-phytools:::make.transparent

## generate random NNIs
trees<-rNNI(rtree(n=8),moves=sample(1:8,replace=TRUE,size=120))

## compute average tree (to be used later)
ave.tree<-midpoint(ls.consensus(trees))
## Best Q = 0.0573618227165727
## Solution found after 1 set of nearest neighbor interchanges.
## append to the set of simulated trees
ave.tree<-list(ave.tree)
class(ave.tree)<-"multiPhylo"
trees<-c(trees,ave.tree)

## compute all pairwise "quadratic path differences" distances
D<-phytools:::qpd(trees,trees)

## this is for plotting
rescaleTree<-function(x,scale){
    x$edge.length<-x$edge.length/max(nodeHeights(x))*scale
    x
}

## compute the MDS in one dimension
d<-cmdscale(D,k=1)[,1]

## plot
h<-sapply(trees,function(x) max(nodeHeights(x)))
pd<-density(d,bw=1)
plot(pd$x,pd$y,lwd=2,col=mt("navy",0.3),type="l",ylab="density",
    xlab="QPD distance (one-dimensional MDS)")

## add arrow for the distance from the average tree
lines(rep(d[121],2),par()$usr[3:4],lty="dashed",col="red")
arrows(x0=d[121],y0=par()$usr[4],x1=d[121],
    y1=pd$y[which(abs(pd$x-d[121])==min(abs(pd$x-d[121])))],
    lwd=2,col="red",length=0.15,angle=20)
text(x=d[121],y=0.98*par()$usr[4],"average tree",pos=4,cex=0.8)

## add all the trees to the plot
x<-y<-vector()
maxdist<-function(y,x,X,Y){
    d<-as.matrix(dist(rbind(c(x,y),cbind(X,Y))))[,1]
    max(-d[2:length(d)]^2)
}
for(i in 1:120){
    ii<-which(abs(pd$x-d[i])==min(abs(pd$x-d[i])))
    y[i]<-if(i>1) if(runif(n=1)>0.5) 0.9*runif(n=1)*pd$y[ii] 
        else optimize(maxdist,c(0,0.9*pd$y[ii]),x=d[i],X=x,
            Y=y)$minimum
        else 0.9*runif(n=1)*pd$y[ii]
    x[i]<-d[i]
    plotTree(rescaleTree(trees[[i]],diff(range(pd$x))/20),
        xlim=c(0,diff(range(pd$x)))-(x[i]-min(pd$x)),ylim=c(0,max(pd$y)),
        tips=setNames((1:Ntip(trees[[i]])-1)*0.01*max(pd$y)+y[i],
        trees[[i]]$tip.label),ftype="off",add=TRUE,lwd=1,
        color=mt("grey",0.5),mar=par()$mar)
}

plot of chunk unnamed-chunk-1

## now in two dimensions
MDS<-cmdscale(D)
pd<-kde(MDS)
plot(pd,xlab="canonical axis 1",ylab="canonical axis 2")
points(MDS[1:120,],col="blue",pch=19)
points(MDS[121,1],MDS[121,2],pch=21,cex=1.25,bg="grey")
rect(MDS[121,1]+0.5*strwidth("W"),
    MDS[121,2]-0.5*0.9*strheight("W"),
    MDS[121,1]+0.5*strwidth("W")+0.9*strwidth("average tree"),
    MDS[121,2]+0.5*0.9*strheight("W"),border="transparent",
    col="white")
text(MDS[121,1],MDS[121,2],"average tree",pos=4,cex=0.8)

plot of chunk unnamed-chunk-1

Next, we can try the same thing, but in which the trees are actually drawn from two different distributions. To accomplish this, I will mix trees generated via random NNIs from two different base trees. Everything else more or less stays the same, although I'll color the trees blue or red depending on the distribution they have been drawn from:

trees<-c(rNNI(rtree(n=8),moves=sample(1:6,replace=TRUE,size=60)),
    rNNI(rtree(n=8),moves=sample(1:6,replace=TRUE,size=60)))

ave.tree<-midpoint(ls.consensus(trees))
## Best Q = 1.01133790425158
## Best Q = 1.01133790425158
## Solution found after 2 set of nearest neighbor interchanges.
ave.tree<-list(ave.tree)
class(ave.tree)<-"multiPhylo"
trees<-c(trees,ave.tree)

D<-phytools:::qpd(trees,trees)

d<-cmdscale(D,k=1)[,1]

h<-sapply(trees,function(x) max(nodeHeights(x)))

pd<-density(d)
plot(pd$x,pd$y,lwd=2,col=mt("navy",0.3),type="l",ylab="density",
    xlab="QPD distance (one-dimensional MDS)")
lines(rep(d[121],2),par()$usr[3:4],lty="dashed",col="red")
arrows(x0=d[121],y0=par()$usr[4],x1=d[121],
    y1=pd$y[which(abs(pd$x-d[121])==min(abs(pd$x-d[121])))],
    lwd=2,col="red",length=0.15,angle=20)
text(x=d[121],y=0.98*par()$usr[4],"average tree",pos=4,cex=0.8)

x<-y<-vector()
for(i in 1:120){
    ii<-which(abs(pd$x-d[i])==min(abs(pd$x-d[i])))
    y[i]<-if(i>1) if(runif(n=1)>0.5) 0.9*runif(n=1)*pd$y[ii] 
        else optimize(maxdist,c(0,0.9*pd$y[ii]),x=d[i],X=x,
            Y=y)$minimum
        else 0.9*runif(n=1)*pd$y[ii]
    x[i]<-d[i]
    plotTree(rescaleTree(trees[[i]],diff(range(pd$x))/20),
        xlim=c(0,diff(range(pd$x)))-(x[i]-min(pd$x)),ylim=c(0,max(pd$y)),
        tips=setNames((1:Ntip(trees[[i]])-1)*0.01*max(pd$y)+y[i],
        trees[[i]]$tip.label),ftype="off",add=TRUE,lwd=1,
        color=mt(if(i<=60) "blue" else "red",0.3),
        mar=par()$mar)
}

plot of chunk unnamed-chunk-2

MDS<-cmdscale(D)
pd<-kde(MDS)
plot(pd,xlab="canonical axis 1",ylab="canonical axis 2")
points(MDS[1:120,],col=c(rep("blue",60),rep("red",60)),pch=19)
points(MDS[121,1],MDS[121,2],pch=21,cex=1.25,bg="grey")
rect(MDS[121,1]+0.5*strwidth("W"),
    MDS[121,2]-0.5*0.9*strheight("W"),
    MDS[121,1]+0.5*strwidth("W")+0.9*strwidth("average tree"),
    MDS[121,2]+0.5*0.9*strheight("W"),border="transparent",
    col="white")
text(MDS[121,1],MDS[121,2],"average tree",pos=4,cex=0.8)

plot of chunk unnamed-chunk-2

So in the former case, the average tree corresponds to the modal tree, more or less. However, in the latter case, where the set of trees is a mixture of two different distributions, the mean tree falls precisely between the two corresponding peaks - just as we might expect.

There's nothing really new here, but it is nonetheless kind of fun to explore.

Wednesday, May 4, 2016

as.phylo method for "simmap" and "multiSimmap" objects

I have just added some generic methods/functions as.phylo (method "simmap") and as.multiPhylo to strip the elements and class attributes from objects of class "simmap" and "multiSimmap". The reason for this, well, is because I discovered that the S3 method reorder for objects of class "simmap" was causing some problems for phangorn functions used internally in some of the new consensus tree functions of the phytools package.

This is really pretty simple. In the case of as.phylo, I just added the following function:

as.phylo.simmap<-function(x,...){
    x$maps<-NULL
    x$mapped.edge<-NULL
    if(!is.null(x$node.states)) x$node.states<-NULL
    if(!is.null(x$states)) x$states<-NULL
    if(!is.null(x$Q)) x$Q<-NULL
    if(!is.null(x$logL)) x$logL<-NULL
    if(!is.null(attr(x,"map.order"))) attr(x,"map.order")<-NULL
    class(x)<-setdiff(class(x),"simmap")
    x
}

and then exported an S3 method in NAMESPACE as follows:

S3method(as.phylo, simmap)

and that was all there was to it!

Here is a quick example using as.multiPhylo:

library(phytools)
packageVersion("phytools")
## [1] '0.5.29'
tree
## 
## Phylogenetic tree with 82 tips and 81 internal nodes.
## 
## Tip labels:
##  Anolis_ahli, Anolis_allogus, Anolis_rubribarbus, Anolis_imias, Anolis_sagrei, Anolis_bremeri, ...
## 
## Rooted; includes branch lengths.
head(ecomorph)
##        Anolis_ahli     Anolis_allogus Anolis_rubribarbus 
##                 TG                 TG                 TG 
##       Anolis_imias      Anolis_sagrei     Anolis_bremeri 
##                 TG                 TG                 TG 
## Levels: CG GB TC TG Tr Tw
map.trees<-make.simmap(tree,ecomorph,model="ER",nsim=10)
## make.simmap is sampling character histories conditioned on the transition matrix
## 
## Q =
##             CG          GB          TC          TG          Tr          Tw
## CG -0.11570723  0.02314145  0.02314145  0.02314145  0.02314145  0.02314145
## GB  0.02314145 -0.11570723  0.02314145  0.02314145  0.02314145  0.02314145
## TC  0.02314145  0.02314145 -0.11570723  0.02314145  0.02314145  0.02314145
## TG  0.02314145  0.02314145  0.02314145 -0.11570723  0.02314145  0.02314145
## Tr  0.02314145  0.02314145  0.02314145  0.02314145 -0.11570723  0.02314145
## Tw  0.02314145  0.02314145  0.02314145  0.02314145  0.02314145 -0.11570723
## (estimated using likelihood);
## and (mean) root node prior probabilities
## pi =
##        CG        GB        TC        TG        Tr        Tw 
## 0.1666667 0.1666667 0.1666667 0.1666667 0.1666667 0.1666667
## Done.
map.trees
## 10 phylogenetic trees with mapped discrete characters
map.trees[[1]]
## 
## Phylogenetic tree with 82 tips and 81 internal nodes.
## 
## Tip labels:
##  Anolis_ahli, Anolis_allogus, Anolis_rubribarbus, Anolis_imias, Anolis_sagrei, Anolis_bremeri, ...
## 
## The tree includes a mapped, 6-state discrete character with states:
##  CG, GB, TC, TG, Tr, Tw
## 
## Rooted; includes branch lengths.
par(mfrow=c(4,3))
plot(map.trees,fsize=0.3,lwd=1)
## no colors provided. using the following legend:
##        CG        GB        TC        TG        Tr        Tw 
##   "black"     "red"  "green3"    "blue"    "cyan" "magenta"
## no colors provided. using the following legend:
##        CG        GB        TC        TG        Tr        Tw 
##   "black"     "red"  "green3"    "blue"    "cyan" "magenta"
## no colors provided. using the following legend:
##        CG        GB        TC        TG        Tr        Tw 
##   "black"     "red"  "green3"    "blue"    "cyan" "magenta"
## no colors provided. using the following legend:
##        CG        GB        TC        TG        Tr        Tw 
##   "black"     "red"  "green3"    "blue"    "cyan" "magenta"
## no colors provided. using the following legend:
##        CG        GB        TC        TG        Tr        Tw 
##   "black"     "red"  "green3"    "blue"    "cyan" "magenta"
## no colors provided. using the following legend:
##        CG        GB        TC        TG        Tr        Tw 
##   "black"     "red"  "green3"    "blue"    "cyan" "magenta"
## no colors provided. using the following legend:
##        CG        GB        TC        TG        Tr        Tw 
##   "black"     "red"  "green3"    "blue"    "cyan" "magenta"
## no colors provided. using the following legend:
##        CG        GB        TC        TG        Tr        Tw 
##   "black"     "red"  "green3"    "blue"    "cyan" "magenta"
## no colors provided. using the following legend:
##        CG        GB        TC        TG        Tr        Tw 
##   "black"     "red"  "green3"    "blue"    "cyan" "magenta"
## no colors provided. using the following legend:
##        CG        GB        TC        TG        Tr        Tw 
##   "black"     "red"  "green3"    "blue"    "cyan" "magenta"

plot of chunk unnamed-chunk-3

trees<-as.multiPhylo(map.trees)
trees
## 10 phylogenetic trees
trees[[1]]
## 
## Phylogenetic tree with 82 tips and 81 internal nodes.
## 
## Tip labels:
##  Anolis_ahli, Anolis_allogus, Anolis_rubribarbus, Anolis_imias, Anolis_sagrei, Anolis_bremeri, ...
## 
## Rooted; includes branch lengths.
str(trees[[1]])
## List of 4
##  $ edge       : int [1:162, 1:2] 83 84 85 86 87 88 89 90 90 89 ...
##  $ Nnode      : int 81
##  $ tip.label  : chr [1:82] "Anolis_ahli" "Anolis_allogus" "Anolis_rubribarbus" "Anolis_imias" ...
##  $ edge.length: num [1:162] 0.268 0.209 0.402 0.826 0.768 ...
##  - attr(*, "class")= chr "phylo"
##  - attr(*, "order")= chr "cladewise"
par(mfrow=c(4,3))
nulo<-lapply(trees,plot,cex=0.3,no.margin=TRUE)

plot of chunk unnamed-chunk-4

Of course, the same could have been accomplished by simply setting the class attribute of the "simmap" objects to "phylo", "multiSimmap" to "multiPhylo", and so on. The only advantage of stripping away all the components associated with the object class is that these do not have to be continually copied & re-copied whenever the object is copied.

phytools can be updated thusly from GitHub using devtools:

library(devtools)
install_github("liamrevell/phytools")