[Phylobase-commits] r686 - in pkg: . R inst/unitTests man tests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Oct 6 06:48:16 CEST 2009
Author: regetz
Date: 2009-10-06 06:48:15 +0200 (Tue, 06 Oct 2009)
New Revision: 686
Modified:
pkg/NAMESPACE
pkg/R/class-phylo4d.R
pkg/R/methods-phylo4d.R
pkg/R/phylo4.R
pkg/inst/unitTests/runit.methods-phylo4d.R
pkg/inst/unitTests/runit.setAs-Methods.R
pkg/man/tdata.Rd
pkg/tests/misctests.R
pkg/tests/misctests.Rout.save
pkg/tests/phylo4dtests.R
pkg/tests/phylo4dtests.Rout.save
pkg/tests/phylosubtest.R
Log:
modified tdata<- default behavior to leave existing tip or node data
unchanged when only the other type is replaced; added tipData and
nodeData getter/setter methods, and changed tdata default type to 'all';
updated documentation and tests, and added some new tests
Modified: pkg/NAMESPACE
===================================================================
--- pkg/NAMESPACE 2009-10-02 05:20:48 UTC (rev 685)
+++ pkg/NAMESPACE 2009-10-06 04:48:15 UTC (rev 686)
@@ -36,7 +36,8 @@
exportMethods(nodeId, nodeType)
# tree data methods
-exportMethods(tdata, "tdata<-", addData, hasTipData, hasNodeData)
+exportMethods(tdata, "tdata<-", tipData, "tipData<-", nodeData,
+ "nodeData<-", hasTipData, hasNodeData, addData)
# subset methods
exportMethods(subset, prune, "[")
Modified: pkg/R/class-phylo4d.R
===================================================================
--- pkg/R/class-phylo4d.R 2009-10-02 05:20:48 UTC (rev 685)
+++ pkg/R/class-phylo4d.R 2009-10-06 04:48:15 UTC (rev 686)
@@ -25,21 +25,16 @@
## Core part that takes care of the data
.phylo4Data <- function(x, tip.data=NULL, node.data=NULL, all.data=NULL,
- match.data=TRUE, merge.data=TRUE,
- rownamesAsLabels=FALSE,
- ...) {
+ merge.data=TRUE, ...) {
## Check validity of phylo4 object
if(is.character(checkval <- checkPhylo4(x))) stop(checkval)
## apply formatData to ensure data have node number rownames and
## correct dimensions
- all.data <- formatData(phy=x, dt=all.data, type="all",
- match.data=match.data, rownamesAsLabels=rownamesAsLabels, ...)
- tip.data <- formatData(phy=x, dt=tip.data, type="tip",
- match.data=match.data, rownamesAsLabels=rownamesAsLabels, ...)
- node.data <- formatData(phy=x, dt=node.data, type="internal",
- match.data=match.data, rownamesAsLabels=rownamesAsLabels, ...)
+ all.data <- formatData(phy=x, dt=all.data, type="all", ...)
+ tip.data <- formatData(phy=x, dt=tip.data, type="tip", ...)
+ node.data <- formatData(phy=x, dt=node.data, type="internal", ...)
# don't allow all.data columns of same name as tip.data or node.data
colnamesTipOrNode <- union(names(tip.data), names(node.data))
Modified: pkg/R/methods-phylo4d.R
===================================================================
--- pkg/R/methods-phylo4d.R 2009-10-02 05:20:48 UTC (rev 685)
+++ pkg/R/methods-phylo4d.R 2009-10-06 04:48:15 UTC (rev 686)
@@ -1,7 +1,7 @@
setMethod("tdata", signature(x="phylo4d"),
- function(x, type=c("tip", "internal", "all"),
+ function(x, type=c("all", "tip", "internal"),
label.type=c("row.names","column"),
- empty.columns=TRUE, ...) {
+ empty.columns=TRUE) {
## Returns data associated with the tree
## Note: the function checks for unique labels. It's currently unecessary
@@ -46,22 +46,68 @@
})
setReplaceMethod("tdata", signature(x="phylo4d", value="ANY"),
- function(x, type = c("tip", "internal", "all"), ..., value) {
+ function(x, type = c("all", "tip", "internal"), merge.data = TRUE,
+ clear.all = FALSE, ..., value) {
+
type <- match.arg(type)
- object <- x
- ## Removes existing data, just keeps the tree (as a phylo4d)
- object <- extractTree(object)
- object <- as(object, "phylo4d")
+ ## format new data
+ value <- formatData(x, value, type, keep.all=FALSE, ...)
- object at data <- switch(type,
- tip = .phylo4Data(object, tip.data=value, ...),
- internal = .phylo4Data(object, node.data=value, ...),
- all = .phylo4Data(object, all.data=value, ...))
+ ## get old data to keep (if any)
+ if (clear.all || type=="all") {
+ keep <- NULL
+ } else {
+ if (type=="tip") {
+ keep <- tdata(x, type="internal", empty.column=FALSE)
+ } else if (type=="internal") {
+ keep <- tdata(x, type="tip", empty.column=FALSE)
+ }
+ }
- object
+ ## create updated data
+ updated.data <- switch(type,
+ tip = .phylo4Data(x, tip.data=value, node.data=keep,
+ merge.data=merge.data),
+ internal = .phylo4Data(x, tip.data=keep, node.data=value,
+ merge.data=merge.data),
+ all = .phylo4Data(x, all.data=value, merge.data=merge.data))
+
+ ## try to arrange new columns after old columns
+ kept <- names(updated.data) %in% names(keep)
+ old.cols <- names(updated.data)[kept]
+ new.cols <- names(updated.data)[!kept]
+ x at data <- updated.data[c(old.cols, new.cols)]
+
+ if(is.character(checkval <- checkPhylo4(x))) stop(checkval)
+ return(x)
})
+### Tip data wrappers
+setMethod("tipData", signature(x="phylo4d"), function(x, ...) {
+ tdata(x, type="tip", ...)
+})
+
+setReplaceMethod("tipData", signature(x="phylo4d", value="ANY"),
+ function(x, ..., value) {
+ tdata(x, type="tip", ...) <- value
+ if(is.character(checkval <- checkPhylo4(x))) stop(checkval)
+ return(x)
+})
+
+### Node data wrappers
+setMethod("nodeData", signature(x="phylo4d"), function(x, ...) {
+ tdata(x, type="internal", ...)
+})
+
+setReplaceMethod("nodeData", signature(x="phylo4d", value="ANY"),
+ function(x, ..., value) {
+ tdata(x, type="internal", ...) <- value
+ if(is.character(checkval <- checkPhylo4(x))) stop(checkval)
+ return(x)
+})
+
+### Add new data
setMethod("addData", signature(x="phylo4d"),
function(x, tip.data=NULL, node.data=NULL,
all.data=NULL, pos=c("after", "before"),
Modified: pkg/R/phylo4.R
===================================================================
--- pkg/R/phylo4.R 2009-10-02 05:20:48 UTC (rev 685)
+++ pkg/R/phylo4.R 2009-10-06 04:48:15 UTC (rev 686)
@@ -154,6 +154,26 @@
standardGeneric("tdata<-")
})
+## tipData
+setGeneric("tipData", function(x, ...) {
+ standardGeneric("tipData")
+})
+
+## tipData<-
+setGeneric("tipData<-", function(x, ..., value) {
+ standardGeneric("tipData<-")
+})
+
+## nodeData
+setGeneric("nodeData", function(x, ...) {
+ standardGeneric("nodeData")
+})
+
+## nodeData<-
+setGeneric("nodeData<-", function(x, ..., value) {
+ standardGeneric("nodeData<-")
+})
+
## addData
setGeneric("addData", function(x, ...) {
standardGeneric("addData")
Modified: pkg/inst/unitTests/runit.methods-phylo4d.R
===================================================================
--- pkg/inst/unitTests/runit.methods-phylo4d.R 2009-10-02 05:20:48 UTC (rev 685)
+++ pkg/inst/unitTests/runit.methods-phylo4d.R 2009-10-06 04:48:15 UTC (rev 686)
@@ -39,43 +39,48 @@
nid.all.r <- c(nid.tip.r, nid.int.r)
phyd.alt at data <- phyd at data[rank(nid.all.r), ]
+# for comparisons, manually create expected "all" trait data.frame
+m1 <- merge(allDt, rbind(tipDt["c"], nodDt["c"]), by=0, all=TRUE)
+m2 <- merge(tipDt["d"], nodDt["e"], by=0, all=TRUE)
+eAllDt <- merge(m1, m2, by="Row.names", all=TRUE)[-1]
+row.names(eAllDt) <- lab.all
+
+# for comparisons, manually create expected "tip" trait data.frame
+m1 <- merge(allDt, rbind(tipDt["c"], nodDt["c"]), by=0, all=TRUE)
+m2 <- merge(tipDt["d"], nodDt["e"], by=0, all=TRUE)
+eTipDt <- merge(m1, m2, by="Row.names", all=TRUE)[nid.tip, -1]
+row.names(eTipDt) <- lab.tip
+
+# manually create expected tip trait data.frame
+m1 <- merge(allDt, rbind(tipDt["c"], nodDt["c"]), by=0, all=TRUE)
+m2 <- merge(tipDt["d"], nodDt["e"], by=0, all=TRUE)
+eNodDt <- merge(m1, m2, by="Row.names", all=TRUE)[nid.int, -1]
+row.names(eNodDt) <- lab.int
+
#-----------------------------------------------------------------------
test.tdata.phylo4d <- function() {
# function(x, type=c("tip", "internal", "allnode"),
# label.type=c("row.names","column"), empty.columns=TRUE, ...)
- # manually create expected full trait data.frame
- m1 <- merge(allDt, rbind(tipDt["c"], nodDt["c"]), by=0, all=TRUE)
- m2 <- merge(tipDt["d"], nodDt["e"], by=0, all=TRUE)
- compDt <- merge(m1, m2, by="Row.names", all=TRUE)[-1]
- row.names(compDt) <- lab.all
-
# check basic tdata usage
- checkIdentical(tdata(phyd.alt, type="tip"), compDt[nid.tip,])
- checkIdentical(tdata(phyd.alt, type="internal"), compDt[nid.int,])
- checkIdentical(tdata(phyd.alt, type="all"), compDt)
+ checkIdentical(tdata(phyd.alt, type="tip"), eTipDt)
+ checkIdentical(tdata(phyd.alt, type="internal"), eNodDt)
+ checkIdentical(tdata(phyd.alt, type="all"), eAllDt)
- #
- # label.type
- #
-
# label.type="row.names"
- tmpDt <- data.frame(compDt[nid.tip, -5, ], row.names=lab.tip)
+ tmpDt <- data.frame(eAllDt[nid.tip, -5, ], row.names=lab.tip)
checkIdentical(tdata(phyd.alt, type="tip", label.type="row.names",
empty.columns=FALSE), data.frame(tmpDt[nid.tip,], row.names=lab.tip))
# label.type="column"
- tmpDt <- data.frame(label=lab.tip, compDt[nid.tip, -5, ],
+ tmpDt <- data.frame(label=lab.tip, eAllDt[nid.tip, -5, ],
row.names=as.character(nid.tip))
checkIdentical(tdata(phyd.alt, type="tip", label.type="column",
empty.columns=FALSE), tmpDt)
- #
# keep empty.columns
- #
-
checkIdentical(tdata(phyd.alt, type="tip", empty.columns=TRUE),
- compDt[nid.tip,])
+ eAllDt[nid.tip,])
#
# misc tests
@@ -83,32 +88,79 @@
# check with other tree orderings
phyd.pre <- reorder(phyd.alt, "preorder")
- checkIdentical(tdata(phyd.pre, "all", empty.columns=FALSE), compDt)
+ checkIdentical(tdata(phyd.pre, "all", empty.columns=FALSE), eAllDt)
phyd.post <- reorder(phyd.alt, "postorder")
- checkIdentical(tdata(phyd.post, "all", empty.columns=FALSE), compDt)
+ checkIdentical(tdata(phyd.post, "all", empty.columns=FALSE), eAllDt)
}
## currently just basic tests of tdata replacement; using out-of-order
## data, but only with default args (e.g. row.name-nodeID matching)
+## ... formatData unit tests should be sufficient for the rest
test.Replace.tdata.phylo4d <- function() {
- ## replace data with tip data only
- tdata(phyd.alt, type="tip") <- tipDt[rank(nid.tip.r), , drop=FALSE]
- checkIdentical(tdata(phyd.alt, type="tip"), data.frame(tipDt,
- row.names=lab.tip))
+ ## replace data, labels are row names
+ tdata(phyd.alt, "all") <- allDt[rank(nid.all.r), , drop=FALSE]
+ checkIdentical(tdata(phyd.alt, type="all"), data.frame(allDt,
+ row.names=lab.all))
- ## replace data with internal data only
- tdata(phyd.alt, type="internal") <- nodDt[rank(nid.int.r), , drop=FALSE]
- checkIdentical(tdata(phyd.alt, type="internal"), data.frame(nodDt,
- row.names=lab.int))
+ ## replace data with empty data frame
+ tdata(phyd.alt) <- data.frame()
+ checkIdentical(tdata(phyd.alt), data.frame(row.names=lab.all))
- ## replace data with both tip and internal data
- tdata(phyd.alt, type="all") <- allDt[rank(nid.all.r), , drop=FALSE]
- checkIdentical(tdata(phyd.alt, type="all"), data.frame(allDt,
+ ## same as first test, but leaving out default 'all' type
+ tdata(phyd.alt) <- allDt[rank(nid.all.r), , drop=FALSE]
+ checkIdentical(tdata(phyd.alt), data.frame(allDt,
row.names=lab.all))
+
}
+test.tipData.phylo4d <- function() {
+ # label.type="row.names"
+ checkIdentical(tipData(phyd.alt, label.type="row.names",
+ empty.columns=FALSE), eTipDt[-5])
+ # label.type="column"
+ tmpDt <- data.frame(label=lab.tip, eTipDt[-5],
+ row.names=as.character(nid.tip))
+ checkIdentical(tipData(phyd.alt, label.type="column",
+ empty.columns=FALSE), tmpDt)
+
+ # keep empty.columns
+ checkIdentical(tipData(phyd.alt), eTipDt)
+}
+
+test.Replace.tipData.phylo4d <- function() {
+ ## replace data with tip data only, clearing all data
+ tipData(phyd.alt, clear.all=TRUE) <- tipDt[rank(nid.tip.r), ,
+ drop=FALSE]
+ checkIdentical(tipData(phyd.alt), data.frame(tipDt,
+ row.names=lab.tip))
+}
+
+test.nodeData.phylo4d <- function() {
+
+ # label.type="row.names"
+ checkIdentical(nodeData(phyd.alt, label.type="row.names",
+ empty.columns=FALSE), eNodDt[-4])
+
+ # label.type="column"
+ tmpDt <- data.frame(label=lab.int, eNodDt[-4],
+ row.names=as.character(nid.int))
+ checkIdentical(nodeData(phyd.alt, label.type="column",
+ empty.columns=FALSE), tmpDt)
+
+ # keep empty.columns
+ checkIdentical(nodeData(phyd.alt), eNodDt)
+}
+
+test.Replace.nodeData.phylo4d <- function() {
+ ## replace data with internal data only, clearing all data
+ nodeData(phyd.alt, clear.all=TRUE) <- nodDt[rank(nid.int.r), ,
+ drop=FALSE]
+ checkIdentical(nodeData(phyd.alt), data.frame(nodDt,
+ row.names=lab.int))
+}
+
test.addData.phylo4d <- function() {
# function(x, tip.data=NULL, node.data=NULL, all.data=NULL,
# pos=c("after", "before"), merge.data=TRUE, match.data=TRUE, ...)
Modified: pkg/inst/unitTests/runit.setAs-Methods.R
===================================================================
--- pkg/inst/unitTests/runit.setAs-Methods.R 2009-10-02 05:20:48 UTC (rev 685)
+++ pkg/inst/unitTests/runit.setAs-Methods.R 2009-10-06 04:48:15 UTC (rev 686)
@@ -110,7 +110,7 @@
# phylo tree in unknown order
phyd <- as(tr, "phylo4d")
- tdata(phyd) <- data.frame(x=1:5, row.names=tipLabels(phyd))
+ tipData(phyd) <- data.frame(x=1:5, row.names=tipLabels(phyd))
checkEquals(as(phyd, "phylo"), tr)
# ...now check for warning for unknown order
opt <- options(warn=3)
@@ -120,7 +120,7 @@
# phylo tree in cladewise order
tr.cladewise <- reorder(tr, "cladewise")
phyd <- as(tr.cladewise, "phylo4d")
- tdata(phyd) <- data.frame(x=1:5, row.names=tipLabels(phyd))
+ tipData(phyd) <- data.frame(x=1:5, row.names=tipLabels(phyd))
checkEquals(as(phyd, "phylo"), tr.cladewise)
# ...now check for warning for dropping data
opt <- options(warn=3)
@@ -130,7 +130,7 @@
# phylo tree in pruningwise order
tr.pruningwise <- reorder(tr, "pruningwise")
phyd <- as(tr.pruningwise, "phylo4d")
- tdata(phyd) <- data.frame(x=1:5, row.names=tipLabels(phyd))
+ tipData(phyd) <- data.frame(x=1:5, row.names=tipLabels(phyd))
checkEquals(as(phyd, "phylo"), tr.pruningwise)
}
Modified: pkg/man/tdata.Rd
===================================================================
--- pkg/man/tdata.Rd 2009-10-02 05:20:48 UTC (rev 685)
+++ pkg/man/tdata.Rd 2009-10-06 04:48:15 UTC (rev 686)
@@ -5,37 +5,62 @@
\alias{tdata<-}
\alias{tdata<-,phylo4d-method}
\alias{tdata<-,phylo4d,ANY-method}
+\alias{tipData}
+\alias{tipData-method}
+\alias{tipData,phylo4d-method}
+\alias{tipData<-}
+\alias{tipData<-,phylo4d,ANY-method}
+\alias{nodeData}
+\alias{nodeData-method}
+\alias{nodeData,phylo4d-method}
+\alias{nodeData<-}
+\alias{nodeData<-,phylo4d,ANY-method}
\title{Retrieving or updating tip and node data in phylo4d objects}
\description{
Method to retrieve or update tip, node or all data associated with a
phylogenetic tree stored as a phylo4d object
}
\usage{
- \S4method{tdata}{phylo4d}(x, type=c("tip", "internal", "all"),
- label.type=c("row.names", "column"), empty.columns=TRUE, \dots)
- \S4method{tdata}{phylo4d,ANY}(x, type = "tip", \dots) <- value
+ \S4method{tdata}{phylo4d}(x, type=c("all", "tip", "internal"),
+ label.type=c("row.names", "column"), empty.columns=TRUE)
+ \S4method{tdata}{phylo4d,ANY}(x, type = ("all", "tip", "internal"),
+ merge.data=TRUE, clear.all=FALSE, \dots) <- value
+ \S4method{tipData}{phylo4d}(x, \dots)
+ \S4method{tipData}{phylo4d,ANY}(x, \dots) <- value
+ \S4method{nodeData}{phylo4d}(x, \dots)
+ \S4method{nodeData}{phylo4d,ANY}(x, \dots) <- value
}
\arguments{
\item{x}{A \code{phylo4d} object}
+
\item{type}{The type of data to retrieve or update:
- \dQuote{\code{tip}} for data associated with tips,
- \dQuote{\code{internal}} for data associated with internal nodes,
- \dQuote{\code{all}} for data associated with tip and internal
- nodes.}
+ \dQuote{\code{all}} (default) for data associated with both tip
+ and internal nodes, \dQuote{\code{tip}} for data associated with
+ tips only, \dQuote{\code{internal}} for data associated with
+ internal nodes only.}
- \item{label.type}{How the tip/node labels from the tree be
+ \item{label.type}{How should the tip/node labels from the tree be
returned? \dQuote{\code{row.names}} returns them as row names of
- the data frame, \dQuote{\code{column}} returns the labels in the
- first column of the data frame. This options is useful in the case
- of missing (\code{NA}) or non-unique labels.}
+ the data frame, \dQuote{\code{column}} returns them in the first
+ column of the data frame. This options is useful in the case of
+ missing (\code{NA}) or non-unique labels.}
\item{empty.columns}{Should columns filled with \code{NA} be
returned?}
+
+ \item{merge.data}{if tip or internal node data are provided and data
+ already exists for the other type, this determines whether columns
+ with common names will be merged together (default TRUE). If
+ FALSE, columns with common names will be preserved separately,
+ with \dQuote{.tip} and \dQuote{.node} appended to the names. This
+ argument has no effect if tip and node data have no column names
+ in common, or if type=\dQuote{all}.}
- \item{\dots}{Further arguments similar to those used by
- \code{phylo4d} (e.g. \code{match.data}), see \link{phylo4d} for
- more details.}
+ \item{\dots}{For the tipData and nodeData accessors, further
+ arguments to be used by tdata. For the replacement forms, further
+ arguments to be used by \code{formatData} (e.g.
+ \code{match.data}), see \link{formatData} for more details.}
\item{value}{a data frame (or object to be coerced to one) to
replace the values associated with the nodes specified by the
@@ -59,7 +84,7 @@
\examples{
data(geospiza)
tdata(geospiza)
- tdata(geospiza, "tip") <- 1:nTips(geospiza)
+ tipData(geospiza) <- 1:nTips(geospiza)
tdata(geospiza)
\dontshow{data(geospiza)}
}
Modified: pkg/tests/misctests.R
===================================================================
--- pkg/tests/misctests.R 2009-10-02 05:20:48 UTC (rev 685)
+++ pkg/tests/misctests.R 2009-10-06 04:48:15 UTC (rev 686)
@@ -11,7 +11,7 @@
geospiza0 <-
- list(geospiza.tree=as(geospiza,"phylo"),geospiza.data=tdata(geospiza))
+ list(geospiza.tree=as(geospiza,"phylo"),geospiza.data=tipData(geospiza))
## push data back into list form as in geiger
t1 <- try(p1 <- phylo4d(geospiza0$geospiza.tree,geospiza0$geospiza.data))
@@ -92,7 +92,7 @@
nodeLabels(obj4) <- character(0)
obj5 <- obj1
-tdata(obj4) <- subset(tdata(obj4),select=sapply(tdata(obj4),class)=="numeric")
+tipData(obj4) <- subset(tipData(obj4),select=sapply(tipData(obj4),class)=="numeric")
treePlot(obj4)
Modified: pkg/tests/misctests.Rout.save
===================================================================
--- pkg/tests/misctests.Rout.save 2009-10-02 05:20:48 UTC (rev 685)
+++ pkg/tests/misctests.Rout.save 2009-10-06 04:48:15 UTC (rev 686)
@@ -32,7 +32,7 @@
>
>
> geospiza0 <-
-+ list(geospiza.tree=as(geospiza,"phylo"),geospiza.data=tdata(geospiza))
++ list(geospiza.tree=as(geospiza,"phylo"),geospiza.data=tipData(geospiza))
Warning messages:
1: In asMethod(object) : losing data while coercing phylo4d to phylo
2: In asMethod(object) : trees with unknown order may be unsafe in ape
@@ -467,7 +467,7 @@
> nodeLabels(obj4) <- character(0)
>
> obj5 <- obj1
-> tdata(obj4) <- subset(tdata(obj4),select=sapply(tdata(obj4),class)=="numeric")
+> tipData(obj4) <- subset(tipData(obj4),select=sapply(tipData(obj4),class)=="numeric")
>
> treePlot(obj4)
>
Modified: pkg/tests/phylo4dtests.R
===================================================================
--- pkg/tests/phylo4dtests.R 2009-10-02 05:20:48 UTC (rev 685)
+++ pkg/tests/phylo4dtests.R 2009-10-06 04:48:15 UTC (rev 686)
@@ -16,12 +16,12 @@
phylo4d(tree2, node.data=dat2) -> treed2 # OK tree labelled; has node data, no tip data
plot(treed2) # works with a warning about no tip data to plot
-tdata(treed2, empty.columns=FALSE) #returns empty 4-row data.frame
+tipData(treed2, empty.columns=FALSE) #returns empty 4-row data.frame
phylo4d(tree2, tip.data=tip.data, node.data=dat2) -> treed3 #node+tip data
plot(treed3) # works
-tdata(treed3) #works, but returns tips only
+tipData(treed3) #works, but returns tips only
tdata(treed3, "all")
print(tree)
Modified: pkg/tests/phylo4dtests.Rout.save
===================================================================
--- pkg/tests/phylo4dtests.Rout.save 2009-10-02 05:20:48 UTC (rev 685)
+++ pkg/tests/phylo4dtests.Rout.save 2009-10-06 04:48:15 UTC (rev 686)
@@ -37,13 +37,13 @@
> plot(treed2) # works with a warning about no tip data to plot
Warning message:
In treePlot(x, ...) : tree has no tip data to plot
-> tdata(treed2, empty.columns=FALSE) #returns empty 4-row data.frame
+> tipData(treed2, empty.columns=FALSE) #returns empty 4-row data.frame
data frame with 0 columns and 4 rows
>
> phylo4d(tree2, tip.data=tip.data, node.data=dat2) -> treed3 #node+tip data
>
> plot(treed3) # works
-> tdata(treed3) #works, but returns tips only
+> tipData(treed3) #works, but returns tips only
size
A 1
B 2
Modified: pkg/tests/phylosubtest.R
===================================================================
--- pkg/tests/phylosubtest.R 2009-10-02 05:20:48 UTC (rev 685)
+++ pkg/tests/phylosubtest.R 2009-10-06 04:48:15 UTC (rev 686)
@@ -10,6 +10,6 @@
tr <- read.tree(text="(((spA:0.2,(spB:0.1,spC:0.1):0.15):0.5,spD:0.7):0.2,spE:1):0.4;")
phyd <- as(tr, "phylo4d")
-tdata(phyd) <- 1:5
+tipData(phyd) <- 1:5
stopifnot(identical(phyd at data,subset(phyd,tipLabels(phyd))@data))
More information about the Phylobase-commits
mailing list