matchNodes<-function(tr1,tr2){
desc.tr1<-lapply(1:tr1$Nnode+length(tr1$tip),
function(x) extract.clade(tr1,x)$tip.label)
names(desc.tr1)<-1:tr1$Nnode+length(tr1$tip)
desc.tr2<-lapply(1:tr2$Nnode+length(tr2$tip),
function(x) extract.clade(tr2,x)$tip.label)
names(desc.tr2)<-1:tr2$Nnode+length(tr2$tip)
Nodes<-matrix(NA,length(desc.tr1),2,dimnames= list(NULL,c("tr1","tr2")))
for(i in 1:length(desc.tr1)){
Nodes[i,1]<-as.numeric(names(desc.tr1)[i])
for(j in 1:length(desc.tr2))
if(all(desc.tr1[[i]]%in%desc.tr2[[j]]) && all(desc.tr2[[j]]%in%desc.tr1[[i]]))
Nodes[i,2]<-as.numeric(names(desc.tr2)[j])
}
return(Nodes)
}
desc.tr1<-lapply(1:tr1$Nnode+length(tr1$tip),
function(x) extract.clade(tr1,x)$tip.label)
names(desc.tr1)<-1:tr1$Nnode+length(tr1$tip)
desc.tr2<-lapply(1:tr2$Nnode+length(tr2$tip),
function(x) extract.clade(tr2,x)$tip.label)
names(desc.tr2)<-1:tr2$Nnode+length(tr2$tip)
Nodes<-matrix(NA,length(desc.tr1),2,dimnames= list(NULL,c("tr1","tr2")))
for(i in 1:length(desc.tr1)){
Nodes[i,1]<-as.numeric(names(desc.tr1)[i])
for(j in 1:length(desc.tr2))
if(all(desc.tr1[[i]]%in%desc.tr2[[j]]) && all(desc.tr2[[j]]%in%desc.tr1[[i]]))
Nodes[i,2]<-as.numeric(names(desc.tr2)[j])
}
return(Nodes)
}
The top part of this code pulls out two lists of vectors containing the set of leaves descending from each node in each of the two input trees. The second part asks if - for each pair of nodes - all (and exactly all) of the descendant leaves are shared in common. The function returns a matrix containing the node numbers of tr1 in column 1, and their corresponding matches in column 2. Note, then, that the dimensions of the matrix are defined by the number of nodes in the first input tree. Mismatches in the other direction (i.e., nodes found in tree 2, but not in tree 1) won't be identified (but could be by another call to the function in which the argument order was flipped). Code for this function is here.
fastAnc is now highly simplified, as follows:
fastAnc<-function(tree,x){
if(!is.binary.tree(tree)) btree<-multi2di(tree)
else btree<-tree
M<-btree$Nnode
N<-length(btree$tip)
anc<-vector()
for(i in 1:M+N){
anc[i-N]<-ace(x,multi2di(root(btree,node=i)),
method="pic")$ace[1]
names(anc)[i-N]<-i
}
if(!is.binary.tree(tree)){
ancNames<-matchNodes(tree,btree)
anc<-anc[as.character(ancNames[,2])]
names(anc)<-ancNames[,1]
}
return(anc)
}
if(!is.binary.tree(tree)) btree<-multi2di(tree)
else btree<-tree
M<-btree$Nnode
N<-length(btree$tip)
anc<-vector()
for(i in 1:M+N){
anc[i-N]<-ace(x,multi2di(root(btree,node=i)),
method="pic")$ace[1]
names(anc)[i-N]<-i
}
if(!is.binary.tree(tree)){
ancNames<-matchNodes(tree,btree)
anc<-anc[as.character(ancNames[,2])]
names(anc)<-ancNames[,1]
}
return(anc)
}
I have also made some additional changes to phenogram, phylomorphospace, and phylomorphospace3d, so that they now call fastAnc instead of ace or (worse) anc.ML. I have built this updates into a new non-CRAN version of phytools (version 0.2-01; I know, I just released a new CRAN update of phytools - sorry!) which can be downloaded here and installed from source:
> install.packages("phytools_0.2-01.tar.gz",type="source",
+ repos=NULL)
* installing *source* package 'phytools' ...
** R
...
* DONE (phytools)
+ repos=NULL)
* installing *source* package 'phytools' ...
** R
...
* DONE (phytools)
No comments:
Post a Comment
Note: due to the very large amount of spam, all comments are now automatically submitted for moderation.