[Phylobase-commits] r907 - pkg/R

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

Author: francois
Date: 2014-04-08 18:53:45 +0200 (Tue, 08 Apr 2014)
New Revision: 907

Modified:
   pkg/R/phylo4-accessors.R
   pkg/R/treestruc.R
Log:
finished commented code in treestruc and moved it to phylo4-accessor, new methods: terminalEdges and internalEdges, updated doc to reflect these changes.

Modified: pkg/R/phylo4-accessors.R
===================================================================
--- pkg/R/phylo4-accessors.R	2014-04-08 16:52:35 UTC (rev 906)
+++ pkg/R/phylo4-accessors.R	2014-04-08 16:53:45 UTC (rev 907)
@@ -74,12 +74,32 @@
 ##'
 ##' @param x A \code{phylo4} or \code{phylo4d} object.
 ##'
-##' @return \code{edges} returns the edge matrix that represent the
-##' ancestor-descendant relationships among the nodes of the tree.
+##' @return \describe{
+##' 
+##' \item{\code{edges}}{returns the edge matrix that represent the
+##' ancestor-descendant relationships among the nodes of the tree.}
 ##'
-##' \code{edgeOrder} returns the order in which the edge matrix is in.
+##' \item{\code{edgeOrder}}{returns the order in which the edge matrix
+##' is in.}
 ##'
-##' @seealso reorder
+##' \item{\code{internalEdges}}{returns a logical vector indicating
+##' internal edges (edges that connect an internal node to
+##' another). This vector is named with the \code{edgeId}}.
+##'
+##' \item{\code{terminalEdges}{returns a logical vector indicating
+##' terminal edges (edges that connect an internal node to a
+##' tip). This vector is named with the \code{edgeId}}
+##' }
+##' @author Ben Bolker, Francois Michonneau, Thibaut Jombart.
+##' @seealso reorder, edgeId
+##' @examples
+##'    data(geospiza)
+##'    edges(geospiza)
+##'    edgeOrder(geospîza)
+##'    geoPost <- reorder(geospiza, "postorder")
+##'    edgeOrder(geoPost)
+##'    ## with a binary tree this should always be true
+##'    identical(!terminalEdges(geospiza), internalEdges(geospiza))
 ##' @export
 ##' @docType methods
 ##' @rdname edges-accessors
@@ -97,10 +117,51 @@
      e
 })
 
+##### -------- edgeOrder
+
 ##' @rdname edges-accessors
+##' @aliases edgeOrder
+setGeneric("edgeOrder", function(x, ...) {
+  standardGeneric("edgeOrder")
+})
+
+##' @rdname edges-accessors
 ##' @aliases edgeOrder,phylo4-method
 setMethod("edgeOrder", signature(x="phylo4"),
  function(x, ...) {
     x at order
 })
 
+##### -------- internalEdges
+
+##' @rdname edges-accessors
+##' @aliases internalEdges
+setGeneric("internalEdges", function(x) {
+    standardGeneric("internalEdges")
+})
+
+##' @rdname edges-accessors
+##' @aliases internalEdges,phylo4-method
+setMethod("internalEdges", signature(x="phylo4"),
+  function(x) {
+      res <- edges(x)[, 2] %in% nodeId(x, "internal")
+      names(res) <- edgeId(x, "all")
+      res
+})
+
+##### -------- terminalEdges
+
+##' @rdname edges-accessors
+##' @aliases terminalEdges
+setGeneric("terminalEdges", function(x) {
+    standardGeneric("terminalEdges")
+})
+
+##' @rdname edges-accessors
+##' @aliases terminalEdges,phylo4-method
+setMethod("terminalEdges", signature(x="phylo4"),
+  function(x) {
+      res <- edges(x)[, 2] %in% nodeId(x, "tip")
+      names(res) <- edgeId(x, "all")
+      res
+})

Modified: pkg/R/treestruc.R
===================================================================
--- pkg/R/treestruc.R	2014-04-08 16:52:35 UTC (rev 906)
+++ pkg/R/treestruc.R	2014-04-08 16:53:45 UTC (rev 907)
@@ -82,40 +82,3 @@
   degree <- tabulateTips(object at edge[, 1])
   any(degree > 2)
 })
-
-
-### TO BE FINISHED - Thibaut
-
-# Returns a vector of logical 
-# TRUE = this edge goes from an internal node to another
-#internEdges <- function(object){
-#  if(!checkPhylo4(object)) stop("to be used with a phylo4 object")
-#  x <- object
-#  isTips <- (tabulate(x at edge[,1]) == 0)
-#  tips <- x at edge[isTips, 1]
-#  inter <- is.na(match(x at edge[,2],tips))
-#  return(inter)
-#}
-
-# Returns a vector of logical 
-# TRUE = this edge goes from an internal node to a tip
-#terminEdges <- function(object){
-#  return(!internEdges(object))
-#}
-
-#isPoly <- function(object, position=c("all", "terminal", "internal")){
-#  if(!checkPhylo4(object)) stop("to be used with a phylo4 object")
-#  x <- object
-#  pos <- match.arg(position)
-#  res <- (tabulate(x at edge[,1]) > 2)
-
-  # all polytomies 
-#  if(pos=="all") return(res)
-
-  # find which edge ends at a tip
-  
-  
-  
-  # external polytomies
-  
-#}