[Phylobase-commits] r624 - in pkg: R inst/doc man tests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Sep 8 22:59:41 CEST 2009
Author: regetz
Date: 2009-09-08 22:59:41 +0200 (Tue, 08 Sep 2009)
New Revision: 624
Modified:
pkg/R/checkdata.R
pkg/R/methods-phylo4.R
pkg/R/subset.R
pkg/R/treewalk.R
pkg/inst/doc/phylobase.Rnw
pkg/man/phylo4-labels.Rd
pkg/tests/misctests.R
pkg/tests/misctests.Rout.save
Log:
revised labels accessor method:
- now always returning labels in ascending order of node ID
- changed type 'allnode' to 'all'
- default type is now 'all', matching nodeId and edgeId accessors
fixed code, examples, and tests that relied on the old 'tip' default
Modified: pkg/R/checkdata.R
===================================================================
--- pkg/R/checkdata.R 2009-09-08 18:59:12 UTC (rev 623)
+++ pkg/R/checkdata.R 2009-09-08 20:59:41 UTC (rev 624)
@@ -127,7 +127,7 @@
}
## make sure that tip and node labels are unique
- lb <- labels(object, "allnode")
+ lb <- labels(object, "all")
lb <- lb[nchar(lb) > 0]
lb <- na.omit(lb)
if(any(table(lb) > 1))
Modified: pkg/R/methods-phylo4.R
===================================================================
--- pkg/R/methods-phylo4.R 2009-09-08 18:59:12 UTC (rev 623)
+++ pkg/R/methods-phylo4.R 2009-09-08 20:59:41 UTC (rev 624)
@@ -227,14 +227,22 @@
### Label accessors
#########################################################
-setMethod("labels", "phylo4", function(object, type = c("tip",
- "internal", "allnode")) {
+## return labels in increasing node order
+setMethod("labels", "phylo4", function(object, type = c("all", "tip",
+ "internal")) {
type <- match.arg(type)
- switch(type,
- tip = object at tip.label[as.character(nodeId(object, "tip"))],
- internal = object at node.label,
- allnode = c(object at tip.label, object at node.label)
- )
+ ## [JR: below, using match for ordering rather than direct character
+ ## indexing b/c the latter is slow for vectors of a certain size]
+ if (type=="all") {
+ all <- c(object at tip.label, object at node.label)
+ return(all[match(nodeId(object, "all"), names(all))])
+ } else if (type=="tip") {
+ tip <- object at tip.label
+ return(tip[match(nodeId(object, "tip"), names(tip))])
+ } else if (type=="internal") {
+ int <- object at node.label
+ return(int[match(nodeId(object, "internal"), names(int))])
+ }
})
setReplaceMethod("labels",
Modified: pkg/R/subset.R
===================================================================
--- pkg/R/subset.R 2009-09-08 18:59:12 UTC (rev 623)
+++ pkg/R/subset.R 2009-09-08 20:59:41 UTC (rev 624)
@@ -71,7 +71,7 @@
if(missing(i)) i <- TRUE
- oldlab <- labels(x)
+ oldlab <- tipLabels(x)
if(is.character(i)){
newlab <- i
} else {
Modified: pkg/R/treewalk.R
===================================================================
--- pkg/R/treewalk.R 2009-09-08 18:59:12 UTC (rev 623)
+++ pkg/R/treewalk.R 2009-09-08 20:59:41 UTC (rev 624)
@@ -15,23 +15,23 @@
}
if (is.character(node)) {
- irval <- match(node, labels(phy, "allnode"))
+ irval <- match(node, labels(phy, "all"))
}
else {
if (is.integer(node)) {
- irval <- match(as.character(node), names(labels(phy, "allnode")))
+ irval <- match(as.character(node), names(labels(phy, "all")))
}
else stop("Node must be a vector of class \'integer\' or \'character\'.")
}
## node numbers
- rval <- names(labels(phy, "allnode"))[irval]
+ rval <- names(labels(phy, "all"))[irval]
rval <- as.integer(rval)
rval[is.na(node)] <- NA # return NA for any NA_character_ inputs
## node labels
- nmNd <- labels(phy, "allnode")[irval]
+ nmNd <- labels(phy, "all")[irval]
names(rval) <- nmNd
## deal with nodes that don't match
Modified: pkg/inst/doc/phylobase.Rnw
===================================================================
--- pkg/inst/doc/phylobase.Rnw 2009-09-08 18:59:12 UTC (rev 623)
+++ pkg/inst/doc/phylobase.Rnw 2009-09-08 20:59:41 UTC (rev 624)
@@ -125,7 +125,7 @@
<<tiplabelgeodata>>=
tipLabels(g1)
@
-(\code{labels(g1)} or \code{labels(g1,"tip")} would also work.)
+(\code{labels(g1,"tip")} would also work.)
Print node numbers (in edge matrix order):
Modified: pkg/man/phylo4-labels.Rd
===================================================================
--- pkg/man/phylo4-labels.Rd 2009-09-08 18:59:12 UTC (rev 623)
+++ pkg/man/phylo4-labels.Rd 2009-09-08 20:59:41 UTC (rev 624)
@@ -35,7 +35,7 @@
\usage{
-\S4method{labels}{phylo4}(object, type=c("tip", "internal", "allnode"), \dots)
+\S4method{labels}{phylo4}(object, type=c("all", "tip", "internal"), \dots)
\S4method{labels}{phylo4,ANY,ANY,character}(x, type=c("tip", "internal", "allnode"),
use.names=FALSE) <- value
@@ -55,8 +55,8 @@
\arguments{
\item{x}{a phylo4 or phylo4d object.}
\item{object}{a phylo4 or phylo4d object.}
- \item{type}{which type of labels: \code{tip} (tips), \code{internal}
- (internal nodes), \code{allnode} (tips and internal nodes).}
+ \item{type}{which type of labels: \code{all} (tips and internal nodes),
+ \code{tip} (tips only), \code{internal} (internal nodes only).}
\item{value}{a vector of class \code{character}, see Details for more
information.}
\item{use.names}{should the names of the vector used to create/update
@@ -84,7 +84,8 @@
\section{Methods}{
\describe{
- \item{labels}{\code{signature(object = "phylo4")}: tip labels}
+ \item{labels}{\code{signature(object = "phylo4")}: tip and/or
+ internal node labels}
\item{tipLabels}{\code{signature(object = "phylo4")}: tip labels}
@@ -94,7 +95,7 @@
node labels}
\item{hasEdgeLabels}{\code{signature(object = "phylo4")}: whether
- tree has (internal) edge labels}
+ tree has (internal) edge labels}
\item{edgeLabels}{\code{signature(object = "phylo4")}: internal
edge labels}
}
@@ -130,4 +131,4 @@
labels(geospiza, "internal", use.names=TRUE) <- ndLbl
nodeLabels(geospiza)
-}
\ No newline at end of file
+}
Modified: pkg/tests/misctests.R
===================================================================
--- pkg/tests/misctests.R 2009-09-08 18:59:12 UTC (rev 623)
+++ pkg/tests/misctests.R 2009-09-08 20:59:41 UTC (rev 624)
@@ -21,7 +21,7 @@
p2 <- as(geospiza0$geospiza.tree,"phylo4")
plot(p2)
-lab1 <- labels(p2)
+lab1 <- tipLabels(p2)
lab2 <- rownames(geospiza0$geospiza.data)
lab1[!lab1 %in% lab2] ## missing data
@@ -38,7 +38,7 @@
## or ...
p1C <- na.omit(p1)
-labels(p1C) <- tolower(labels(p1C))
+labels(p1C, "allnode") <- tolower(labels(p1C, "all"))
## trace("prune",browser,signature="phylo4d")
r1 <- read.tree(text="((t4:0.3210275554,(t2:0.2724586465,t3:0.2724586465):0.0485689089):0.1397952619,(t5:0.07551818331,t1:0.07551818331):0.385304634);")
Modified: pkg/tests/misctests.Rout.save
===================================================================
--- pkg/tests/misctests.Rout.save 2009-09-08 18:59:12 UTC (rev 623)
+++ pkg/tests/misctests.Rout.save 2009-09-08 20:59:41 UTC (rev 624)
@@ -44,7 +44,7 @@
> p2 <- as(geospiza0$geospiza.tree,"phylo4")
> plot(p2)
>
-> lab1 <- labels(p2)
+> lab1 <- tipLabels(p2)
> lab2 <- rownames(geospiza0$geospiza.data)
>
> lab1[!lab1 %in% lab2] ## missing data
More information about the Phylobase-commits
mailing list