[Phylobase-commits] r613 - in pkg: R man src

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Wed Sep 2 21:01:48 CEST 2009


Author: regetz
Date: 2009-09-02 21:01:46 +0200 (Wed, 02 Sep 2009)
New Revision: 613

Added:
   pkg/src/reorderBinary.c
   pkg/src/reorderRobust.c
Modified:
   pkg/R/methods-phylo4.R
   pkg/man/reorder-methods.Rd
Log:
Reimplemented reorder() in C, leaving original R code commented out
(with slight tweaking to make it easier to uncomment and run if
necessary). Also made some changes to the documentation page.


Modified: pkg/R/methods-phylo4.R
===================================================================
--- pkg/R/methods-phylo4.R	2009-09-02 13:36:55 UTC (rev 612)
+++ pkg/R/methods-phylo4.R	2009-09-02 19:01:46 UTC (rev 613)
@@ -462,46 +462,86 @@
 #########################################################
 
 orderIndex <- function(phy, order = c('preorder', 'postorder')) {
-    ## get an root node free edge matrix
-    ## R scoping allows us to call this variable in
-    ## the postOrder() func defined above
+
     order <- match.arg(order)
+
+    ## get a root node free edge matrix
     edge <- phy at edge[!is.na(phy at edge[, 1]), ]
     ## Sort edges -- ensures that starting order of edge matrix doesn't
     ## affect the order of reordered trees
     edge <- edge[order(edge[, 2]), ]
 
-    ## recursive functions are placed first and calls to those functions below
-    postOrder <- function(node) {
-        ## this function returns a vector of nodes in the post order traversal
-        ## get the descendants
-        traversal <- NULL
-        ## edge -- defined above, outside this function
-        ## extensive testing found this loop to be faster than apply() etc.
-        for(i in edge[edge[, 1] == node, 2]) {
-            traversal <- c(traversal, postOrder(i))
-        }
-        c(traversal, node)
+    # recast order argument as integer to pass to C
+    if(order == 'postorder') {
+        iOrder <- 0L
+    } else if(order == 'preorder') {
+        iOrder <- 1L
+    } else {stop(paste("Method for", order, "not implemented"))}
+
+    if (!hasPoly(phy) & !hasSingle(phy)) {
+        # method 1: faster, but only works if all internal nodes have
+        # exactly two children (true binary tree)
+
+        # extract nodes, separating descendants into left (first
+        # encountered) and right (second encountered) for each ancestor
+        isFirst <- !duplicated(edge[, 1])
+        ancestor <- as.integer(edge[isFirst, 1])
+        left <- as.integer(edge[isFirst, 2])
+        right <- as.integer(edge[!isFirst, 2])[match(ancestor,
+            edge[!isFirst, 1])]
+        descendantNew <- rep(0L, nEdges(phy))
+        root <- as.integer(rootNode(phy))
+        nEdge <- as.integer(length(ancestor))
+
+        descendantReord <- .C("reorderBinary", descendantNew, root,
+            ancestor, left, right, nEdge, iOrder)[[1]]
+
+    } else {
+        # method 2: not as fast, but robust to singletons and polytomies
+
+        # extract ancestors and descendants
+        ancestor <- as.integer(edge[,1])
+        descendant <- as.integer(edge[,2])
+        descendantNew <- rep(0L, nEdges(phy))
+        root <- as.integer(rootNode(phy))
+        nEdge <- as.integer(nrow(edge))
+
+        descendantReord <- .C("reorderRobust", descendantNew, root,
+            ancestor, descendant, nEdge, iOrder)[[1]]
+
     }
-    preOrder  <- function(node) {
-        ## see expanded code in comments of postOrder()
-        ## only difference here is that we record current node, then descendants
-        traversal <- NULL
-        for(i in edge[edge[, 1] == node, 2]) {
-            traversal <- c(traversal, preOrder(i))
-        }
-        c(node, traversal)
-    }
 
-    if(order == 'postorder') {
-        ## match the new node order to the old order to get an index
-        index <- match(postOrder(rootNode(phy)), phy at edge[, 2])
+    ## Original pure R implementation of the above:
+    #### recursive functions are placed first and calls to those functions below
+    ##postOrder <- function(node) {
+    ##    ## this function returns a vector of nodes in the post order traversal
+    ##    ## get the descendants
+    ##    traversal <- NULL
+    ##    ## edge -- defined above, outside this function
+    ##    ## extensive testing found this loop to be faster than apply() etc.
+    ##    for(i in edge[edge[, 1] == node, 2]) {
+    ##        traversal <- c(traversal, postOrder(i))
+    ##    }
+    ##    c(traversal, node)
+    ##}
+    ##preOrder  <- function(node) {
+    ##    ## see expanded code in comments of postOrder()
+    ##    ## only difference here is that we record current node, then descendants
+    ##    traversal <- NULL
+    ##    for(i in edge[edge[, 1] == node, 2]) {
+    ##        traversal <- c(traversal, preOrder(i))
+    ##    }
+    ##    c(node, traversal)
+    ##}
+    ##if(order == 'postorder') {
+    ##    descendantReord <- postOrder(rootNode(phy))
+    ##} else if(order == 'preorder') {
+    ##    descendantReord <- preOrder(rootNode(phy))
+    ##} else {stop(paste("Method for", order, "not implemented"))}
 
-    } else if(order == 'preorder') {
-        ## match the new node order to the old order to get an index
-        index <- match(preOrder(rootNode(phy)), phy at edge[, 2])
+    ## match the new node order to the old order to get an index
+    index <- match(descendantReord, phy at edge[, 2])
 
-    } else {stop(paste("Method for", order, "not implemented"))}
 }
 
 setMethod("reorder", signature(x = 'phylo4'),

Modified: pkg/man/reorder-methods.Rd
===================================================================
--- pkg/man/reorder-methods.Rd	2009-09-02 13:36:55 UTC (rev 612)
+++ pkg/man/reorder-methods.Rd	2009-09-02 19:01:46 UTC (rev 613)
@@ -4,7 +4,6 @@
 \alias{reorder,phylo-method}
 \alias{reorder,phylo4-method}
 \alias{reorder,phylo4d-method}
-\alias{.orderIndex}
 \title{reordering trees within phylobase objects}
 \description{
  Methods for reordering trees into various traversal orders
@@ -20,25 +19,40 @@
 \usage{
 \S4method{reorder}{phylo}(x, order = "cladewise")
 \S4method{reorder}{phylo4}(x, order = c("preorder", "postorder"))
-.orderIndex(phy, order = c('preorder','postorder'))
 }
 
 \arguments{
-  \item{phy}{a \code{phylo4} or \code{phylo4d} object}
   \item{x}{a \code{phylo4} or \code{phylo4d} object}
-  \item{order}{The desired traversal order currently only 'preorder' and 'postorder' are allowed for \code{phylo4} and \code{phylo4d} objects, while only 'cladewise' is accepted for \code{phylo} objects}
+  \item{order}{The desired traversal order; currently only 'preorder'
+    and 'postorder' are allowed for \code{phylo4} and \code{phylo4d}
+    objects, whereas only 'cladewise' and 'pruningwise' are allowed for
+    \code{phylo} objects}
 }
 \details{
-The \code{reorder} method takes \code{phylo4} or \code{phylo4d} tree and orders the edge matrix (e.g. \code{edges(phy)}) in the requested traversal order.  Currently only two orderings are permitted and both require rooted trees.  In "postorder" a nodes descendants come before that node, thus the root, being ancestral to all nodes, comes last.  "Preorder" is the converse, a node is visited before it's descendants, thus the root comes first.
+  The \code{reorder} method takes a \code{phylo4} or \code{phylo4d} tree
+  and orders the edge matrix (i.e. \code{edges(x)}) in the requested
+  traversal order. Currently only two orderings are permitted, and both
+  require rooted trees. In "postorder", a node's descendants come before
+  that node, thus the root, which is ancestral to all nodes, comes last.
+  In "preorder", a node is visited before its descendants, thus the root
+  comes first.
 
-A method is also defined that takes an \code{ape phylo} object.  This also takes an order argument, however, 'pruningwise' and 'cladewise' are the only acceptable parameters.  This is because this method actually uses the \code{ape reorder()} command to complete the ordering.  
+  A method is also defined that takes an \code{ape phylo} object.  This
+  also takes an order argument, however, 'pruningwise' and 'cladewise'
+  are the only acceptable parameters. This is because this method
+  actually uses the \code{ape reorder()} command to complete the
+  ordering.
 }
 \value{
-A \code{phylo4} or \code{phylo4d} object with the edge, label, length and data slots ordered as \code{order}.
+  A \code{phylo4} or \code{phylo4d} object with the edge, label, length
+  and data slots ordered as \code{order}, which is itself recorded in
+  the order slot.
 }
-\author{Peter Cowan}
+\author{Peter Cowan, Jim Regetz}
 \note{
-  The "preorder" parameter corresponds to "cladewise" in the \code{ape} package, and "postorder" corresponds (almost but close enough?) to "pruningwise".  
+  The "preorder" parameter corresponds to "cladewise" in the \code{ape}
+  package, and "postorder" corresponds (almost but close enough?) to
+  "pruningwise".  
   
   See \url{http://ape.mpl.ird.fr/misc/FormatTreeR_28July2008.pdf}
 }
@@ -46,4 +60,9 @@
  \code{\link{ancestors}} \code{\link{ancestor}} \code{\link{siblings}}
  \code{\link{children}} \code{\link{descendants}}
 }
+\examples{
+phy <- phylo4(rtree(5))
+edges(reorder(phy, "preorder"))
+edges(reorder(phy, "postorder"))
+}
 \keyword{methods}

Added: pkg/src/reorderBinary.c
===================================================================
--- pkg/src/reorderBinary.c	                        (rev 0)
+++ pkg/src/reorderBinary.c	2009-09-02 19:01:46 UTC (rev 613)
@@ -0,0 +1,66 @@
+/*
+  reorderBinary.c:
+    Given a root node, reorder a tree either as postorder or preorder.
+  Works only on binary trees, in which each internal node has exactly 2
+  descendants. Function inputs are derived from a phylo4 edge matrix.
+  The new descendant node ordering is stored in descendantNew.
+*/
+
+#include <R.h>
+
+typedef struct {
+    int *descendantNew;
+    int *ancestor;
+    int *left;
+    int *right;
+    int nEdges;
+    int index;
+    } tree;
+
+void postorderBinary(tree*, int node);
+void preorderBinary(tree*, int node);
+
+void reorderBinary(int *descendantNew, int *root, int *ancestor, int *left,
+    int *right, int *nEdges, int *order) {
+
+    tree tr;
+    tr.ancestor = ancestor;
+    tr.left = left;
+    tr.right = right;
+    tr.descendantNew = descendantNew;
+    tr.nEdges = *nEdges;
+    tr.index = 0;
+
+    if (*order==0) {
+      postorderBinary(&tr, *root);
+    } else if (*order==1) {
+      preorderBinary(&tr, *root);
+    } else {
+      error("invalid order type");
+    }
+
+}
+
+// postorder: continue traversing to the end, then record node
+void postorderBinary(tree *tr, int node) {
+    for (int i=0; i<tr->nEdges; i++) {
+        if (tr->ancestor[i]==node) {
+            postorderBinary(tr, tr->left[i]);
+            postorderBinary(tr, tr->right[i]);
+        }
+     }
+    tr->descendantNew[tr->index] = node;
+    tr->index += 1;
+}
+
+// preorder: record node first, then continue traversing
+void preorderBinary(tree *tr, int node) {
+    tr->descendantNew[tr->index] = node;
+    tr->index += 1;
+    for (int i=0; i<tr->nEdges; i++) {
+        if (tr->ancestor[i]==node) {
+            preorderBinary(tr, tr->left[i]);
+            preorderBinary(tr, tr->right[i]);
+        }
+    }
+}


Property changes on: pkg/src/reorderBinary.c
___________________________________________________________________
Name: svn:eol-style
   + native

Added: pkg/src/reorderRobust.c
===================================================================
--- pkg/src/reorderRobust.c	                        (rev 0)
+++ pkg/src/reorderRobust.c	2009-09-02 19:01:46 UTC (rev 613)
@@ -0,0 +1,62 @@
+/*
+  reorderRobust.c:
+    Given a root node, reorder a tree either as postorder or preorder.
+  Works on any valid tree, including those with singleton nodes and/or
+  polytomies. Function inputs are derived from a phylo4 edge matrix. The
+  new descendant node ordering is stored in descendantNew.
+*/
+
+#include <R.h>
+
+typedef struct {
+    int *descendantNew;
+    int *ancestor;
+    int *descendant;
+    int nEdges;
+    int index;
+    } tree;
+
+void postorderRobust(tree*, int node);
+void preorderRobust(tree*, int node);
+
+void reorderRobust(int *descendantNew, int *root, int *ancestor,
+    int *descendant, int *nEdges, int *order) {
+
+    tree tr;
+    tr.ancestor = ancestor;
+    tr.descendant = descendant;
+    tr.descendantNew = descendantNew;
+    tr.nEdges = *nEdges;
+    tr.index = 0;
+
+    if (*order==0) {
+        postorderRobust(&tr, *root);
+    } else if (*order==1) {
+        preorderRobust(&tr, *root);
+    } else {
+        error("invalid order type");
+    }
+
+}
+
+// postorder: continue traversing to the end, then record node
+void postorderRobust(tree *tr, int node) {
+    for (int i=0; i<tr->nEdges; i++) {
+        if (tr->ancestor[i]==node) {
+            postorderRobust(tr, tr->descendant[i]);
+        }
+    }
+    tr->descendantNew[tr->index] = node;
+    tr->index += 1;
+}
+
+// preorder: record node before continuing traversal
+void preorderRobust(tree *tr, int node) {
+    tr->descendantNew[tr->index] = node;
+    tr->index += 1;
+    for (int i=0; i<tr->nEdges; i++) {
+        if (tr->ancestor[i]==node) {
+            preorderRobust(tr, tr->descendant[i]);
+        }
+    }
+}


Property changes on: pkg/src/reorderRobust.c
___________________________________________________________________
Name: svn:eol-style
   + native



More information about the Phylobase-commits mailing list