[Phylobase-commits] r900 - pkg/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Apr 8 17:07:30 CEST 2014
Author: francois
Date: 2014-04-08 17:07:30 +0200 (Tue, 08 Apr 2014)
New Revision: 900
Modified:
pkg/R/edgeLength-methods.R
Log:
updated/added documentation for edgeLength methods
Modified: pkg/R/edgeLength-methods.R
===================================================================
--- pkg/R/edgeLength-methods.R 2014-04-08 15:06:21 UTC (rev 899)
+++ pkg/R/edgeLength-methods.R 2014-04-08 15:07:30 UTC (rev 900)
@@ -1,37 +1,96 @@
+## TODO -- the behavior of edgeLength needs to be made more consistent
+## with other functions like MRCA. The user should be able to specify a
+## vector of nodes, of edges, or both.
+##### This file contains
+## hasEdgeLength
+## edgeLength and edgeLength<-
+## isUltrametric
+## nodeDepth
+## sumEdgeLength
+##' edgeLength methods
+##'
+##' These functions give information about and allow replacement of edge lengths.
+##'
+##' The \code{edgeLength} function returns the edge length in the same
+##' order as the edges in the matrix.
+##'
+##' @param x a \code{phylo4} or \code{phylo4d} object.
+##' @param value a numeric vector indicating the new values for the edge lengths
+##' @param node optional numeric or character vector indicating the
+##' nodes for which edge
+##' @param use.name should the the name attributes of \code{value} be
+##' used to match the length to a given edge.
+##' @param tol the tolerance to decide whether all the tips have the
+##' same depth to test if the tree is ultrametric. Default is
+##' \code{.Machine$double.eps^0.5}.
+##' @return \describe{
+##'
+##' \item{hasEdgeLength}{whether or not the object has edge lengths
+##' (logical)}
+##'
+##' \item{edgeLength}{a named vector of the edge length for the
+##' object}
+##'
+##' \item{nodeDepth}{a named vector indicating the \dQuote{depth} (the
+##' distance between the root and the tip) of each tip.}
+##'
+##' \item{isUltrametric}{whether or not the tree is ultrametric (all
+##' the tips are have the same depth (distance from the root) (logical)}
+##'
+##' \item{sumEdgeLength}{the sum of the edge lengths for a set of
+##' nodes (intended to be used with \code{ancestors} or \code{descendants})}
+##' }
+##' @seealso \code{ancestors}, \code{descendants}, \code{.Machine} for
+##' more information about tolerance.
+##' @export
+##' @docType methods
+##' @rdname edgeLength-methods
+##' @include phylo4-class.R phylo4-methods.R phylo4-accessors.R nodeId-methods.R
+##' @examples
+##' data(geospiza)
+##' hasEdgeLength(geospiza) # TRUE
+##' topoGeo <- geospiza
+##' edgeLength(topoGeo) <- NULL
+##' hasEdgeLength(topoGeo) # FALSE
+##'
+##' edgeLength(geospiza)[2] # use the position in vector
+##' edgeLength(geospiza)["16-17"] # or the name of the edge
+##' edgeLength(geospiza, 17) # or the descendant node of the edge
+##'
+##' ## The same methods can be used to update an edge length
+##' edgeLength(geospiza)[2] <- 0.33
+##' edgeLength(geospiza)["16-17"] <- 0.34
+##' edgeLength(geospiza, 17) <- 0.35
+setGeneric("hasEdgeLength", function(x) {
+ standardGeneric("hasEdgeLength")
+})
-setMethod("depthTips", signature(x="phylo4"), function(x) {
- nodeDepth(x, 1:nTips(x))
+##' @rdname edgeLength-methods
+##' @aliases hasEdgeLength,phylo4-method
+setMethod("hasEdgeLength", signature(x="phylo4"),
+ function(x) {
+ !all(is.na(x at edge.length))
})
+#### ----- edgeLength
-
-setMethod("nodeDepth", signature(x="phylo4"),
- function(x, node) {
- if (!hasEdgeLength(x))
- return(NULL)
- else {
- node <- getNode(x, node, missing="warn")
- node <- node[!is.na(node)]
- res <- sapply(node, function(n)
- sumEdgeLength(x, ancestors(x, n, "ALL")))
- if (length(res) == 1) {
- res <- res[[1]]
- names(res) <- names(node)
- }
- res
- }
+##' @rdname edgeLength-methods
+##' @aliases edgeLength
+setGeneric("edgeLength", function(x, ...) {
+ standardGeneric("edgeLength")
})
-
-setMethod("hasEdgeLength", signature(x="phylo4"),
- function(x) {
- !all(is.na(x at edge.length))
+##' @rdname edgeLength-methods
+##' @aliases edgeLength<-
+setGeneric("edgeLength<-", function(x, ..., value) {
+ standardGeneric("edgeLength<-")
})
-# return edge lengths in order by edgeIds (same order as edge matrix)
+##' @rdname edgeLength-methods
+##' @aliases edgeLength,phylo4-method
setMethod("edgeLength", signature(x="phylo4"),
function(x, node) {
## [JR: below, using match for ordering rather than direct character
@@ -46,6 +105,8 @@
return(elen)
})
+##' @rdname edgeLength-methods
+##' @aliases edgeLength<-,phylo4-method
setReplaceMethod("edgeLength", signature(x="phylo4"),
function(x, use.names=TRUE, ..., value) {
len <- .createEdge(value, x at edge, type="lengths", use.names)
@@ -61,6 +122,57 @@
x
})
+##### ------ depthTips
+
+##' @rdname edgeLength-methods
+##' @aliases depthTips
+setGeneric("depthTips", function(x) {
+ standardGeneric("depthTips")
+})
+
+##' @rdname edgeLength-methods
+##' @aliases depthTips,phylo4-methods
+setMethod("depthTips", signature(x="phylo4"), function(x) {
+ nodeDepth(x, 1:nTips(x))
+})
+
+##### ----- nodeDepth
+
+##' @rdname edgeLength-methods
+##' @aliases nodeDepth
+setGeneric("nodeDepth", function(x, node) {
+ standardGeneric("nodeDepth")
+})
+
+##' @rdname edgeLength-methods
+##' @aliases nodeDepth,phylo4-method
+setMethod("nodeDepth", signature(x="phylo4"),
+ function(x, node) {
+ if (!hasEdgeLength(x))
+ return(NULL)
+ else {
+ node <- getNode(x, node, missing="warn")
+ node <- node[!is.na(node)]
+ res <- sapply(node, function(n)
+ sumEdgeLength(x, ancestors(x, n, "ALL")))
+ if (length(res) == 1) {
+ res <- res[[1]]
+ names(res) <- names(node)
+ }
+ res
+ }
+})
+
+###### ----- sumEdgeLength
+
+##' @rdname edgeLength-methods
+##' @aliases sumEdgeLength
+setGeneric("sumEdgeLength", function(x, node) {
+ standardGeneric("sumEdgeLength")
+})
+
+##' @rdname edgeLength-methods
+##' @aliases sumEdgeLength,phylo4-method
setMethod("sumEdgeLength", signature(x="phylo4"),
function(x, node) {
if(!hasEdgeLength(x))
@@ -68,11 +180,21 @@
else {
nd <- getNode(x, node)
iEdges <- which(x at edge[,2] %in% nd)
- sumEdges <- sum(x at edge.length[iEdges],na.rm=TRUE)
+ sumEdges <- sum(x at edge.length[iEdges], na.rm=TRUE)
sumEdges
}
})
+###### ----- isUltrametric
+
+##' @rdname edgeLength-methods
+##' @aliases isUltrametric
+setGeneric("isUltrametric", function(x, tol=.Machine$double.eps^.5) {
+ standardGeneric("isUltrametric")
+})
+
+##' @rdname edgeLength-methods
+##' @aliases isUltrametric,phylo4-method
setMethod("isUltrametric", signature(x="phylo4"),
function(x, tol=.Machine$double.eps^.5) {
if (!hasEdgeLength(x)) {
More information about the Phylobase-commits
mailing list