[Phylobase-commits] r668 - in branches/slot-mods: R man tests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Sep 28 06:06:24 CEST 2009
Author: regetz
Date: 2009-09-28 06:06:24 +0200 (Mon, 28 Sep 2009)
New Revision: 668
Modified:
branches/slot-mods/R/formatData.R
branches/slot-mods/man/phylo4d.Rd
branches/slot-mods/tests/misctests.Rout.save
Log:
improved formatData performance, plus minor tweak in error reporting;
fixed documentation infelicity; updated test output
Modified: branches/slot-mods/R/formatData.R
===================================================================
--- branches/slot-mods/R/formatData.R 2009-09-25 23:53:04 UTC (rev 667)
+++ branches/slot-mods/R/formatData.R 2009-09-28 04:06:24 UTC (rev 668)
@@ -40,31 +40,34 @@
tmpDt <- data.frame(tmpDt)
if(match.data) {
- ## Replace node labels by node numbers
+ ## extract node-matching vector
ndNames <- switch(label.type,
rownames = rownames(dt),
column = dt[,label.column])
- ndDt <- lapply(ndNames, function(nd) {
- if(nchar(gsub("[0-9]", "", nd)) == 0 && !rownamesAsLabels)
- getNode(phy, as.integer(nd), missing="OK")
- else getNode(phy, nd, missing="OK")
- })
- ndDt <- unlist(ndDt)
-# ndDt <- ifelse(nchar(gsub("[0-9]", "", ndNames))==0,
-# getNode(phy, as.integer(ndNames), missing="OK"),
-# getNode(phy, ndNames, missing="OK"))
+ ## either force matching on labels, or match on node
+ ## numbers for any number-like elements and labels otherwise
+ if (rownamesAsLabels) {
+ ndDt <- getNode(phy, as.character(ndNames), missing="OK")
+ } else {
+ ndDt <- as.numeric(rep(NA, length(ndNames)))
+ treatAsNumber <- nchar(gsub("[0-9]", "", ndNames))==0
+ ndDt[treatAsNumber] <- getNode(phy,
+ as.integer(ndNames[treatAsNumber]), missing="OK")
+ ndDt[!treatAsNumber] <- getNode(phy,
+ as.character(ndNames[!treatAsNumber]), missing="OK")
+ }
## Make sure that data are matched to appropriate nodes
if(type != "all") {
switch(type,
tip = {
## BMB: don't bother trying to match NAs
- if(any(na.omit(names(ndDt)) %in% labels(phy, "internal")))
+ if(any(na.omit(ndDt) %in% nodeId(phy, "internal")))
stop("Your tip data are being matched to internal ",
"nodes. Make sure that your data identifiers ",
"are correct.")
},
internal = {
- if(any(na.omit(names(ndDt)) %in% labels(phy, "tip")))
+ if(any(na.omit(ndDt) %in% nodeId(phy, "tip")))
stop("Your node data are being matched to tip ",
"nodes. Make sure that your data identifiers ",
"are correct.")
@@ -72,7 +75,7 @@
}
## Check differences
- extra <- names(ndDt[is.na(ndDt)])
+ extra <- ndNames[is.na(ndDt)]
mssng <- nodeId(phy, type)[! nodeId(phy, type) %in% ndDt]
if(length(mssng) > 0 && missing.data != "OK") {
Modified: branches/slot-mods/man/phylo4d.Rd
===================================================================
--- branches/slot-mods/man/phylo4d.Rd 2009-09-25 23:53:04 UTC (rev 667)
+++ branches/slot-mods/man/phylo4d.Rd 2009-09-28 04:06:24 UTC (rev 668)
@@ -53,9 +53,9 @@
argument is useful if the \code{phylo} object has non-unique node
labels or node labels with informative data (e.g., posterior
probabilities).}
- \item{rownamesAsLabels}{(logical), in the case of number-like labels
- should the row names of the data provided be considered as labels
- (TRUE) or node numbers (FALSE and default)}
+ \item{rownamesAsLabels}{(logical), should the row names of the data
+ provided be matched only to labels (TRUE), or should any number-like
+ row names be matched to node numbers (FALSE and default)}
\item{annote}{any additional annotation data to be passed to the new object}
\item{metadata}{any additional metadata to be passed to the new object}
\item{\dots}{further arguments to be passed to
@@ -71,12 +71,13 @@
nodes are determined jointly by the \code{match.data} and
\code{rownamesAsLabels} arguments, and these will apply the same way
to all supplied data frames. If \code{match.data} is TRUE, data frame
- rows will be matched against tip and node \emph{labels} if
- \code{rownamesAsLabels} is also TRUE, and against tip and node
- \emph{numbers} otherwise (the default). If \code{match.data} is FALSE,
- \code{rownamesAsLabels} has no effect, and row matching is purely
- positional with respect to the order returned by \code{nodeId(x,
- "tip")} for tip.data, \code{nodeId(x, "internal")} for
+ rows will be matched exclusively against tip and node labels if
+ \code{rownamesAsLabels} is also TRUE, whereas any all-digit row names
+ will be matched against tip and node numbers if
+ \code{rownamesAsLabels} is FALSE (the default). If \code{match.data}
+ is FALSE, \code{rownamesAsLabels} has no effect, and row matching is
+ purely positional with respect to the order returned by
+ \code{nodeId(x, "tip")} for tip.data, \code{nodeId(x, "internal")} for
node.data, and \code{nodeId(x, "all")} for all.data.
This means that you need to be consistent with the row names of your
Modified: branches/slot-mods/tests/misctests.Rout.save
===================================================================
--- branches/slot-mods/tests/misctests.Rout.save 2009-09-25 23:53:04 UTC (rev 667)
+++ branches/slot-mods/tests/misctests.Rout.save 2009-09-28 04:06:24 UTC (rev 668)
@@ -455,7 +455,7 @@
phyl4d> p4d.all2 <- phylo4d(p4, all.data = rbind(dat, nod.dat, match.data=FALSE))
Warning message:
In switch(extra.data, warn = warning(msg), fail = stop(msg)) :
- The following names are not found in the tree: NA
+ The following names are not found in the tree: match.data
> obj1 <- obj2 <- obj3 <- phylo4d(z, data.frame(wing=1:4,color=factor(c("b","w","b","b")), tail=runif(4)*10), match.data=FALSE)
>
> obj2 at data <- as.data.frame(obj2 at data[,1])
More information about the Phylobase-commits
mailing list