[Phylobase-commits] r402 - in pkg: R man tests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Dec 24 16:12:45 CET 2008
Author: francois
Date: 2008-12-24 16:12:45 +0100 (Wed, 24 Dec 2008)
New Revision: 402
Modified:
pkg/R/methods-phylo4.R
pkg/R/phylo4.R
pkg/man/nNodes-methods.Rd
pkg/man/treewalk.Rd
pkg/tests/misctests.R
Log:
fixed incorrect behavior of nodeLabels, created tipLabels, removed $ accessor and its calls in the code
Modified: pkg/R/methods-phylo4.R
===================================================================
--- pkg/R/methods-phylo4.R 2008-12-24 04:03:19 UTC (rev 401)
+++ pkg/R/methods-phylo4.R 2008-12-24 15:12:45 UTC (rev 402)
@@ -143,11 +143,15 @@
)
})
-setMethod("nodeLabels", "phylo4", function(phy) {
+setMethod("nodeLabels", "phylo4", function(object) {
#x at node.label
- labels(phy, which="node")
+ labels(object, which="node")
})
+setMethod("tipLabels", "phylo4", function(object) {
+ labels(object, which="tip")
+ })
+
setMethod("nodeId", "phylo4", function(x,which=c("internal","tip","all")) {
which <- match.arg(which)
switch(which,
@@ -156,38 +160,29 @@
all = x at edge[,2])
})
-setReplaceMethod("nodeLabels", "phylo4",
- function(object, ..., value) {
- labels(object, "node") <- value
- return(object)
- })
+setReplaceMethod("nodeLabels", signature(object="phylo4", value="character"),
+ function(object, ..., value) {
+ labels(object, which="node", ...) <- value
+ return(object)
+ })
-setMethod("edgeLabels", "phylo4", function(x) {
+setReplaceMethod("tipLabels", signature(object="phylo4", value="character"),
+ function(object, ..., value) {
+ labels(object, which="tip", ...) <- value
+ return(object)
+ })
+
+setMethod("edgeLabels", signature(x = "phylo4"), function(x) {
x at edge.label
})
-setReplaceMethod("edgeLabels", "phylo4", function(object, ...,
- value) {
- object at edge.label <- value
- object
-})
+setReplaceMethod("edgeLabels", signature(object="phylo4", value="character"),
+ function(object, ..., value) {
+ object at edge.label <- value
+ object
+ })
-## hack to allow access with $
-setMethod("$", "phylo4", function(x, name) {
- switch(name, edge.length = if (!hasEdgeLength(x))
- NULL
- else x at edge.length, node.label = if (!hasNodeLabels(x))
- NULL
- else x at node.label, attr(x, name))
-})
-## FIXME: implement more checks on this!!
-setReplaceMethod("$", "phylo4", function(x, name, value) {
- slot(x, name, check = TRUE) <- value
- return(x)
-})
-
-
printphylo4 <- function(x, printall = TRUE){
if (printall)
print(as(x, 'data.frame'))
@@ -256,13 +251,13 @@
## build the result object
res$name <- deparse(substitute(object, sys.frame(-1)))
- res$nb.tips <- length(x$tip.label)
- res$nb.nodes <- x$Nnode
+ res$nb.tips <- length(x at tip.label)
+ res$nb.nodes <- x at Nnode
- if(!is.null(x$edge.length)){
- res$mean.el <- mean(x$edge.length, na.rm=TRUE)
- res$var.el <- var(x$edge.length, na.rm=TRUE)
- res$sumry.el <- summary(x$edge.length)[-4]
+ if(!is.null(x at edge.length)){
+ res$mean.el <- mean(x at edge.length, na.rm=TRUE)
+ res$var.el <- var(x at edge.length, na.rm=TRUE)
+ res$sumry.el <- summary(x at edge.length)[-4]
} else {
res$mean.el <- NULL
res$var.el <- NULL
@@ -303,7 +298,7 @@
cat(" Number of tips :", res$nb.tips, "\n")
cat(" Number of nodes :", res$nb.nodes, "\n")
## cat(" ")
- if(is.null(x$edge.length)) {
+ if(is.null(x at edge.length)) {
cat(" Branch lengths : No branch lengths.\n")
} else {
cat(" Branch lengths:\n")
@@ -345,7 +340,7 @@
length(x at edge.length)>0
})
-setReplaceMethod("labels", "phylo4",
+setReplaceMethod("labels", signature(object="phylo4", value="character"),
function(object, which = c("tip", "node", "allnode"), ..., value) {
which <- match.arg(which)
switch(which,
Modified: pkg/R/phylo4.R
===================================================================
--- pkg/R/phylo4.R 2008-12-24 04:03:19 UTC (rev 401)
+++ pkg/R/phylo4.R 2008-12-24 15:12:45 UTC (rev 402)
@@ -61,14 +61,24 @@
standardGeneric("labels<-")
})
-setGeneric("nodeLabels", function(phy) {
+setGeneric("nodeLabels", function(object) {
standardGeneric("nodeLabels")
})
+
setGeneric("nodeLabels<-",
function(object, ..., value) {
standardGeneric("nodeLabels<-")
})
+setGeneric("tipLabels", function(object) {
+ standardGeneric("tipLabels")
+})
+
+setGeneric("tipLabels<-",
+ function(object, ..., value) {
+ standardGeneric("tipLabels<-")
+ })
+
setGeneric("nodeId", function(x, which=c("internal", "tip", "all")) {
standardGeneric("nodeId")
})
Modified: pkg/man/nNodes-methods.Rd
===================================================================
--- pkg/man/nNodes-methods.Rd 2008-12-24 04:03:19 UTC (rev 401)
+++ pkg/man/nNodes-methods.Rd 2008-12-24 15:12:45 UTC (rev 402)
@@ -9,8 +9,8 @@
\alias{nTips,ANY-method}
\alias{labels<-}
\alias{labels,phylo4-method}
-\alias{labels<-,phylo4-method}
-\alias{labels<-,phylo4d-method}
+\alias{labels<-,phylo4,ANY,character-method}
+\alias{labels<-,phylo4d,missing,ANY-method}
\alias{edges}
\alias{edges-methods}
\alias{edges,phylo4-method}
@@ -48,8 +48,14 @@
\alias{nodeLabels-methods}
\alias{nodeLabels,phylo4-method}
\alias{nodeLabels<-}
-\alias{nodeLabels<-,phylo4-method}
-\alias{nodeLabels<-,phylo4d-method}
+\alias{nodeLabels<-,phylo4,character-method}
+\alias{nodeLabels<-,phylo4d,ANY-method}
+\alias{tipLabels}
+\alias{tipLabels-methods}
+\alias{tipLabels,phylo4-method}
+\alias{tipLabels<-}
+\alias{tipLabels<-,phylo4,character-method}
+\alias{tipLabels<-,phylo4d,character-method}
\alias{hasEdgeLabels}
\alias{hasEdgeLabels-methods}
\alias{hasEdgeLabels,phylo4-method}
@@ -57,7 +63,7 @@
\alias{edgeLabels<-}
\alias{edgeLabels-methods}
\alias{edgeLabels,phylo4-method}
-\alias{edgeLabels<-,phylo4-method}
+\alias{edgeLabels<-,phylo4,character-method}
\alias{tdata}
\alias{tdata<-}
\alias{tdata-methods}
@@ -78,6 +84,7 @@
tree has (internal) node data}
\item{nodeLabels}{\code{signature(object = "phylo4")}: internal
node labels}
+ \item{tipLabels}{\code{signature(object = "phylo4")}: tip labels}
\item{nEdges}{\code{signature(object = "phylo4")}: number of edges}
\item{edges}{\code{signature(object = "phylo4")}: edge matrix}
\item{hasEdgeLength}{\code{signature(object = "phylo4")}: whether
Modified: pkg/man/treewalk.Rd
===================================================================
--- pkg/man/treewalk.Rd 2008-12-24 04:03:19 UTC (rev 401)
+++ pkg/man/treewalk.Rd 2008-12-24 15:12:45 UTC (rev 402)
@@ -96,7 +96,7 @@
## identifying an edge from its terminal node
getedges(geospiza,c("olivacea","B","fortis"))
getNode(geospiza, c("olivacea","B","fortis"))
- geospiza$edge[c(26,1,11),]
+ geospiza at edge[c(26,1,11),]
## FIXME
## if(require(ape)){ edgelabels() }
Modified: pkg/tests/misctests.R
===================================================================
--- pkg/tests/misctests.R 2008-12-24 04:03:19 UTC (rev 401)
+++ pkg/tests/misctests.R 2008-12-24 15:12:45 UTC (rev 402)
@@ -7,7 +7,7 @@
## push data back into list form as in geiger
t1 <- try(p1 <- phylo4d(geospiza0$geospiza.tree,geospiza0$geospiza.data))
-## Error in check_data(res, ...) :
+## Error in check_data(res, ...) :
## Tip data names are a subset of tree tip labels.
p2 <- as(geospiza0$geospiza.tree,"phylo4")
@@ -79,8 +79,8 @@
obj2 at tip.data <- as.data.frame(obj2 at tip.data[,1])
obj3 at tip.data <- cbind(obj1 at tip.data,obj2 at tip.data)
obj4 <- obj1
-obj4$tip.data[2,3] <- NA
-obj4$tip.data[1,1] <- NA
+obj4 at tip.data[2,3] <- NA
+obj4 at tip.data[1,1] <- NA
obj4 at node.label <- character(0)
@@ -90,16 +90,16 @@
treePlot(obj4)
E <- matrix(c(
- 8, 9,
- 9, 10,
- 10, 1,
- 10, 2,
- 9, 3,
- 9, 4,
- 8, 11,
- 11, 5,
- 11, 6,
- 11, 7,
- NA, 8), ncol=2,byrow=TRUE)
+ 8, 9,
+ 9, 10,
+ 10, 1,
+ 10, 2,
+ 9, 3,
+ 9, 4,
+ 8, 11,
+ 11, 5,
+ 11, 6,
+ 11, 7,
+ NA, 8), ncol=2,byrow=TRUE)
P2 <- phylo4(E)
More information about the Phylobase-commits
mailing list