[Phylobase-commits] r378 - in pkg: R man tests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Dec 21 02:08:41 CET 2008
Author: bbolker
Date: 2008-12-21 02:08:41 +0100 (Sun, 21 Dec 2008)
New Revision: 378
Modified:
pkg/R/class-phylo4.R
pkg/R/methods-phylo4d.R
pkg/R/prune.R
pkg/R/setAs-Methods.R
pkg/R/subset.R
pkg/R/tbind.R
pkg/R/treewalk.R
pkg/man/as-methods.Rd
pkg/man/extract.tree.Rd
pkg/tests/plottest.R
Log:
changed extract.tree to extractTree
fix to keep only labels as character, not nodeTypes
substituted extractTree for explicit as(phylo4d,phylo4)
allow 0-length tip and node labels as input to phylo4
use hasEdgeLength instead of is.null test
Modified: pkg/R/class-phylo4.R
===================================================================
--- pkg/R/class-phylo4.R 2008-12-20 21:40:36 UTC (rev 377)
+++ pkg/R/class-phylo4.R 2008-12-21 01:08:41 UTC (rev 378)
@@ -59,15 +59,15 @@
node.label <- character(0) ## empty node labels
## node.label <- character(nnodes)
## is.na(node.label) <- TRUE ## ???
- } else if (length(node.label) != nnodes)
- stop("the node labels are not consistent with the number of nodes")
+ } else if (length(node.label)>0 && length(node.label) != nnodes)
+ stop("number of node labels is not consistent with the number of nodes")
## edge.label
## an edge is named by the descendant
if(is.null(edge.label)) {
edge.label <- character(0)
## edge.label <- paste("E", edge[, 2], sep = "")
- } else if (length(edge.label) != nrow(edge))
- stop("the edge labels are not consistent with the number of edges")
+ } else if (length(edge.label)>0 && length(edge.label) != nrow(edge))
+ stop("number of edge labels is not consistent with the number of edges")
## fill in the result
res <- new("phylo4")
res at edge <- edge
Modified: pkg/R/methods-phylo4d.R
===================================================================
--- pkg/R/methods-phylo4d.R 2008-12-20 21:40:36 UTC (rev 377)
+++ pkg/R/methods-phylo4d.R 2008-12-21 01:08:41 UTC (rev 378)
@@ -124,7 +124,7 @@
## Marguerite Butler & Peter Cowan
setMethod("summary", "phylo4d", function(object) {
x <- object
- summary(as(object, "phylo4"))
+ summary(extractTree(object))
tips <- tdata(object, "tip")
nodes <- tdata(object, "node")
cat("\nComparative data:\n")
Modified: pkg/R/prune.R
===================================================================
--- pkg/R/prune.R 2008-12-20 21:40:36 UTC (rev 377)
+++ pkg/R/prune.R 2008-12-21 01:08:41 UTC (rev 378)
@@ -19,7 +19,7 @@
phy
} else if (is(phy,"phylo4d")) {
## use extract.tree instead of as() to avoid warning
- as(ape::drop.tip(as(extract.tree(phy),"phylo"),tip,...),"phylo4d")
+ as(ape::drop.tip(as(extractTree(phy),"phylo"),tip,...),"phylo4d")
} else as(ape::drop.tip(as(phy,"phylo"),tip,...),class(phy))
}
Modified: pkg/R/setAs-Methods.R
===================================================================
--- pkg/R/setAs-Methods.R 2008-12-20 21:40:36 UTC (rev 377)
+++ pkg/R/setAs-Methods.R 2008-12-21 01:08:41 UTC (rev 378)
@@ -46,6 +46,19 @@
#######################################################
## Exporting to ape
+
+
+## BMB: adding an explicit as method, and the warning,
+## here is a very bad idea, because
+## even implicit conversions from phylo4d to phylo4 (e.g.
+## to use inhertied methods) will produce the warning
+
+## setAs("phylo4d", "phylo4",function(from,to) {
+## warning("losing data while coercing phylo4d to phylo")
+## phylo4(from at edge, from at edge.length, from at tip.label,
+## from at node.label,from at edge.label,from at order)
+## })
+
setAs("phylo4", "phylo", function(from, to) {
if (inherits(from,"phylo4d"))
warning("losing data while coercing phylo4d to phylo")
@@ -137,8 +150,10 @@
## there may not be node labels (character(0))
label <- labels(x,which="all")[node]
node.type <- nodeType(x)[node]
- return(data.frame(label, node, ancestor, branch.length,
- node.type,stringsAsFactors=FALSE))
+ d <- data.frame(label, node, ancestor, branch.length,
+ node.type)
+ d$label <- as.character(d$label)
+ return(d)
}
else {
E <- edges(x) # E: matrix of edges
@@ -146,8 +161,8 @@
ancestor <- E[, 1][node]
#orphan <- setdiff(E[,1],E[,2])
branch.length <- edgeLength(x)[node]
- if (is.null(edgeLength(x))) {
- branch.length <- rep(NA, length(node))
+ if (!hasEdgeLength(x)) {
+ branch.length <- rep(NA, length(node))
}
## node and tip labels ##
## beware: they cannot be NULL
@@ -155,14 +170,16 @@
## there may not be node labels (character(0))
label <- labels(x,which="all")[node]
node.type <- nodeType(x)[node]
- return(data.frame(label, node, ancestor, branch.length,
- node.type,stringsAsFactors=FALSE))
+ d <- data.frame(label, node, ancestor, branch.length,
+ node.type)
+ d$label <- as.character(d$label)
+ return(d)
}
})
setAs(from = "phylo4d", to = "data.frame", function(from) {
## TODO we need some test to ensure data and tree are in the right order
- tree <- as(from, "phylo4") # get tree
+ tree <- extractTree(from) ## as(from, "phylo4") # get tree
t_df <- as(tree, "data.frame") # convert to data.frame
dat <- tdata(from, "allnode", label.type="column") # get data
tdat <- cbind(t_df, dat[ ,-1 , drop=FALSE])
Modified: pkg/R/subset.R
===================================================================
--- pkg/R/subset.R 2008-12-20 21:40:36 UTC (rev 377)
+++ pkg/R/subset.R 2008-12-21 01:08:41 UTC (rev 378)
@@ -92,7 +92,8 @@
## coerce phylo4d to phylo4 -- on purpose, so no warning
-extract.tree <- function(from) {
- phylo4(edge = from at edge, edge.length = from at edge.length,
- Nnode = from at Nnode, tip.label = from at tip.label)
-}
+extractTree <- function(from) {
+ phylo4(edge = from at edge, edge.length = from at edge.length,
+ tip.label = from at tip.label,
+ node.label = from at node.label, edge.label = from at edge.label)
+ }
Modified: pkg/R/tbind.R
===================================================================
--- pkg/R/tbind.R 2008-12-20 21:40:36 UTC (rev 377)
+++ pkg/R/tbind.R 2008-12-21 01:08:41 UTC (rev 378)
@@ -22,7 +22,7 @@
xfun <- function(x) {
switch(class(x),
phylo4=x,
- phylo4d=extract.tree(x),
+ phylo4d=extractTree(x),
multiPhylo4=x at phylolist,
multiPhylo4d=suppressWarnings(as("multiPhylo4",x)@phylolist))}
## decompose multi-trees into lists
Modified: pkg/R/treewalk.R
===================================================================
--- pkg/R/treewalk.R 2008-12-20 21:40:36 UTC (rev 377)
+++ pkg/R/treewalk.R 2008-12-21 01:08:41 UTC (rev 378)
@@ -157,8 +157,9 @@
## conversion from phylo, phylo4 and phylo4d
x <- as(phy, "phylo4")
+ ## FIXME: use extractTree if coming from phylo4d
- ## come checks
+ ## some checks
if (is.character(checkval <- check_phylo4(x))) stop(checkval)
t1 <- getNode(x, node1)
t2 <- getNode(x, node2)
Modified: pkg/man/as-methods.Rd
===================================================================
--- pkg/man/as-methods.Rd 2008-12-20 21:40:36 UTC (rev 377)
+++ pkg/man/as-methods.Rd 2008-12-21 01:08:41 UTC (rev 378)
@@ -21,7 +21,9 @@
\alias{coerce,phylo4d,phylo-method}
\alias{coerce,phylo4,data.frame-method}
\alias{coerce,phylo4d,data.frame-method}
+%\alias{coerce,phylo4d,phylo4-method}
+
\title{Converting between phylo4 and other phylogenetic trees}
\section{Usage}{
@@ -75,7 +77,7 @@
}
\author{Ben Bolker, Thibaut Jombart \email{jombart at biomserv.univ-lyon1.fr}, Marguerite Butler, Steve Kembel}
-\seealso{ generic \code{\link[methods]{as}}, \code{\link{phylo4}}, \code{\link{phylo4d}}, \code{\link{extract.tree}}, the original \code{\link[ade4]{phylog}} from the
+\seealso{ generic \code{\link[methods]{as}}, \code{\link{phylo4}}, \code{\link{phylo4d}}, \code{\link{extractTree}}, the original \code{\link[ade4]{phylog}} from the
\code{ade4} package and \code{\link[ape]{as.phylo}} from the \code{ape} package.
}
\examples{
Modified: pkg/man/extract.tree.Rd
===================================================================
--- pkg/man/extract.tree.Rd 2008-12-20 21:40:36 UTC (rev 377)
+++ pkg/man/extract.tree.Rd 2008-12-21 01:08:41 UTC (rev 378)
@@ -1,17 +1,17 @@
-\name{extract.tree}
-\alias{extract.tree}
+\name{extractTree}
+\alias{extractTree}
\title{Get tree from tree+data object}
\description{
Extracts a \code{phylo4} tree object from a \code{phylo4d} tree+data object.
}
\usage{
-extract.tree(from)
+extractTree(from)
}
\arguments{
\item{from}{ a \code{phylo4d} object, containing a phylogenetic tree plus associated phenotypic data. Created by the \code{phylo4d()} function. }
}
\details{
- \code{extract.tree} extracts just the phylogeny from a tree+data object. The phylogeny contains the topology (how the nodes are linked together), the branch lengths (if any), and any tip and/or node labels. This may be useful for extracting a tree from a \code{phylo4d} object, and associating with another phenotypic dataset, or to convert the tree to another format.
+ \code{extractTree} extracts just the phylogeny from a tree+data object. The phylogeny contains the topology (how the nodes are linked together), the branch lengths (if any), and any tip and/or node labels. This may be useful for extracting a tree from a \code{phylo4d} object, and associating with another phenotypic dataset, or to convert the tree to another format.
}
\author{ Ben Bolker }
\seealso{\code{\link{phylo4}}, \code{\link{phylo4d}}, \code{\link{coerce-methods}} for translation functions. }
@@ -21,8 +21,8 @@
plot(tree)
tip.data <- data.frame(size = c(1, 2, 3), row.names = c("a", "b", "c"))
(treedata <- phylo4d(tree, tip.data))
-## treePlot(treedata) ## not yet -- wait for debugging
-(tree1 <- extract.tree(treedata))
-## treePlot(tree1) ## not yet -- wait for debugging
+plot(treedata)
+(tree1 <- extractTree(treedata))
+plot(tree1)
}
\keyword{methods}
Modified: pkg/tests/plottest.R
===================================================================
--- pkg/tests/plottest.R 2008-12-20 21:40:36 UTC (rev 377)
+++ pkg/tests/plottest.R 2008-12-21 01:08:41 UTC (rev 378)
@@ -26,7 +26,7 @@
g3 = subset(g2, tips.exclude=c("fuliginosa", "fortis", "magnirostris",
"conirostris", "scandens"))
-plot(extract.tree(g3)) ## phylo4
+plot(extractTree(g3)) ## phylo4
plot(g3)
More information about the Phylobase-commits
mailing list