[Phylobase-commits] r216 - branches/pdcgsoc/R

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

Author: pdc
Date: 2008-07-27 22:36:52 +0200 (Sun, 27 Jul 2008)
New Revision: 216

Modified:
   branches/pdcgsoc/R/methods-phylo4.R
   branches/pdcgsoc/R/methods-phylo4d.R
   branches/pdcgsoc/R/phylo4.R
Log:
updates to reorder command.  several issues still remain
1. because node and tip labels are not stored in order in the same slot, it is difficult to track nodes, and currently they are not
2. A similar issue exists with the data objects stored in separate data frames so the phylo4d methods doesn't reorder the data!
3. currently this command masks a generic with the same name in stats, since is doesn't replace the functionality in that command, I need to either find a work around or change the method name

Modified: branches/pdcgsoc/R/methods-phylo4.R
===================================================================
--- branches/pdcgsoc/R/methods-phylo4.R	2008-07-25 20:39:22 UTC (rev 215)
+++ branches/pdcgsoc/R/methods-phylo4.R	2008-07-27 20:36:52 UTC (rev 216)
@@ -295,3 +295,28 @@
     object
 })
 
+setMethod("reorder", signature(object = 'phylo4'), function(object, type = 'pruningwise') {
+    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(type == 'pruningwise') {
+        index <- reorder.prune(object at edge, length(object at tip.label))
+    }
+    print('test')
+    object at edge        <- object at edge[index, ]
+    object at edge.label  <- object at edge.label[index]
+    object at edge.length <- object at edge.length[index]
+    object
+})

Modified: branches/pdcgsoc/R/methods-phylo4d.R
===================================================================
--- branches/pdcgsoc/R/methods-phylo4d.R	2008-07-25 20:39:22 UTC (rev 215)
+++ branches/pdcgsoc/R/methods-phylo4d.R	2008-07-27 20:36:52 UTC (rev 216)
@@ -156,3 +156,28 @@
     temp <- rev(names(attributes(x)))[-1]
     return(rev(temp))
 })
+
+setMethod("reorder", signature(object = 'phylo4d'), function(object, type = 'pruningwise') {
+    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(type == 'pruningwise') {
+        index <- reorder.prune(object at edge, length(object at tip.label))
+    }
+    object at edge        <- object at edge[index, ]
+    object at edge.label  <- object at edge.label[index]
+    object at edge.length <- object at edge.length[index]
+    object
+})

Modified: branches/pdcgsoc/R/phylo4.R
===================================================================
--- branches/pdcgsoc/R/phylo4.R	2008-07-25 20:39:22 UTC (rev 215)
+++ branches/pdcgsoc/R/phylo4.R	2008-07-27 20:36:52 UTC (rev 216)
@@ -83,53 +83,7 @@
 setGeneric("na.omit")
 
 setGeneric("reorder", def = function(object, type = 'pruningwise') {
-    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(type == 'pruningwise') {
-        index <- reorder.prune(object at edge, length(object at tip.label))
-    }
-    object at edge        <- object at edge[index, ]
-    object at edge.label  <- object at edge.label[index]
-    object at edge.length <- object at edge.length[index]
-    object
-},
-    useAsDefault = function(object, type = 'pruningwise') {
-        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(type == 'pruningwise') {
-            index <- reorder.prune(object at edge, length(object at tip.label))
-        }
-        object at edge        <- object at edge[index, ]
-        object at edge.label  <- object at edge.label[index]
-        object at edge.length <- object at edge.length[index]
-        object
-})
+    standardGeneric("reorder")}, package = 'phylobase', useAsDefault = FALSE)