[Phylobase-commits] r923 - pkg/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Apr 9 21:54:17 CEST 2014
Author: francois
Date: 2014-04-09 21:54:17 +0200 (Wed, 09 Apr 2014)
New Revision: 923
Modified:
pkg/R/MRCA-methods.R
pkg/R/RcppExports.R
pkg/R/addData-methods.R
pkg/R/ancestors.R
pkg/R/checkdata.R
pkg/R/edgeLength-methods.R
pkg/R/getNode-methods.R
pkg/R/internal-constructors.R
pkg/R/labels-methods.R
pkg/R/multiphylo4-class.R
pkg/R/nodeId-methods.R
pkg/R/pdata.R
pkg/R/phylo4-accessors.R
pkg/R/phylo4-class.R
pkg/R/phylo4-methods.R
pkg/R/phylo4d-accessors.R
pkg/R/phylo4d-methods.R
pkg/R/phylobase-package.R
pkg/R/phylobase.options.R
pkg/R/phylomats-class.R
pkg/R/print-methods.R
pkg/R/readNCL.R
pkg/R/reorder-methods.R
pkg/R/root-methods.R
pkg/R/setAs-methods.R
pkg/R/shortestPath-methods.R
pkg/R/subset-methods.R
pkg/R/summary-methods.R
pkg/R/tdata-methods.R
pkg/R/treePlot.R
pkg/R/treestruc.R
Log:
clean up and add @export and @exportMethod where appropriate
Modified: pkg/R/MRCA-methods.R
===================================================================
--- pkg/R/MRCA-methods.R 2014-04-09 18:30:28 UTC (rev 922)
+++ pkg/R/MRCA-methods.R 2014-04-09 19:54:17 UTC (rev 923)
@@ -19,6 +19,7 @@
##' @return the node corresponding to the most recent common ancestor
##' @export
##' @include phylo4d-methods.R getNode-methods.R
+##' @include oldclasses-class.R
##' @rdname MRCA
##' @examples
##' data(geospiza)
Modified: pkg/R/RcppExports.R
===================================================================
--- pkg/R/RcppExports.R 2014-04-09 18:30:28 UTC (rev 922)
+++ pkg/R/RcppExports.R 2014-04-09 19:54:17 UTC (rev 923)
@@ -41,8 +41,8 @@
.Call('phylobase_getAllNodesSafe', PACKAGE = 'phylobase', edge)
}
-getAllNodesFast <- function(edge, rooted) {
- .Call('phylobase_getAllNodesFast', PACKAGE = 'phylobase', edge, rooted)
+getAllNodesFast <- function(edge) {
+ .Call('phylobase_getAllNodesFast', PACKAGE = 'phylobase', edge)
}
testEqInt <- function(x, y) {
Modified: pkg/R/addData-methods.R
===================================================================
--- pkg/R/addData-methods.R 2014-04-09 18:30:28 UTC (rev 922)
+++ pkg/R/addData-methods.R 2014-04-09 19:54:17 UTC (rev 923)
@@ -35,6 +35,7 @@
##' @seealso \code{\link{tdata}} for extracting or updating data and
##' \code{\link{phylo4d}} constructor.
##' @keywords methods
+##' @rdname addData-methods
##' @include phylo4d-class.R
##' @export
##' @examples
Modified: pkg/R/ancestors.R
===================================================================
--- pkg/R/ancestors.R 2014-04-09 18:30:28 UTC (rev 922)
+++ pkg/R/ancestors.R 2014-04-09 19:54:17 UTC (rev 923)
@@ -11,7 +11,7 @@
##'
##' If any supplied nodes are not found in the tree, the behavior currently
##' varies across functions.
-##'
+##' \itemize{
##' \item Invalid nodes are automatically omitted by \code{ancestors}
##' and \code{descendants}, with a warning.
##'
@@ -20,11 +20,9 @@
##'
##' \item Both \code{children} and \code{siblings} will return an empty
##' vector, again with a warning.
-##'
+##' }
##' @param phy a \linkS4class{phylo4} object (or one inheriting from
##' \linkS4class{phylo4}, e.g. a \linkS4class{phylo4d} object)
-##' @param x a \linkS4class{phylo4} object (or one inheriting from
-##' \linkS4class{phylo4}, e.g. a \linkS4class{phylo4d} object)
##' @param node either an integer corresponding to a node ID number, or a
##' character corresponding to a node label; for \code{ancestors} and
##' \code{descendants}, this may be a vector of multiple node numbers or names
@@ -36,7 +34,8 @@
##' @param include.self whether to include self in list of siblings
##' @param \dots a list of node numbers or names, or a vector of node numbers or
##' names
-##' @return \item{\code{ancestors}}{ return a named vector (or a list
+##' @return \describe{
+##' \item{\code{ancestors}}{ return a named vector (or a list
##' of such vectors in the case of multiple input nodes) of the
##' ancestors and descendants of a node}
##'
@@ -55,10 +54,11 @@
##'
##' \item{\code{siblings}}{ returns sibling nodes (children of the same
##' parent)}
-##'
+##' }
##' @seealso \code{\link[ape]{mrca}}, in the ape package, gives a list of all
##' subtrees
##' @export
+##' @rdname ancestors
##' @include phylo4-class.R
##' @include phylo4-methods.R
##' @include getNode-methods.R
@@ -91,6 +91,7 @@
##' @rdname ancestors
##' @aliases children
+##' @export
children <- function(phy,node) {
node2 <- getNode(phy,node)
r <- which(edges(phy)[,1]==node2)
@@ -99,6 +100,7 @@
##' @rdname ancestors
##' @aliases descendants
+##' @export
descendants <- function (phy, node, type=c("tips","children","all")) {
type <- match.arg(type)
@@ -162,6 +164,7 @@
##' @rdname ancestors
##' @aliases siblings
+##' @export
siblings <- function(phy, node, include.self=FALSE) {
v <- children(phy,ancestor(phy,node))
if (!include.self) v <- v[v!=getNode(phy,node)]
@@ -170,6 +173,7 @@
##' @rdname ancestors
##' @aliases siblings
+##' @export
ancestors <- function (phy, node, type=c("all","parent","ALL")) {
type <- match.arg(type)
Modified: pkg/R/checkdata.R
===================================================================
--- pkg/R/checkdata.R 2014-04-09 18:30:28 UTC (rev 922)
+++ pkg/R/checkdata.R 2014-04-09 19:54:17 UTC (rev 923)
@@ -45,6 +45,7 @@
##' @include RcppExports.R
##' @include phylo4-class.R
##' @include phylo4-methods.R
+##' @export
##' @keywords misc
checkPhylo4 <- function(object) {
ct <- checkTree(object)
Modified: pkg/R/edgeLength-methods.R
===================================================================
--- pkg/R/edgeLength-methods.R 2014-04-09 18:30:28 UTC (rev 922)
+++ pkg/R/edgeLength-methods.R 2014-04-09 19:54:17 UTC (rev 923)
@@ -21,11 +21,12 @@
##' @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
+##' @param use.names 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}.
+##' @param \dots optional arguments (none used at present).
##' @return \describe{
##'
##' \item{hasEdgeLength}{whether or not the object has edge lengths
@@ -82,17 +83,12 @@
##' @rdname edgeLength-methods
##' @aliases edgeLength
+##' @export
setGeneric("edgeLength", function(x, ...) {
standardGeneric("edgeLength")
})
##' @rdname edgeLength-methods
-##' @aliases edgeLength<-
-setGeneric("edgeLength<-", function(x, ..., value) {
- standardGeneric("edgeLength<-")
-})
-
-##' @rdname edgeLength-methods
##' @aliases edgeLength,phylo4-method
setMethod("edgeLength", signature(x="phylo4"),
function(x, node) {
@@ -108,10 +104,17 @@
return(elen)
})
+##' @rdname edgeLength-methods
+##' @aliases edgeLength<-
+##' @export
+setGeneric("edgeLength<-", function(x, use.names=TRUE, ..., value) {
+ standardGeneric("edgeLength<-")
+})
+
##' @name edgeLength<-
##' @rdname edgeLength-methods
-##' @aliases edgeLength<-,phylo4-method
-setReplaceMethod("edgeLength", signature(x="phylo4"),
+##' @aliases edgeLength<-,phylo4-method edgeLength<-,phylo4,ANY-method
+setReplaceMethod("edgeLength", signature(x="phylo4", value="ANY"),
function(x, use.names=TRUE, ..., value) {
len <- .createEdge(value, x at edge, type="lengths", use.names)
## return empty vector if all values are NA
@@ -130,6 +133,7 @@
##' @rdname edgeLength-methods
##' @aliases depthTips
+##' @export
setGeneric("depthTips", function(x) {
standardGeneric("depthTips")
})
@@ -144,6 +148,7 @@
##' @rdname edgeLength-methods
##' @aliases nodeDepth
+##' @export
setGeneric("nodeDepth", function(x, node) {
standardGeneric("nodeDepth")
})
@@ -171,6 +176,7 @@
##' @rdname edgeLength-methods
##' @aliases sumEdgeLength
+##' @export
setGeneric("sumEdgeLength", function(x, node) {
standardGeneric("sumEdgeLength")
})
@@ -193,6 +199,7 @@
##' @rdname edgeLength-methods
##' @aliases isUltrametric
+##' @export
setGeneric("isUltrametric", function(x, tol=.Machine$double.eps^.5) {
standardGeneric("isUltrametric")
})
Modified: pkg/R/getNode-methods.R
===================================================================
--- pkg/R/getNode-methods.R 2014-04-09 18:30:28 UTC (rev 922)
+++ pkg/R/getNode-methods.R 2014-04-09 19:54:17 UTC (rev 923)
@@ -31,8 +31,6 @@
##' \code{edgeId} simply returns an unnamed vector of the character IDs of all
##' edges for which the descendant node is of the specified node type.
##'
-##' @aliases getNode getEdge nodeId nodeId,phylo4-method edgeId
-##' edgeId,phylo4-method
##' @param x a \linkS4class{phylo4} object (or one inheriting from
##' \linkS4class{phylo4}, e.g. a \linkS4class{phylo4d} object)
##' @param node either an integer vector corresponding to node ID numbers, or a
@@ -57,6 +55,7 @@
##' of edge IDs, in edge matrix order}
##' @keywords misc
##' @export
+##' @rdname getNode-methods
##' @include phylo4-class.R
##' @examples
##'
@@ -150,6 +149,7 @@
##' @rdname getNode-methods
##' @aliases getEdge-methods
+##' @export
setGeneric("getEdge", function(x, node, type=c("descendant", "ancestor"),
missing=c("warn", "OK", "fail")) {
standardGeneric("getEdge")
Modified: pkg/R/internal-constructors.R
===================================================================
--- pkg/R/internal-constructors.R 2014-04-09 18:30:28 UTC (rev 922)
+++ pkg/R/internal-constructors.R 2014-04-09 19:54:17 UTC (rev 923)
@@ -3,6 +3,17 @@
## Labels constructor
#####################
+## (formerly) recursive function to have labels of constant length
+## base = a character string
+## n = number of labels
+.genlab <- function(base, n) {
+ if(n <= 0) return("")
+ s <- seq(length.out=n)
+ fw <- max(nchar(as.character(s)))
+ numstr <- formatC(s, flag="0", width=fw)
+ paste(base, numstr, sep="")
+}
+
.createLabels <- function(value, ntips, nnodes, use.names = TRUE,
type = c("all", "tip", "internal")) {
@@ -53,7 +64,8 @@
}
-.createEdge <- function(value, edgeMat, type=c("lengths", "labels"), use.names=TRUE) {
+.createEdge <- function(value, edgeMat, type=c("lengths", "labels"),
+ use.names=TRUE) {
type <- match.arg(type)
lgthRes <- nrow(edgeMat)
Modified: pkg/R/labels-methods.R
===================================================================
--- pkg/R/labels-methods.R 2014-04-09 18:30:28 UTC (rev 922)
+++ pkg/R/labels-methods.R 2014-04-09 19:54:17 UTC (rev 923)
@@ -62,7 +62,7 @@
##' \item{hasEdgeLabels}{\code{signature(object = "phylo4")}: whether tree has
##' (internal) edge labels} \item{edgeLabels}{\code{signature(object =
##' "phylo4")}: internal edge labels, ordered according to the edge matrix} }
-##' @export
+##' @exportMethod labels
##' @rdname labels-methods
##' @include phylo4-class.R phylo4-methods.R phylo4-accessors.R nodeId-methods.R
##' @author Ben Bolker, Peter Cowan, Steve Kembel, Francois Michonneau
@@ -116,6 +116,7 @@
##' @rdname labels-methods
##' @aliases labels<-
+##' @export
setGeneric("labels<-",
function(x, type, use.names, ..., value) {
standardGeneric("labels<-")
@@ -162,6 +163,7 @@
##' @rdname labels-methods
##' @aliases hasDuplicatedLabels
+##' @export
setGeneric("hasDuplicatedLabels",
function(x, type) {
standardGeneric("hasDuplicatedLabels")
@@ -183,6 +185,7 @@
##' @rdname labels-methods
##' @aliases hasNodeLabels
+##' @export
setGeneric("hasNodeLabels", function(x) {
standardGeneric("hasNodeLabels")
})
@@ -198,6 +201,7 @@
##' @rdname labels-methods
##' @aliases nodeLabels
+##' @export
setGeneric("nodeLabels", function(x) {
standardGeneric("nodeLabels")
})
@@ -211,6 +215,7 @@
##' @rdname labels-methods
##' @aliases nodeLabels<-
+##' @export
setGeneric("nodeLabels<-",
function(x, ..., value) {
standardGeneric("nodeLabels<-")
@@ -230,6 +235,7 @@
##' @rdname labels-methods
##' @aliases tipLabels
+##' @export
setGeneric("tipLabels", function(x) {
standardGeneric("tipLabels")
})
@@ -243,6 +249,7 @@
##' @rdname labels-methods
##' @aliases tipLabels<-
+##' @export
setGeneric("tipLabels<-",
function(x, ..., value) {
standardGeneric("tipLabels<-")
@@ -263,6 +270,7 @@
##' @rdname labels-methods
##' @aliases hasEdgeLabels
+##' @export
setGeneric("hasEdgeLabels", function(x) {
standardGeneric("hasEdgeLabels")
})
@@ -278,6 +286,7 @@
##' @rdname labels-methods
##' @aliases edgeLabels
+##' @export
setGeneric("edgeLabels", function(x) {
standardGeneric("edgeLabels")
})
@@ -296,6 +305,7 @@
##' @rdname labels-methods
##' @aliases edgeLabels<-
+##' @export
setGeneric("edgeLabels<-",
function(x, ..., value) {
standardGeneric("edgeLabels<-")
Modified: pkg/R/multiphylo4-class.R
===================================================================
--- pkg/R/multiphylo4-class.R 2014-04-09 18:30:28 UTC (rev 922)
+++ pkg/R/multiphylo4-class.R 2014-04-09 19:54:17 UTC (rev 923)
@@ -10,7 +10,7 @@
##' @aliases multiPhylo-class multiPhylo4-class multiPhylo4d-class tbind
##' @docType class
##' @keywords classes
-##' @export
+## @export
setClass("multiPhylo4", representation(phylolist = "list",
tree.names = "character"), prototype = list(phylolist = list(),
tree.names = character(0)))
Modified: pkg/R/nodeId-methods.R
===================================================================
--- pkg/R/nodeId-methods.R 2014-04-09 18:30:28 UTC (rev 922)
+++ pkg/R/nodeId-methods.R 2014-04-09 19:54:17 UTC (rev 923)
@@ -21,7 +21,7 @@
##' @include phylo4-class.R phylo4-methods.R phylo4-accessors.R root-methods.R
##' @examples
##' data(geospiza)
-##' identical(nodeId(geopsiza, "tip"), 1:nTips(geospiza))
+##' identical(nodeId(geospiza, "tip"), 1:nTips(geospiza))
##' nodeId(geospiza, "internal")
##' edgeId(geospiza, "internal")
##' nodeId(geospiza, "root")
@@ -45,7 +45,15 @@
## all nodes appear at least once in the edge matrix
## twice slower: all = unique(as.vector(E)[as.vector(E) != 0]),
## but maybe should be used if tree is not "normal"
- all = getAllNodesFast(x at edge, isRooted(x)),
+ all = {
+ if (isRooted(x)) {
+ res <- getAllNodesFast(x at edge)[-1]
+ }
+ else {
+ res <- getAllNodesFast(x at edge)
+ }
+ res
+ },
## tips are nodes that do not appear in the ancestor column
## three times slower: setdiff(E[, 2], E[, 1]),
tip = tipsFast(x at edge[,1]),
@@ -53,7 +61,7 @@
## about 0.5 faster than: setdiff(getAllNodesFast(x at edge, isRooted(x)), tipsFast(x at edge[,1])),
internal = unique(E[E[, 1] != 0, 1]),
## roots are nodes that have NA as ancestor
- root = if (!isRooted(x)) NA else unname(E[E[, 1] == 0, 2]))
+ root = if (!isRooted(x)) return(NA) else unname(E[E[, 1] == 0, 2]))
return(sort(nid))
@@ -63,6 +71,7 @@
##' @rdname nodeId-methods
##' @aliases edgeId
+##' @export
setGeneric("edgeId", function(x, type=c("all", "tip", "internal",
"root")) {
standardGeneric("edgeId")
Modified: pkg/R/pdata.R
===================================================================
--- pkg/R/pdata.R 2014-04-09 18:30:28 UTC (rev 922)
+++ pkg/R/pdata.R 2014-04-09 19:54:17 UTC (rev 923)
@@ -16,6 +16,7 @@
##' \code{new("pdata", ...)}.
##' @author Ben Bolker
##' @keywords classes
+#### @export
setClass("pdata", representation(data="data.frame",
type="factor",
comment="character",
@@ -38,7 +39,7 @@
##' same length as \code{ncol(data)}
##' @param comment a character vector, the same length as \code{ncol(data)}
##' @param metadata an arbitrary list
-##' @param object an object of class \code{pdata}
+## @param object an object of class \code{pdata}
##' @return An object of class \code{pdata}
##' @author Ben Bolker
##' @seealso \linkS4class{pdata}
@@ -56,6 +57,7 @@
obj
}
+
check_pdata <- function(object) {
nvar <- ncol(object at data)
badlevels <- levels(object at type)[!levels(object at type) %in% ptypes]
@@ -75,16 +77,21 @@
xd2
})
+#### @exportMethod [<-
+setGeneric("[<-")
+
setMethod("[<-","pdata",function(x,i, j,...,drop=FALSE,value) {
"[<-"(x at data,i,j,...,drop=drop,value)
})
+### @exportMethod [[
setGeneric("[[")
setMethod("[[","pdata",
function(x,i,j,...,exact=NA) {
x at data[[i,j,...,exact=exact]]
})
+#### @exportMethod [[<-
setGeneric("[[<-")
setMethod("[[<-","pdata",
function(x,i,j,...,exact=NA,value) {
Modified: pkg/R/phylo4-accessors.R
===================================================================
--- pkg/R/phylo4-accessors.R 2014-04-09 18:30:28 UTC (rev 922)
+++ pkg/R/phylo4-accessors.R 2014-04-09 19:54:17 UTC (rev 923)
@@ -11,6 +11,7 @@
##' @docType methods
##' @export
##' @include phylo4-class.R phylo4-methods.R
+##' @include oldclasses-class.R
##' @rdname nTips-methods
setGeneric("nTips", function(x) {
standardGeneric("nTips")
@@ -38,6 +39,7 @@
##' @rdname nTips-methods
##' @aliases nNodes
+##' @export
setGeneric("nNodes", function(x) {
standardGeneric("nNodes")
})
@@ -55,6 +57,7 @@
##' @rdname nTips-methods
##' @aliases nEdges
+##' @export
setGeneric("nEdges", function(x) {
standardGeneric("nEdges")
})
@@ -71,12 +74,16 @@
### Edge accessors
#########################################################
-##' edges accessors
+##' Edges accessors
##'
-##' @param x A \code{phylo4} or \code{phylo4d} object.
+##' Access or modify information about the edges.
##'
+##' @param x a \code{phylo4} or \code{phylo4d} object.
+##' @param drop.root logical (default FALSE), should the edge
+##' connecting the root be included in the edge matrix?
+##' @param \dots Optional arguments used by specific methods. (None
+##' used at present).
##' @return \describe{
-##'
##' \item{\code{edges}}{returns the edge matrix that represent the
##' ancestor-descendant relationships among the nodes of the tree.}
##'
@@ -87,16 +94,15 @@
##' 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
+##' \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.
+##' 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)
+##' edgeOrder(geospiza)
##' geoPost <- reorder(geospiza, "postorder")
##' edgeOrder(geoPost)
##' ## with a binary tree this should always be true
@@ -112,7 +118,7 @@
##' @rdname edges-accessors
##' @aliases edges,phylo4-method
setMethod("edges", signature(x="phylo4"),
- function(x, drop.root=FALSE, ...) {
+ function(x, drop.root=FALSE) {
e <- x at edge
if (drop.root) e <- e[e[, 1] != 0, ]
e
@@ -122,6 +128,7 @@
##' @rdname edges-accessors
##' @aliases edgeOrder
+##' @export
setGeneric("edgeOrder", function(x, ...) {
standardGeneric("edgeOrder")
})
@@ -129,7 +136,7 @@
##' @rdname edges-accessors
##' @aliases edgeOrder,phylo4-method
setMethod("edgeOrder", signature(x="phylo4"),
- function(x, ...) {
+ function(x) {
x at order
})
@@ -137,6 +144,7 @@
##' @rdname edges-accessors
##' @aliases internalEdges
+##' @export
setGeneric("internalEdges", function(x) {
standardGeneric("internalEdges")
})
@@ -154,6 +162,7 @@
##' @rdname edges-accessors
##' @aliases terminalEdges
+##' @export
setGeneric("terminalEdges", function(x) {
standardGeneric("terminalEdges")
})
Modified: pkg/R/phylo4-class.R
===================================================================
--- pkg/R/phylo4-class.R 2014-04-09 18:30:28 UTC (rev 922)
+++ pkg/R/phylo4-class.R 2014-04-09 19:54:17 UTC (rev 923)
@@ -2,9 +2,7 @@
##'
##' Classes for phylogenetic trees
##'
-##'
##' @name phylo4-class
-##' @aliases phylo4_orderings phylo-class phylo4-class
##' @docType class
##' @section Objects from the Class: Phylogenetic tree objects can be created by
##' calls to the \code{\link{phylo4}} constructor function. Translation
Modified: pkg/R/phylo4-methods.R
===================================================================
--- pkg/R/phylo4-methods.R 2014-04-09 18:30:28 UTC (rev 922)
+++ pkg/R/phylo4-methods.R 2014-04-09 19:54:17 UTC (rev 923)
@@ -40,6 +40,7 @@
##' (the default) or "drop" node labels. This argument is useful if the
##' \code{phylo} object has non-unique node labels.
##' @param annote any additional annotation data to be passed to the new object
+##' @param \dots optional arguments (none used at present).
##' @note Translation functions are available from many valid tree formats. See
##' \link{coerce-methods}.
##' @author phylobase team
@@ -48,7 +49,9 @@
##' the validity of \code{phylo4} objects. See also the \code{\link{phylo4d}}
##' constructor, and \linkS4class{phylo4d} class.
##' @export
-##' @include internal-constructors.R phylo4-class.R
+##' @aliases phylo4
+##' @rdname phylo4-methods
+##' @include internal-constructors.R phylo4-class.R oldclasses-class.R
##' @examples
##'
##' # a three species tree:
@@ -73,8 +76,12 @@
##'
setGeneric("phylo4", function(x, ...) { standardGeneric("phylo4")} )
-# ape orderings should be allowed for so we can import trees from ape e.g. during subsetting
-phylo4_orderings <- c("unknown", "preorder", "postorder", "pruningwise", "cladewise")
+## ape orderings should be allowed for so we can import trees from ape
+## e.g. during subsetting
+##' @rdname phylo4-methods
+##' @aliases phylo4_orderings
+phylo4_orderings <- c("unknown", "preorder", "postorder",
+ "pruningwise", "cladewise")
##' @rdname phylo4-methods
##' @aliases phylo4,matrix-method
@@ -85,7 +92,7 @@
## edge
edge <- x
mode(edge) <- "integer"
- #if(any(is.na(edge))) stop("NA are not allowed in edge matrix") ## taken care by checkTree
+
if(ncol(edge) > 2)
warning("The edge matrix has more than two columns, ",
"only the first two columns are considered.")
@@ -102,14 +109,16 @@
nnodes <- nNodes(res)
## edge.length (drop elements if all are NA but keep the vector named)
- edge.length <- .createEdge(value=edge.length, edgeMat=edge, type="lengths", use.names=FALSE)
+ edge.length <- .createEdge(value=edge.length, edgeMat=edge, type="lengths",
+ use.names=FALSE)
if (all(is.na(edge.length))) {
edge.length <- numeric()
attributes(edge.length) <- list(names=character(0))
}
## edge.label (drop NA elements)
- edge.label <- .createEdge(value=edge.label, edgeMat=edge, type="labels", use.names=FALSE)
+ edge.label <- .createEdge(value=edge.label, edgeMat=edge, type="labels",
+ use.names=FALSE)
edge.label <- edge.label[!is.na(edge.label)]
## tip.label (leave NA elements; let checkTree complain about it)
Modified: pkg/R/phylo4d-accessors.R
===================================================================
--- pkg/R/phylo4d-accessors.R 2014-04-09 18:30:28 UTC (rev 922)
+++ pkg/R/phylo4d-accessors.R 2014-04-09 19:54:17 UTC (rev 923)
@@ -2,20 +2,28 @@
##' Tests for presence of data associated with trees stored as phylo4d objects
##'
##' Methods that test for the presence of data associated with trees stored as
-##' phylo4d objects.
+##' \code{phylo4d} objects.
##'
-##' The outcome of the test is based on row names of the data frame stored in
-##' \code{data}. If there are no rows having row names from the set
-##' \code{nodeId(x, "tip")}, then \code{hasTipData} returns FALSE. Likewise, if
-##' there are no rows having row names from the set \code{nodeId(x,
-##' "internal")}, then \code{hasNodeData} returns FALSE.
+##' \code{nData} tests for the presence of data associated with the object.
+##'
+##' \code{hasTipData} and \code{hasNodeData} tests for the presence of
+##' data associated with the tips and the internal nodes
+##' respectively. The outcome of the test is based on row names of the
+##' data frame stored in the \code{data} slot. If no rows have names
+##' from the set \code{nodeId(x, "tip")}, then \code{hasTipData}
+##' returns FALSE. Likewise, if no rows have names from the set
+##' \code{nodeId(x, "internal")}, then \code{hasNodeData} returns
+##' FALSE.
##'
-##' @aliases hasNodeData hasNodeData-methods hasNodeData,phylo4d-method
-##' hasTipData hasTipData-methods hasTipData,phylo4d-method
-##' @param x a phylo4d object
-##' @return \item{list("logical")}{return \code{TRUE} or \code{FALSE} depending
-##' whether data are associated with the tree (i.e., the slots \code{tip.data}
-##' or \code{node.data} are not empty)}
+##' @param x a \code{phylo4d} object
+##' @return \describe{
+##'
+##' \item{\code{nData}}{returns the number of datasets (i.e.,
+##' columns) associated with the object.}
+##'
+##' \item{\code{hasTipData}, \code{hasNodeData}}{return \code{TRUE}
+##' or \code{FALSE} depending whether data associated with the
+##' tree are associated with either tips or internal nodes respectively.}}
##' @section Methods: \describe{ \item{hasNodeData}{\code{signature(object =
##' "phylo4d")}: whether tree has internal node data}
##' \item{hasTipData}{\code{signature(object = "phylo4d")}: whether tree has
@@ -23,13 +31,15 @@
##' @author Ben Bolker, Thibault Jombart, Francois Michonneau
##' @seealso \code{\link{phylo4d}} constructor and \code{\linkS4class{phylo4d}}
##' class.
-##' @name hasTipData
+##' @rdname phylo4d-accessors
+##' @aliases hasTipData
##' @keywords methods
##' @docType methods
-##' @include phylo4d-class.R
+##' @include phylo4d-class.R phylo4d-methods.R
##' @export
##' @examples
##' data(geospiza)
+##' nData(geospiza) ## 5
##' hasTipData(geospiza) ## TRUE
##' hasNodeData(geospiza) ## FALSE
##'
@@ -37,24 +47,36 @@
standardGeneric("hasTipData")
})
-##' @name hasTipData-methods
-##' @rdname hasTipData
+##' @rdname phylo4d-accessors
##' @aliases hasTipData-method,phylo4d-method
setMethod("hasTipData", signature(x="phylo4d"),
function(x) {
ncol(tdata(x, type="tip", empty.columns=FALSE)) > 0
})
-##' @rdname hasTipData
+##' @rdname phylo4d-accessors
##' @aliases hasNodeData-methods
+##' @export
setGeneric("hasNodeData", function(x) {
standardGeneric("hasNodeData")
})
-##' @name hasNodeData-methods
-##' @rdname hasTipData
+##' @rdname phylo4d-accessors
##' @aliases hasNodeData,phylo4d-method
setMethod("hasNodeData", signature(x="phylo4d"),
function(x) {
ncol(tdata(x, type="internal", empty.columns=FALSE)) > 0
})
+
+##' @rdname phylo4d-accessors
+##' @aliases nData
+##' @export
+setGeneric("nData", function(x) {
+ standardGeneric("nData")
+})
+
+##' @rdname phylo4d-accessors
+##' @aliases nData,phylo4d-method
+setMethod("nData", signature(x="phylo4d"), function(x) {
+ ncol(x at data)
+})
Modified: pkg/R/phylo4d-methods.R
===================================================================
--- pkg/R/phylo4d-methods.R 2014-04-09 18:30:28 UTC (rev 922)
+++ pkg/R/phylo4d-methods.R 2014-04-09 19:54:17 UTC (rev 923)
@@ -95,6 +95,7 @@
##' @docType methods
##' @rdname phylo4d-methods
##' @include phylo4d-class.R
+##' @include oldclasses-class.R
##' @examples
##'
##' treeOwls <- "((Strix_aluco:4.2,Asio_otus:4.2):3.1,Athene_noctua:7.3);"
Modified: pkg/R/phylobase-package.R
===================================================================
--- pkg/R/phylobase-package.R 2014-04-09 18:30:28 UTC (rev 922)
+++ pkg/R/phylobase-package.R 2014-04-09 19:54:17 UTC (rev 923)
@@ -26,7 +26,7 @@
##' between two nodes in your tree
##'
##' \item robust functions to import data from NEXUS and Newick files
-##' using the NEXUS Class Library (\url{http://ncl.sourceforge.net/})
+##' using the NEXUS Class Library (\url{http://ncl.sourceforge.net/})
##' }
##'
##' @section History:
@@ -72,17 +72,17 @@
##' @importFrom utils head tail
##' @importFrom ade4 newick2phylog
##'
-##'
-##' @exportMethod print head tail reorder plot summary
-##' @exportMethod phylo4 phylo4d
-##' @exportMethod edges edgeId hasEdgeLength edgeLength edgeLength<- sumEdgeLength edgeOrder
-##' @exportMethod isRooted rootNode rootNode<-
-##' @exportMethod nodeId nodeType nodeDepth
-##' @exportMethod isUltrametric
-##' @exportMethod subset prune [
-##' @exportMethod [<- [[ [[<-
-##' @exportMethod labels labels<- nodeLabels nodeLabels<- tipLabels tipLabels<- edgeLabels edgeLabels<-
-##' @exportMethod hasNodeLabels hasEdgeLabels hasDuplicatedLabels
+##'
+## exportMethod should only be used for generics defined outside the package!
+## @exportMethod print head tail reorder plot summary
+## @exportMethod phylo4 phylo4d
+## @exportMethod edges edgeId hasEdgeLength edgeLength edgeLength<- sumEdgeLength edgeOrder
+## @exportMethod isRooted rootNode rootNode<-
+## @exportMethod isUltrametric
+## @exportMethod subset prune [
+## @exportMethod [<- [[ [[<-
+## @exportMethod labels labels<- nodeLabels nodeLabels<- tipLabels tipLabels<- edgeLabels edgeLabels<-
+## @exportMethod hasNodeLabels hasEdgeLabels hasDuplicatedLabels
NULL
Modified: pkg/R/phylobase.options.R
===================================================================
--- pkg/R/phylobase.options.R 2014-04-09 18:30:28 UTC (rev 922)
+++ pkg/R/phylobase.options.R 2014-04-09 19:54:17 UTC (rev 923)
@@ -21,7 +21,7 @@
##' # subsequent trees with polytomies will fail the validity check
##' }
##'
-##' @export phylobase.options
+##' @export
phylobase.options <- function (...) {
if (nargs() == 0) return(.phylobase.Options)
current <- .phylobase.Options
Modified: pkg/R/phylomats-class.R
===================================================================
--- pkg/R/phylomats-class.R 2014-04-09 18:30:28 UTC (rev 922)
+++ pkg/R/phylomats-class.R 2014-04-09 19:54:17 UTC (rev 923)
@@ -19,6 +19,7 @@
##' @author Ben Bolker
##' @rdname phylomat-class
##' @keywords classes
+##' @export
##' @examples
##'
##' tree.owls <- ape::read.tree(text="(((Strix_aluco:4.2,Asio_otus:4.2):3.1,Athene_noctua:7.3):6.3,Tyto_alba:13.5);")
@@ -58,12 +59,14 @@
edge.label=from at edge.label,
order=from at order)
}
+##' @name phylomat-setAs
##' @rdname phylomat-class
##' @aliases setAs,phylo,phylo4vcov-method
setAs("phylo4","phylo4vcov",
function(from,to) {
as_phylo4vcov(from)})
+##' @name phylomat-setAs
##' @rdname phylomat-class
##' @aliases setAs,phylo4vcov,phylo4-method
setAs("phylo4vcov","phylo4",
Modified: pkg/R/print-methods.R
===================================================================
--- pkg/R/print-methods.R 2014-04-09 18:30:28 UTC (rev 922)
+++ pkg/R/print-methods.R 2014-04-09 19:54:17 UTC (rev 923)
@@ -47,13 +47,13 @@
##' print(treedata)
##'
##'
-##' @export
##' @aliases print
##' @rdname print-methods
setGeneric("print")
##' @rdname print-methods
##' @aliases print,phylo4-method
+##' @exportMethod print
setMethod("print", signature(x="phylo4"),
function(x, edgeOrder=c("pretty", "real"),
printall=TRUE) {
@@ -74,6 +74,7 @@
##' @rdname print-methods
##' @aliases show
+##' @exportMethod show
setGeneric("show")
##' @rdname print-methods
@@ -83,6 +84,7 @@
##' @rdname print-methods
##' @aliases names
+##' @exportMethod names
setGeneric("names")
##' @rdname print-methods
@@ -95,6 +97,7 @@
##' @rdname print-methods
##' @aliases head
+##' @exportMethod head
setGeneric("head")
##' @rdname print-methods
@@ -105,8 +108,12 @@
})
##' @rdname print-methods
+##' @aliases tail
+##' @exportMethod tail
+setGeneric("tail")
+
+##' @rdname print-methods
##' @aliases tail,phylo4-method
-setGeneric("tail")
setMethod("tail", signature(x="phylo4"),
function(x, n=20) {
tail(as(x, "data.frame"), n=n)
Modified: pkg/R/readNCL.R
===================================================================
--- pkg/R/readNCL.R 2014-04-09 18:30:28 UTC (rev 922)
+++ pkg/R/readNCL.R 2014-04-09 19:54:17 UTC (rev 923)
@@ -3,96 +3,111 @@
### - readNexus (wrapper for readNCL importing Nexus files)
### - readNewick (wrapper for readNCL importing Newick files)
-##' Create a phylo4, phylo4d or data.frame object from a Nexus or a Newick file
+##' Create a phylo4, phylo4d or data.frame object from a Nexus or a
+##' Newick file
##'
##' \code{readNexus} reads a Nexus file and outputs a \code{phylo4} or
##' \code{phylo4d} or \code{data.frame} object.
##'
-##' \code{readNewick} reads a Newick file and outputs a \code{phylo4} or
-##' \code{phylo4d} object.
+##' \code{readNewick} reads a Newick file and outputs a \code{phylo4}
+##' or \code{phylo4d} object.
##'
-##' \code{readNexus} extracts data held in a Nexus file, specifically from DATA,
-##' CHARACTER or TREES blocks present in the file. The \code{type} argument
-##' specifies which of these is returned: \describe{ \item{data}{will only
-##' return a \code{data.frame} of the contents of all DATA and CHARACTER
-##' blocks.} \item{tree}{will only return a \code{phylo4} object of the contents
-##' of the TREES block.} \item{all}{if only data or a tree are present in the
-##' file, this option will act as the options above, returning either a
-##' \code{data.frame} or a \code{phylo4} object respectively. If both are
-##' present then a \code{phylo4d} object is returned containing both.} } The
-##' function returns \code{NULL} if the \code{type} of data requested is not
-##' present in the file, or if neither data nor tree blocks are present.
+##' \code{readNexus} extracts data held in a Nexus file, specifically
+##' from DATA, CHARACTER or TREES blocks present in the file. The
+##' \code{type} argument specifies which of these is returned:
+##' \describe{ \item{data}{will only return a \code{data.frame} of the
+##' contents of all DATA and CHARACTER blocks.} \item{tree}{will only
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/phylobase -r 923
More information about the Phylobase-commits
mailing list