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

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

Author: pdc
Date: 2008-07-21 08:55:41 +0200 (Mon, 21 Jul 2008)
New Revision: 209

Modified:
   branches/pdcgsoc/R/phylo4.R
Log:
define generic for reorder
this seems overly verbose, perhaps there's a more parsimonious definition

Modified: branches/pdcgsoc/R/phylo4.R
===================================================================
--- branches/pdcgsoc/R/phylo4.R	2008-07-21 05:52:35 UTC (rev 208)
+++ branches/pdcgsoc/R/phylo4.R	2008-07-21 06:55:41 UTC (rev 209)
@@ -78,8 +78,53 @@
 
 setGeneric("na.omit")
 
-setGeneric("reorder", function(phy) {
-    standardGeneric("reorder")
+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, myorder(edge, tips, root = i))
+        }
+        c(nord, which(index))
+    }
+    if(type == 'pruningwise') {
+        index <- reorder.prune(phy at edge, length(phy at tip.label))
+    }
+    phy at edge        <- phy at edge[index, ]
+    phy at edge.label  <- phy at edge.label[index]
+    phy at edge.length <- phy at edge.length[index]
+    phy
+},
+    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, myorder(edge, tips, root = i))
+            }
+            c(nord, which(index))
+        }
+        if(type == 'pruningwise') {
+            index <- reorder.prune(phy at edge, length(phy at tip.label))
+        }
+        phy at edge        <- phy at edge[index, ]
+        phy at edge.label  <- phy at edge.label[index]
+        phy at edge.length <- phy at edge.length[index]
+        phy
 })