[Phylobase-commits] r286 - in pkg: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Sep 1 22:43:02 CEST 2008
Author: francois
Date: 2008-09-01 22:43:02 +0200 (Mon, 01 Sep 2008)
New Revision: 286
Modified:
pkg/DESCRIPTION
pkg/R/class-phylo4d.R
pkg/man/phylo4d.Rd
Log:
Added possibility for 'phylo4d' constructor to accept several type (tip, node and all) of data at the same time
Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION 2008-08-26 13:13:35 UTC (rev 285)
+++ pkg/DESCRIPTION 2008-09-01 20:43:02 UTC (rev 286)
@@ -1,7 +1,7 @@
Package: phylobase
Type: Package
Title: Base package for phylogenetic structures and comparative data
-Version: 0.3-1
+Version: 0.4
Date: 2008-07-27
Depends: methods, ape(>= 2.1)
Suggests: ade4, MASS
@@ -10,4 +10,5 @@
Description: Provides a base S4 class for comparative methods, incorporating one or more trees and trait data
License: GPL
Collate: phylo4.R checkdata.R class-multiphylo4.R class-oldclasses.R class-phylo4.R class-phylo4d.R methods-multiphylo4.R methods-phylo4.R methods-phylo4d.R setAs-Methods.R pdata.R subset.R prune.R plot.R identify.R treestruc.R treewalk.R ReadWithNCL.R tbind.R zzz.R
+Encoding: UTF-8
URL: http://phylobase.R-forge.R-project.org
Modified: pkg/R/class-phylo4d.R
===================================================================
--- pkg/R/class-phylo4d.R 2008-08-26 13:13:35 UTC (rev 285)
+++ pkg/R/class-phylo4d.R 2008-09-01 20:43:02 UTC (rev 286)
@@ -11,14 +11,14 @@
validity = function(object) {
## FIXME: finish this by intercepting FALSE, char string, etc.
check1 <- check_data(object)
- check2 <- check_phylo4(object)
- },
+ check2 <- check_phylo4(object)
+ },
contains="phylo4")
######################
## phylo4d constructor
######################
-## TEST ME
+## TEST ME
## '...' recognized args for data are tipdata and nodedata.
## other recognized options are those known by the phylo4 constructor
##
@@ -27,50 +27,93 @@
setGeneric("phylo4d", function(x, ...) { standardGeneric("phylo4d")} )
## first arg is a phylo4
-setMethod("phylo4d", c("phylo4"), function(x, tip.data=NULL, node.data=NULL, all.data=NULL, ...){
+setMethod("phylo4d", c("phylo4"),
+ function(x, tip.data = NULL, node.data = NULL, all.data = NULL,
+ merge.tip.node = TRUE, ...) {
- if(is.character(checkval <- check_phylo4(x))) stop(checkval)
+ classData <- function(someData) {
+ if(!is.null(someData)) {
+ if(is.vector(someData)) someData <- as.data.frame(someData)
+ if(!is.data.frame(someData)) {
+ nmSomedata <- deparseSubstitute(someData)
+ return(paste(nmSomeData, "must be a vector or a data frame"))
+ }
+ return(TRUE)
+ }
+ else return(TRUE)
+ }
- res <- new("phylo4d")
- res at edge <- x at edge
- res at edge.length <- x at edge.length
- res at Nnode <- x at Nnode
- res at tip.label <- x at tip.label
- res at node.label <- x at node.label
- res at edge.label <- x at edge.label
- res at root.edge <- x at root.edge
+ if(is.character(checkval <- check_phylo4(x))) stop(checkval)
-### handle a which argument
- which.dat <- match.arg(list(...)$"which", c("tip","node","all"))
+ if(is.character(checkClass <- classData(all.data))) stop(checkClass)
+ if(is.character(checkClass <- classData(tip.data))) stop(checkClass)
+ if(is.character(checkClass <- classData(node.data))) stop(checkClass)
- ## handle data
- if(all(is.null(c(tip.data, node.data, all.data)))) {
- stop("no data provided; please use phylo4 class")
- }
+ res <- new("phylo4d")
+ res at edge <- x at edge
+ res at edge.length <- x at edge.length
+ res at Nnode <- x at Nnode
+ res at tip.label <- x at tip.label
+ res at node.label <- x at node.label
+ res at edge.label <- x at edge.label
+ res at root.edge <- x at root.edge
- ## convert vector to data.frames
- if(is.vector(tip.data)) tip.data <- as.data.frame(tip.data)
- if(is.vector(node.data)) node.data <- as.data.frame(node.data)
- if(is.vector(all.data)) all.data <- as.data.frame(all.data)
+ if(!is.null(all.data)) {
+ tmpData <- all.data
+ if(!is.null(tip.data)) {
+ emptyNodeData <- array(, dim = c(nNodes(x), ncol(tip.data)),
+ dimnames = list(nodeLabels(x), colnames(tip.data)))
+ tmpTipData <- rbind(tip.data, emptyNodeData)
+ ## TODO? - have a test on names between
+ tmpTipData <- tmpTipData[match(rownames(all.data), rownames(tmpTipData)) ,, drop = FALSE]
+ tmpData <- cbind(all.data, tmpTipData)
+ }
+ if(!is.null(node.data)) {
+ emptyTipData <- array(, dim = c(nTips(x), ncol(node.data)),
+ dimnames = list(labels(x), colnames(node.data)))
+ tmpNodeData <- rbind(emptyTipData, node.data)
+ ## TODO? - add test
+ tmpNodeData <- tmpNodeData[match(rownames(all.data), rownames(tmpNodeData)) ,, drop = FALSE]
+ tmpData <- cbind(tmpData, tmpNodeData)
- if(!is.null(all.data)){
- if(!is.data.frame(all.data)) stop("all.data must be a data.frame")
- tip.data <- all.data[1:nTips(x) , , drop=FALSE]
- node.data <- all.data[-(1:nTips(x)) , , drop=FALSE]
- }
+ }
+ res at tip.data <- tmpData[1:nTips(x) ,, drop = FALSE]
+ res at node.data <- tmpData[-(1:nTips(x)) ,, drop = FALSE]
+ }
- ## now at least one data.frame is provided
- if(is.null(tip.data)) tip.data <- data.frame(NULL)
- if(is.null(node.data)) node.data <- data.frame(NULL)
- if(!is.data.frame(tip.data)) stop("tip.data must be a data.frame")
- if(!is.data.frame(node.data)) stop("node.data must be a data.frame")
+ else {
+ if((!is.null(tip.data) && (!is.null(node.data)))) {
+ if(identical(colnames(tip.data), colnames(node.data)) && merge.tip.node) {
+ tmpAllData <- rbind(tip.data, node.data)
+ res at tip.data <- tmpAllData[1:nTips(x) ,, drop = FALSE]
+ res at node.data <- tmpAllData[-(1:nTips(x)) ,, drop = FALSE]
+ }
+ else {
+ emptyTipData <- array(, dim = c(nTips(x), ncol(node.data)),
+ dimnames = list(labels(x), colnames(node.data)))
+ emptyNodeData <- array(, dim = c(nNodes(x), ncol(tip.data)),
+ dimnames = list(nodeLabels(x), colnames(tip.data)))
+ tmpTipData <- rbind(tip.data, emptyNodeData)
+ tmpNodeData <- rbind(emptyTipData, node.data)
+ tmpData <- cbind(tmpTipData, tmpNodeData)
+ res at tip.data <- tmpData[1:nTips(x) ,, drop = FALSE]
+ res at node.data <- tmpData[-(1:nTips(x)) ,, drop = FALSE]
+ }
+ }
+ else {
+ ## at this point provide NULL data frame for empty arguments
+ if(is.null(tip.data)) tip.data <- data.frame(NULL)
+ if(is.null(node.data)) node.data <- data.frame(NULL)
- res at tip.data <- tip.data
- res at node.data <- node.data
+ res at tip.data <- tip.data
+ res at node.data <- node.data
+ }
+ }
- check_data(res, ...)
- res <- attach_data(res,...)
- return(res)
+ check_data(res, ...)
+ res <- attach_data(res,...)
+ return(res)
+
})
## first arg is a matrix of edges
@@ -86,3 +129,9 @@
res <- phylo4d(tree, tip.data, node.data, all.data, ...)
return(res)
})
+
+### first arg is a phylo4d
+setMethod("phylo4d", c("phylo4d"), function(x, ...) {
+ stop("Your object is already a phylo4d object. If you want to modify the data attached to it look help for tdata()<-")
+ })
+
Modified: pkg/man/phylo4d.Rd
===================================================================
--- pkg/man/phylo4d.Rd 2008-08-26 13:13:35 UTC (rev 285)
+++ pkg/man/phylo4d.Rd 2008-09-01 20:43:02 UTC (rev 286)
@@ -8,50 +8,75 @@
\title{Combine a phylogenetic tree with data}
\description{
\code{phylo4d} is a generic constructor which merges a phylogenetic tree with
- a data frame to create a combined object of class \code{phylo4d}
+ data frames to create a combined object of class \code{phylo4d}
}
\section{Methods}{
\describe{
-\item{x = "phylo4"}{merges a tree of class \code{phylo4} with a
- data.frame into a \code{phylo4d} object}
+ \item{x = "phylo4"}{merges a tree of class \code{phylo4} with a
+ data.frame into a \code{phylo4d} object}
-\item{x = "matrix"}{merges a matrix of tree edges similar to the edge
- slot of a \code{phylo4} object (or to \$edge of a \code{phylo} object) with a
- data.frame into a \code{phylo4d} object}
+ \item{x = "matrix"}{merges a matrix of tree edges similar to the edge
+ slot of a \code{phylo4} object (or to \$edge of a \code{phylo} object) with a
+ data.frame into a \code{phylo4d} object}
-\item{x = "phylo"}{merges a tree of class \code{phylo} with a
- data.frame into a \code{phylo4d} object }
- }
- }
- \usage{
-\S4method{phylo4d}{phylo4}(x, tip.data = NULL, node.data = NULL,
- all.data = NULL,...)
-\S4method{phylo4d}{phylo}(x, tip.data = NULL, node.data = NULL,
- all.data = NULL,...)
-\S4method{phylo4d}{matrix}(x, tip.data = NULL, node.data = NULL,
- all.data = NULL,...)
+ \item{x = "phylo"}{merges a tree of class \code{phylo} with a
+ data.frame into a \code{phylo4d} object }
+ }}
+
+\usage{
+ \S4method{phylo4d}{phylo4}(x, tip.data = NULL, node.data = NULL,
+ all.data = NULL, merge.tip.node = TRUE, ...)
+ \S4method{phylo4d}{phylo}(x, tip.data = NULL, node.data = NULL,
+ all.data = NULL, merge.tip.node = TRUE, ...)
+ \S4method{phylo4d}{matrix}(x, tip.data = NULL, node.data = NULL,
+ all.data = NULL, merge.tip.node = TRUE, ...)
}
+
\arguments{
\item{x}{an object of class \code{phylo4}, \code{phylo} or a matrix of
edges (see above)}
-\item{tip.data}{a data frame for tips data}
-\item{node.data}{a data frame for nodes data}
-\item{all.data}{a data frame for all (i.e. tips and nodes) data. In such
- case, first rows should correspond to tips, last rows to nodes.}
-\item{\dots}{further arguments to be passed to other methods. Used to
- control the validity checking of the created object (see \code{\link{check_data}}).}
+ \item{tip.data}{a data frame for tips data}
+ \item{node.data}{a data frame for nodes data}
+ \item{all.data}{a data frame for all (i.e. tips and nodes) data. In such
+ case, first rows should correspond to tips, last rows to nodes.}
+ \item{merge.tip.node}{if both \code{tip.data} and \code{node.data} are
+ provided, it determines if they should be merged as a single
+ trait. This argument is evaluated only if both \code{tip.data} and
+ \code{node.data} have identical column names.}
+ \item{\dots}{further arguments to be passed to other methods. Used to
+ control the validity checking of the created object (see \code{\link{check_data}}).}
}
+
+\details{
+ You can provide several data frames to define traits associated with
+ tips and/or nodes. If you provide \code{all.data} and \code{tip.data}
+ or \code{node.data}, row names of the data frames will be matched
+ (\code{all.data} names are matched against \code{tip.data} and/or
+ \code{node.data}). This is done independently of the labels of the tree
+ (and also of the value of the arguments \code{use.tip.names} and
+ \code{use.node.names}). This means that you need to be consistent
+ with the row names of your data frames. It is good practice to use tip
+ and node labels when you merge data with a tree.
+ If \code{all.data} is provided and tip and node names are not being
+ used, then the first part of the data frame will be tips data and the
+ second part will be nodes data.
+}
+
\value{
An object of class \linkS4class{phylo4d}.
}
+
\seealso{
-\code{\link{coerce-methods}} for translation functions. The \linkS4class{phylo4d} class, the \code{\link{check_data}}
- function to check the validity of \code{phylo4d} objects; \linkS4class{phylo4} class and \link{phylo4} constructor.}
-\author{Ben Bolker, Thibaut Jombart, Steve Kembel}
+\code{\link{coerce-methods}} for translation functions. The
+ \linkS4class{phylo4d} class, the \code{\link{check_data}}
+ function to check the validity of \code{phylo4d} objects;
+ \linkS4class{phylo4} class and \link{phylo4} constructor.}
+
+\author{Ben Bolker, Thibaut Jombart, Steve Kembel, \enc{François}{Francois} Michonneau}
\note{
- Checking on matches will be done by the validity checker
- (label matches between data and tree tips, number of rows
- of data vs. number of nodes/tips/etc.)
+ Checking on matches between the tree and the data will be done by the
+ validity checker (label matches between data and tree tips, number of
+ rows of data vs. number of nodes/tips/etc.)
}
\examples{
library(ape)
@@ -61,5 +86,43 @@
use.tip.names=FALSE)
obj
print(obj)
+
+####
+
+data(geospiza_raw)
+geoTree <- geospiza_raw$tree
+geoData <- geospiza_raw$data
+
+## fix differences in tip names between the tree and the data
+geoData <- rbind(geoData, array(, dim = c(1,ncol(geoData)),
+ dimnames = list("olivacea", colnames(geoData))))
+
+### Example using a tree of class 'phylo'
+exGeo1 <- phylo4d(geoTree, tip.data = geoData)
+
+### Example using a tree of class 'phylo4'
+geoTree <- as(geoTree, "phylo4")
+
+## some random node data
+rNodeData <- data.frame(randomTrait = rnorm(nNodes(geoTree)),
+ row.names = nodeLabels(geoTree))
+
+exGeo2 <- phylo4d(geoTree, tip.data = geoData, node.data = rNodeData)
+
+### Example using 'merge.tip.node'
+## some random tip data
+rTipData <- data.frame(randomTrait = rnorm(nTips(geoTree)),
+ row.names = labels(geoTree))
+
+(exGeo3 <- phylo4d(geoTree, tip.data = rTipData, node.data = rNodeData))
+(exGeo4 <- phylo4d(geoTree, tip.data = rTipData, node.data = rNodeData,
+ merge.tip.node = FALSE))
+
+### Example with 'all.data'
+rAllData <- data.frame(randomTrait = rnorm(nTips(geoTree) + nNodes(geoTree)),
+ row.names = c(labels(geoTree), nodeLabels(geoTree)))
+exGeo5 <- phylo4d(geoTree, all.data = rAllData)
+
+
}
\keyword{misc}
More information about the Phylobase-commits
mailing list