[Ecopd-commits] r48 - pkg/R

[noreply at r-forge.r-project.org]

Author: regetz
Date: 2009-10-24 02:06:20 +0200 (Sat, 24 Oct 2009)
New Revision: 48

Modified:
   pkg/R/pd.R
Log:
updated getMinTL to work with Supertree as a phylo4 object


Modified: pkg/R/pd.R
===================================================================
--- pkg/R/pd.R	2009-10-24 00:01:55 UTC (rev 47)
+++ pkg/R/pd.R	2009-10-24 00:06:20 UTC (rev 48)
@@ -13,15 +13,10 @@
 # lookup function for minimum tip length
 getMinTL <- function(tree, genera) {
 
+  Supertree <- phylo4(Supertree)
+
   if (missing(genera)) stop("must supply vector of genera")
 
-  lengthsTipToRoot <- function(x) {
-    root.node <- rootNode(x)
-    sapply(ancestors(x, nodeId(x, "tip"), "ALL"), function(n) {
-      sumEdgeLength(x, setdiff(n, root.node))
-    })
-  }
-
   # Families, Supertree, and LookupTL are all system data built into
   # the package
 
@@ -48,8 +43,8 @@
   # any user-supplied taxa cannot be matched to families in the
   # supertree, they are simply ignored
   subsupertree <- subset(Supertree, na.omit(familiesInSupertree))
-  subsupertree.maxLength <- max(cophenetic(subsupertree))/2
-  tree.maxLength <- max(lengthsTipToRoot(tree))
+  subsupertree.maxLength <- max(pairdist(subsupertree, type="tip"))/2
+  tree.maxLength <- max(tipLength(tree, from="root"))
 
   tableTL <- LookupTL[familiesInSupertree, "minTL"]
 
@@ -66,7 +61,7 @@
   }
 
   lookupTL <- tableTL * (tree.maxLength / subsupertree.maxLength)
-  actualTL <- tipLength(tree)
+  actualTL <- tipLength(tree, from="parent")
   minTL <- ifelse(lookupTL < actualTL, lookupTL, actualTL)
 
   return(minTL)