[Phylobase-commits] r353 - pkg/R

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

Author: pdc
Date: 2008-12-20 00:35:38 +0100 (Sat, 20 Dec 2008)
New Revision: 353

Modified:
   pkg/R/methods-phylo4.R
   pkg/R/methods-phylo4d.R
Log:
reworked reorder 
-- now methods for phylo4 and phylo4d objects call orderIndex, which returns an index for phy at edges in the desired order.  The two methods then apply that order to the edge matrix, labels, and data as necessary
-- deleted a duplicate labels method

Modified: pkg/R/methods-phylo4.R
===================================================================
--- pkg/R/methods-phylo4.R	2008-12-19 23:17:25 UTC (rev 352)
+++ pkg/R/methods-phylo4.R	2008-12-19 23:35:38 UTC (rev 353)
@@ -337,10 +337,6 @@
     length(x at edge.length)>0
 })
 
-setMethod("labels","phylo4", function(object,...) {
-    object at tip.label
-})
-
 setReplaceMethod("labels","phylo4", function(object,...,value) {
     if (length(value) != length(object at tip.label))
         stop("Number of tip labels does not match number of tips.")
@@ -348,7 +344,7 @@
     object
 })
 
-setMethod("reorder", signature(x = 'phylo4'), function(x, order = 'cladewise') {
+orderIndex <- function(phy, order = 'cladewise') {
     reorder.prune <- function(edge, tips, root = tips + 1) {
         ## if(is.null(root)) {
         ##     root <- tips + 1
@@ -366,11 +362,14 @@
         c(nord, which(index))
     }
     if(order == 'pruningwise') {
-        index <- reorder.prune(x at edge, length(x at tip.label))
+        index <- reorder.prune(phy at edge, length(phy at tip.label))
         ## add the root node to the end, there may be more elegant ways to do this
-        index <- c(index, which(x at edge[,2] == rootNode(x)))
+        index <- c(index, which(phy at edge[,2] == rootNode(phy)))
     } else {stop(paste("Method for", order, "not implemented"))}
-    
+}
+
+setMethod("reorder", signature(x = 'phylo4'), function(x, order = 'cladewise') {
+    index <- orderIndex(x, order)
     x at edge <- x at edge[index, ]
     if(hasEdgeLabels(x)) { x at edge.label  <- x at edge.label[index] }
     if(hasEdgeLength(x)) { x at edge.length <- x at edge.length[index] }

Modified: pkg/R/methods-phylo4d.R
===================================================================
--- pkg/R/methods-phylo4d.R	2008-12-19 23:17:25 UTC (rev 352)
+++ pkg/R/methods-phylo4d.R	2008-12-19 23:35:38 UTC (rev 353)
@@ -168,26 +168,12 @@
 })
 
 setMethod("reorder", signature(x = 'phylo4d'), function(x, order = 'cladewise') {
-    reorder.prune <- function(edge, tips, root = tips + 1) {
-        ## if(is.null(root)) {
-        ##     root <- tips + 1
-        ## }
-        ## if(root <= tips) {return()}
-        index <- edge[, 1] == root
-        nextr <- edge[index, 2]
-        ## paths <- apply(as.matrix(nextr), 1, reorder, edge = edge, tips = tips)
-        nord <- NULL
-        for(i in nextr) {
-            if(i <= tips) {next()}
-            nord <- c(nord, reorder.prune(edge, tips, root = i))
-        }
-        c(nord, which(index))
-    }
-    if(order == 'pruningwise') {
-        index <- reorder.prune(x at edge, length(x at tip.label))
-    }
-    x at edge        <- x at edge[index, ]
-    x at edge.label  <- x at edge.label[index]
-    x at edge.length <- x at edge.length[index]
-    x
-})
+        index <- orderIndex(x, order)
+        test <<- index
+        x at edge      <- x at edge[index, ]
+        x at tip.data  <- x at tip.data[index[index <= nTips(x)], , drop = FALSE]
+        x at node.data <- x at node.data[index[index > nTips(x)], , drop = FALSE]
+        if(hasEdgeLabels(x)) { x at edge.label  <- x at edge.label[index] }
+        if(hasEdgeLength(x)) { x at edge.length <- x at edge.length[index] }
+        x
+    })