Hi Nick.
drop.tip(...,trim.internal=FALSE) almost does this, but it will not
allow you to trim all the leaves in the tree.
Why don't you try the attached function, which I'm calling drop.leaves.
It does what you want, I think, and should be straightforward to figure
out. The tip labels on the pruned tree are either the node labels (if
they exist) or the node numbers in the original tree; or (if
keep.tip.labels=TRUE) they are a comma separated list of the tips
descended from that node in the input tree. Note that not all tips will
be in these lists because some edges from internal nodes lead to only
one tip.
Feedback welcome.
All the best, Liam
Liam J. Revell, Assistant Professor of Biology
University of Massachusetts Boston
web: http://faculty.umb.edu/liam.revell/
email: [email protected]
blog: http://blog.phytools.org
On 8/13/2013 10:43 AM, Nicholas Crouch wrote:
Hi All,
For an analysis I am performing I am looking to drop all terminal branches
from a phylogeny (class "phylo"). The idea is to end up with only branches
that lead to nodes. Does anyone know how to drop these lengths to leave me
everything else?
Thanks,
Nick
[[alternative HTML version deleted]]
_______________________________________________
R-sig-phylo mailing list - [email protected]
https://stat.ethz.ch/mailman/listinfo/r-sig-phylo
Searchable archive at http://www.mail-archive.com/[email protected]/
## function drops all the leaves from the tree & collapses singleton nodes
## written by Liam J. Revell 2013
drop.leaves<-function(tree,...){
## optional arguments
if(hasArg(keep.tip.labels)) keep.tip.labels<-list(...)$keep.tip.labels
else keep.tip.labels<-FALSE
## end optional arguments
n<-length(tree$tip)
edge<-tree$edge
edge[edge>n]<--edge[edge>n]+n
ii<-which(edge[,2]>0)
edge<-edge[-ii,]
if(!is.null(tree$edge.length)){
edge.length<-tree$edge.length
edge.length<-edge.length[-ii]
}
zz<-sapply(edge[,2],function(x,y) !(x%in%y),y=edge[,1])
if(is.null(tree$node.label)) tree$node.label<-1:tree$Nnode+n
nn<-matrix(tree$node.label[-edge],nrow(edge),ncol(edge))
tip.label<-nn[zz,2]
node.label<-c(nn[1,1],nn[!zz,2])
edge[zz,2]<-1:sum(zz)
Nnode<-length(unique(edge[edge<0]))
rr<-cbind(sort(unique(edge[edge<0]),decreasing=TRUE),1:Nnode+sum(zz))
for(i in 1:nrow(rr)) edge[edge==rr[i,1]]<-rr[i,2]
tt<-list(edge=edge,Nnode=Nnode,tip.label=tip.label,edge.length=edge.length,node.label=node.label)
class(tt)<-"phylo"
tt<-collapse.singles(tt)
if(keep.tip.labels){
for(i in 1:length(tt$tip.label)){
yy<-getDescendants(tree,node=which(tree$node.label==tt$tip.label[i])+n)
tt$tip.label[i]<-paste(tree$tip.label[yy[yy<=n]],collapse=",")
}
}
return(tt)
}_______________________________________________
R-sig-phylo mailing list - [email protected]
https://stat.ethz.ch/mailman/listinfo/r-sig-phylo
Searchable archive at http://www.mail-archive.com/[email protected]/
