[Phylobase-commits] r905 - pkg/R

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

Author: francois
Date: 2014-04-08 18:18:16 +0200 (Tue, 08 Apr 2014)
New Revision: 905

Modified:
   pkg/R/treestruc.R
Log:
cleaning up doc, making hasSingle hasPoly and hasRetic methods

Modified: pkg/R/treestruc.R
===================================================================
--- pkg/R/treestruc.R	2014-04-08 15:43:42 UTC (rev 904)
+++ pkg/R/treestruc.R	2014-04-08 16:18:16 UTC (rev 905)
@@ -1,57 +1,89 @@
-## not bothering to check for zero branch lengths:
-##   consensus is that this isn't very important,
-##  and that it's simple enough to do
-##   any(edgeLength(x)==0) if necessary
-hasPoly <- function(object) {
-  if(!checkPhylo4(object)) stop("to be used with a phylo4 object")
-  if (nEdges(object)==0) return(FALSE)
-  degree <- tabulate(edges(object, drop.root=TRUE)[, 1])
-  any(degree > 2)
-}
 
+##' Test trees for polytomies, inline nodes (singletons), or reticulation
+##' 
+##' Methods to test whether trees have (structural) polytomies, inline
+##' nodes (i.e., nodes with a single descendant), or reticulation
+##' (i.e., nodes with more than one ancestor). \code{hasPoly} only
+##' check for structural polytomies (1 node has more than 2
+##' descendants) and not polytomies that result from having edges with
+##' a length of 0.
+##' 
+##' @aliases hasSingle
+##' @param object an object inheriting from class \code{phylo4}
+##' @return Logical value
+##' @note Some algorithms are unhappy with structural polytomies (i.e., >2
+##' descendants from a node), with single-descendant nodes, or with
+##' reticulation; these functions check those properties.  We haven't bothered
+##' to check for zero branch lengths: the consensus is that it doesn't come up
+##' much, and that it's simple enough to test \code{any(edgeLength(x) == 0)} in
+##' these cases.  (Single-descendant nodes are used e.g. in OUCH, or in other
+##' cases to represent events occurring along a branch.)
+##' @author Ben Bolker
+##' @rdname treeStructure-methods
+##' @keywords misc
+##' @examples
+##' 
+##' tree.owls.bis <- ape::read.tree(text="((Strix_aluco:4.2,Asio_otus:4.2):3.1,Athene_noctua:7.3);")
+##' owls4 <- as(tree.owls.bis, "phylo4")
+##' hasPoly(owls4)
+##' hasSingle(owls4)
+##'
+setGeneric("hasSingle", function(object) {
+    standardGeneric("hasSingle")
+})
 
+##' @rdname treeStructure-methods
+##' @aliases hasSingle,phylo4-method
+setMethod("hasSingle", signature(object="phylo4"),
+  function(object) {
+      if (nEdges(object) == 0) {
+          return(FALSE)
+      }
+      ## This is about 3 times slower than using the C++
+      ## function tabulateTips
+      ##  degree <- tabulate(edges(object, drop.root=TRUE)[, 1])
+      degree <- tabulateTips(object at edge[, 1])
+      any(degree == 1)
+})
 
-#' Test trees for polytomies, inline nodes, or reticulation
-#' 
-#' checks to see whether trees have (structural) polytomies, inline nodes
-#' (i.e., nodes with a single descendant), or reticulation (i.e., nodes with
-#' more than one ancestor)
-#' 
-#' 
-#' @aliases hasSingle hasPoly hasRetic
-#' @param object an object inheriting from class \code{phylo4}
-#' @return Logical value
-#' @note Some algorithms are unhappy with structural polytomies (i.e., >2
-#' descendants from a node), with single-descendant nodes, or with
-#' reticulation; these functions check those properties.  We haven't bothered
-#' to check for zero branch lengths: the consensus is that it doesn't come up
-#' much, and that it's simple enough to test \code{any(edgeLength(x) == 0)} in
-#' these cases.  (Single-descendant nodes are used e.g. in OUCH, or in other
-#' cases to represent events occurring along a branch.)
-#' @author Ben Bolker
-#' @keywords misc
-#' @examples
-#' 
-#' tree.owls.bis <- ape::read.tree(text = "((Strix_aluco:4.2,Asio_otus:4.2):3.1,Athene_noctua:7.3);")
-#' owls4 <- as(tree.owls.bis, "phylo4")
-#' hasPoly(owls4)
-#' hasSingle(owls4)
-#' 
-hasSingle <- function(object) {
-  if(!checkPhylo4(object)) stop("to be used with a phylo4 object")
-  if (nEdges(object)==0) return(FALSE)
-  degree <- tabulate(edges(object, drop.root=TRUE)[, 1])
-  any(degree == 1)
-}
+##' @rdname treeStructure-methods
+##' @aliases hasRetic
+setGeneric("hasRetic", function(object) {
+    standardGeneric("hasRetic")
+})
 
-hasRetic <- function(object) {
-  if(!checkPhylo4(object)) stop("to be used with a phylo4 object")
-  if (nEdges(object)==0) return(FALSE)
-  ancest <- tabulate(edges(object)[, 2])
-  any(ancest > 1)
-}
+##' @rdname treeStructure-methods
+##' @aliases hasRetic,phylo4-method
+setMethod("hasRetic", signature(object="phylo4"), function(object) {
+    if (nEdges(object)==0) {
+        return(FALSE)
+    }
+    ## this is about the same (slightly faster on 10,000 tips)
+    ##  than using the C++ function
+    ancest <- tabulate(edges(object)[, 2])
+    any(ancest > 1)    
+})
 
+##' @rdname treeStructure-methods
+##' @aliases hasPoly
+setGeneric("hasPoly", function(object) {
+    standardGeneric("hasPoly")
+})
 
+##' @rdname treeStructure-methods
+##' @aliases hasPoly,phylo4-method
+setMethod("hasPoly", signature(object="phylo4"), function(object) {
+  if (nEdges(object)==0) {
+      return(FALSE)
+  }
+  ## This is about 3 times slower than using the C++
+  ## function tabulateTips
+  ## degree <- tabulate(edges(object, drop.root=TRUE)[, 1])
+  degree <- tabulateTips(object at edge[, 1])
+  any(degree > 2)
+})
+
+
 ### TO BE FINISHED - Thibaut
 
 # Returns a vector of logical