[Phylobase-commits] r204 - pkg/R

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

Author: skembel
Date: 2008-07-18 21:11:21 +0200 (Fri, 18 Jul 2008)
New Revision: 204

Modified:
   pkg/R/prune.R
   pkg/R/subset.R
Log:
Subset and prune functions now working properly with new row.name-less phylo4d data format

Modified: pkg/R/prune.R
===================================================================
--- pkg/R/prune.R	2008-07-18 08:14:52 UTC (rev 203)
+++ pkg/R/prune.R	2008-07-18 19:11:21 UTC (rev 204)
@@ -35,23 +35,19 @@
 setMethod("prune","phylo4d",
           function(phy, tip, trim.internal = TRUE, subtree = FALSE,
                    root.edge = 0,...) {
-            oldnodelabels <- phy at node.label
             ## need unique labels to match data correctly
-            tags <- .genlab("N",nNodes(phy))
-            phy at node.label <- tags
-            if (hasNodeData(phy)) {
-              rownames(phy at node.data) <- phy at node.label
-            }
+            oldnodelabels <- phy at node.label
+            nodetags <- .genlab("N",nNodes(phy))
+            phy at node.label <- nodetags
+            oldtiplabels <- phy at tip.label
             phytr <- DropTip(phy,tip,trim.internal, subtree, root.edge)
             ## this DROPS data
-            phytr at tip.data <- phy at tip.data[phytr at tip.label,,drop=FALSE]
-            m1  = match(phytr at node.label,tags)
-            phytr at node.label <- oldnodelabels[m1]
-            if (hasNodeData(phy)) {
-              phytr at node.data <- phy at node.data[m1,,drop=FALSE]
-              rownames(phytr at node.data) <- phytr at node.label
-            }
-            ## phytr at node.label <- oldnodelabels
+            ntr = match(phytr at node.label,nodetags)
+            ttr = match(phytr at tip.label,oldtiplabels)
+            phytr at node.label <- oldnodelabels[ntr]
+            phytr at tip.label <- oldtiplabels[ttr]
+            phytr at node.data <- phy at node.data[ntr,,drop=FALSE]
+            phytr at tip.data <- phy at tip.data[ttr,,drop=FALSE]            
             phytr
           })
 

Modified: pkg/R/subset.R
===================================================================
--- pkg/R/subset.R	2008-07-18 08:14:52 UTC (rev 203)
+++ pkg/R/subset.R	2008-07-18 19:11:21 UTC (rev 204)
@@ -77,13 +77,11 @@
               if(missing(j)) j <- TRUE
 
               #### data handling
-              ## for now handle only tip data
-              ## FIXME update to remove dependency on row.names
-              tab <- tdata(x, which="tip")[i, j, ...,drop=FALSE]
-              oldtabnames <- row.names(tdata(x,which="tip"))
+              ## for now handle only tip data - assumes tip names are good row.names
+              tab <- tdata(x, which="tip")[i, j, ..., drop=FALSE]
               
               #### tree handling
-              tip.include <- match(row.names(tab), oldtabnames)
+              tip.include <- match(row.names(tab), x at tip.label)
               tre <- subset(as(x,"phylo4"), tips.include=tip.include)
 
               ## result
@@ -92,7 +90,6 @@
               return(res)
           })
 
-
 ## coerce phylo4d to phylo4 -- on purpose, so no warning
 
 extract.tree <- function(from) {