[Phylobase-commits] r654 - pkg/inst/unitTests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Sep 21 08:15:10 CEST 2009
Author: regetz
Date: 2009-09-21 08:15:10 +0200 (Mon, 21 Sep 2009)
New Revision: 654
Added:
pkg/inst/unitTests/runit.class-phylo4d.R
Removed:
pkg/inst/unitTests/runit.phylo.R
pkg/inst/unitTests/runit.phylo4d.R
Modified:
pkg/inst/unitTests/runit.class-phylo4.R
pkg/inst/unitTests/runit.methods-phylo4d.R
pkg/inst/unitTests/runit.setAs-Methods.R
pkg/inst/unitTests/runit.treewalk.R
Log:
refactored unit tests to better mirror pkg/R file structure, reduce
redundancy, and use more consistent test objects for easier maintenance;
also added some new tests and augmented existing tests
Modified: pkg/inst/unitTests/runit.class-phylo4.R
===================================================================
--- pkg/inst/unitTests/runit.class-phylo4.R 2009-09-17 01:52:17 UTC (rev 653)
+++ pkg/inst/unitTests/runit.class-phylo4.R 2009-09-21 06:15:10 UTC (rev 654)
@@ -34,22 +34,51 @@
checkException(phylo4(edge, annote="invalid annotation"))
}
+# note: this method mostly just wraps phylo->phylo4 coercion, which is
+# tested more thoroughly in runit.setAs-methods.R; focus here is on
+# annote and check.node.labels arguments
test.phylo4.phylo <- function() {
- tr <- read.tree(text="(((t1:0.2,(t2:0.1,t3:0.1)n4:0.15)n3:0.5,t4:0.7)n2:0.2,t5:1)n1:0.4;")
+ tr <- read.tree(text="(((t1:0.2,(t2:0.1,t3:0.1):0.15):0.5,t4:0.7):0.2,t5:1):0.4;")
+
+ ##
+ ## annote
+ ##
+
annote <- list(x="annotation")
- phy <- phylo4(tr, check.node.labels="keep", annote=annote)
- checkIdentical(tr$tip.label, unname(tipLabels(phy)))
- checkIdentical(tr$node.label, unname(nodeLabels(phy)))
- checkIdentical("unknown", edgeOrder(phy))
+ phy <- phylo4(tr, annote=annote)
checkIdentical(annote, phy at annote)
- # test preservation of order attribute
- phy <- phylo4(reorder(tr, "cladewise"))
- checkIdentical("preorder", edgeOrder(phy))
- phy <- phylo4(reorder(tr, "pruningwise"))
- checkIdentical("pruningwise", edgeOrder(phy))
+ ##
+ ## check.node.labels
+ ##
+ # case 0: no node labels
+ phy <- phylo4(tr)
+ checkTrue(!hasNodeLabels(phy))
+
+ # case 1: keep unique character labels
+ tr$node.label <- paste("n", 1:4, sep="")
+ phy <- phylo4(tr, check.node.labels="keep")
+ checkIdentical(tr$node.label, unname(nodeLabels(phy)))
+ # keeping node labels should be the default
+ checkIdentical(phy, phylo4(tr))
+
+ # case 2: keep unique number-like character labels
+ tr$node.label <- as.character(1:4)
+ phy <- phylo4(tr, check.node.labels="keep")
+ checkIdentical(tr$node.label, unname(nodeLabels(phy)))
+
+ # case 3: keep unique numeric labels, but convert to character
+ tr$node.label <- as.numeric(1:4)
+ phy <- phylo4(tr, check.node.labels="keep")
+ checkIdentical(as.character(tr$node.label), unname(nodeLabels(phy)))
+
+ # case 4: must drop non-unique labels
+ tr$node.label <- rep("x", 4)
+ checkException(phylo4(tr))
+ checkException(phylo4(tr, check.node.labels="keep"))
# test dropping node labels
phy <- phylo4(tr, check.node.labels="drop")
- checkIdentical(unname(nodeLabels(phy)), rep(NA_character_, nNodes(phy)))
+ checkTrue(!hasNodeLabels(phy))
+
}
Copied: pkg/inst/unitTests/runit.class-phylo4d.R (from rev 650, pkg/inst/unitTests/runit.phylo4d.R)
===================================================================
--- pkg/inst/unitTests/runit.class-phylo4d.R (rev 0)
+++ pkg/inst/unitTests/runit.class-phylo4d.R 2009-09-21 06:15:10 UTC (rev 654)
@@ -0,0 +1,307 @@
+#
+# --- Test class-phylo4d.R ---
+#
+
+# create ape::phylo version of a simple tree for testing
+nwk <- "((t1:0.1,t2:0.2)n7:0.7,(t3:0.3,(t4:0.4,t5:0.5)n9:0.9)n8:0.8)n6:0.6;"
+tr <- read.tree(text=nwk)
+
+# create analogous phylo4 object with a full complement of valid slots
+ancestor <- as.integer(c(6,7,7,6,8,NA,8,9,9))
+descendant <- as.integer(c(7,1,2,8,3,6,9,4,5))
+edge <- cbind(ancestor, descendant)
+nid.tip <- 1:5
+nid.int <- 6:9
+nid.all <- c(nid.tip, nid.int)
+lab.tip <- paste("t", nid.tip, sep="")
+lab.int <- paste("n", nid.int, sep="")
+lab.all <- c(lab.tip, lab.int)
+elen <- descendant/10
+elab <- paste("e", ancestor, descendant, sep="-")
+phy <- phylo4(x=edge, tip.label=lab.tip, node.label=lab.int,
+ edge.length=elen, edge.label=elab)
+
+# create altered version such that each slot is out of order with
+# respect to all others; methods should be able to handle this
+phy.alt <- phy
+phy.alt at tip.label <- rev(phy at tip.label)
+phy.alt at node.label <- rev(phy at node.label)
+phy.alt at edge <- phy at edge[c(6:9, 1:5), ]
+phy.alt at edge.length <- phy at edge.length[c(7:9, 1:6)]
+phy.alt at edge.label <- phy at edge.label[c(8:9, 1:7)]
+
+# create data to add to phylo4 to create phylo4d, but with data rows out
+# of order
+set.seed(1)
+nid.tip.r <- sample(nid.tip)
+nid.int.r <- sample(nid.int)
+nid.all.r <- sample(c(nid.tip, nid.int))
+allDt <- data.frame(a=letters[nid.all.r], b=10*nid.all.r)
+tipDt <- data.frame(c=letters[nid.tip.r], d=10*nid.tip.r)
+nodDt <- data.frame(c=letters[nid.int.r], e=10*nid.int.r)
+## set row.names as numeric node IDs (may be changed in tests below)
+row.names(allDt) <- nid.all.r
+row.names(tipDt) <- nid.tip.r
+row.names(nodDt) <- nid.int.r
+
+#-----------------------------------------------------------------------
+
+test.phylo4d.phylo4 <- function() {
+
+ ## case 1: add data matching only on row position
+ row.names(allDt) <- NULL
+ row.names(tipDt) <- NULL
+ row.names(nodDt) <- NULL
+
+ ## these should fail because row.names don't match nodes
+ checkException(phylo4d(phy.alt, tip.data=tipDt, rownamesAsLabels=TRUE))
+ checkException(phylo4d(phy.alt, node.data=nodDt))
+
+ ## brute force: no matching; with tip data
+ phyd <- phylo4d(phy.alt, tip.data=tipDt, match.data=FALSE)
+ checkEquals(phyd at tip.data, data.frame(tipDt,
+ row.names=as.character(nid.tip)))
+ checkEquals(tdata(phyd, "tip"), data.frame(tipDt,
+ row.names=lab.tip))
+
+ ## brute force: no matching; with node data
+ phyd <- phylo4d(phy.alt, node.data=nodDt, match.data=FALSE)
+ checkEquals(phyd at node.data, data.frame(nodDt,
+ row.names=as.character(nid.int)))
+ checkEquals(tdata(phyd, "internal"), data.frame(nodDt,
+ row.names=lab.int))
+
+ ## brute force: no matching; with all.data
+ phyd <- phylo4d(phy.alt, all.data=allDt, match.data=FALSE)
+ # TODO: these fail b/c all.data option creates numeric row.names
+ # whereas tip.data and node.data options create character row.names
+ #checkEquals(phyd at tip.data, data.frame(allDt,
+ # row.names=as.character(nid.all))[nid.tip,])
+ #checkEquals(phyd at node.data, data.frame(allDt,
+ # row.names=as.character(nid.all))[nid.int,])
+ checkEquals(tdata(phyd, "all"), data.frame(allDt,
+ row.names=lab.all))
+
+ ## brute force: no matching; with tip & node data
+ ## no merging (data names don't match)
+ phyd <- phylo4d(phy.alt, tip.data=tipDt["d"], node.data=nodDt["e"],
+ match.data=FALSE)
+ checkEquals(phyd at tip.data, data.frame(tipDt["d"], e=NA_real_,
+ row.names=as.character(nid.tip)))
+ checkEquals(tdata(phyd, "tip"), data.frame(tipDt["d"], e=NA_real_,
+ row.names=lab.tip))
+ checkEquals(phyd at node.data, data.frame(d=NA_real_, nodDt["e"],
+ row.names=as.character(nid.int)))
+ checkEquals(tdata(phyd, "internal"), data.frame(d=NA_real_, nodDt["e"],
+ row.names=lab.int))
+
+ ## brute force: no matching; with tip & node data
+ ## merging (common data names)
+ phyd <- phylo4d(phy.alt, tip.data=tipDt["c"], node.data=nodDt["c"],
+ match.data=FALSE)
+ checkEquals(phyd at tip.data, data.frame(c=factor(tipDt$c,
+ levels=letters[nid.all]), row.names=as.character(nid.tip)))
+ checkEquals(phyd at node.data, data.frame(c=factor(nodDt$c,
+ levels=letters[nid.all]), row.names=as.character(nid.int)))
+ checkEquals(tdata(phyd, "tip"), data.frame(c=factor(tipDt$c,
+ levels=letters[nid.all]), row.names=lab.tip))
+ checkEquals(tdata(phyd, "internal"), data.frame(c=factor(nodDt$c,
+ levels=letters[nid.all]), row.names=lab.int))
+
+ ## case 2: add data matching on numeric (node ID) row.names
+ row.names(allDt) <- nid.all.r
+ row.names(tipDt) <- nid.tip.r
+ row.names(nodDt) <- nid.int.r
+
+ ## match with node numbers, tip data
+ phyd <- phylo4d(phy.alt, tip.data=tipDt)
+ checkEquals(phyd at tip.data, data.frame(tipDt[order(nid.tip.r),],
+ row.names=as.character(nid.tip)))
+ checkEquals(tdata(phyd, "tip"), data.frame(tipDt[order(nid.tip.r),],
+ row.names=lab.tip))
+
+ ## match with node numbers, node data
+ phyd <- phylo4d(phy.alt, node.data=nodDt)
+ checkEquals(phyd at node.data, data.frame(nodDt[order(nid.int.r),],
+ row.names=as.character(nid.int)))
+ checkEquals(tdata(phyd, "internal"), data.frame(nodDt[order(nid.int.r),],
+ row.names=lab.int))
+
+ ## match with node numbers, tip & node data, no merge
+ phyd <- phylo4d(phy.alt, tip.data=tipDt["d"], node.data=nodDt["e"])
+ checkEquals(phyd at tip.data, data.frame(d=tipDt[order(nid.tip.r), "d"],
+ e=NA_real_, row.names=as.character(nid.tip)))
+ checkEquals(tdata(phyd, "tip"), data.frame(d=tipDt[order(nid.tip.r), "d"],
+ e=NA_real_, row.names=lab.tip))
+ checkEquals(phyd at node.data, data.frame(d=NA_real_,
+ e=nodDt[order(nid.int.r), "e"], row.names=as.character(nid.int)))
+ checkEquals(tdata(phyd, "internal"), data.frame(d=NA_real_,
+ e=nodDt[order(nid.int.r), "e"], row.names=lab.int))
+
+ ## match with node numbers, tip & all data
+ phyd <- phylo4d(phy.alt, tip.data=tipDt, all.data=allDt)
+ merged <- data.frame(merge(allDt[order(nid.all.r),],
+ tipDt[order(nid.tip.r),], all=TRUE, by=0)[-1])
+ checkEquals(phyd at tip.data, data.frame(merged[nid.tip,],
+ row.names=as.character(nid.tip)))
+ checkEquals(phyd at node.data, data.frame(merged[nid.int,],
+ row.names=as.character(nid.int)))
+ checkEquals(tdata(phyd, "all"), data.frame(merged, row.names=lab.all))
+
+ ## match with node numbers, node & all data
+ phyd <- phylo4d(phy.alt, node.data=nodDt, all.data=allDt)
+ merged <- data.frame(merge(allDt[order(nid.all.r),],
+ nodDt[order(nid.int.r),], all=TRUE, by=0)[-1])
+ # TODO: need the next line because factor node data are converted
+ # to character when supplied along with tip data (no merging)
+ merged$c <- as.character(merged$c)
+ checkEquals(phyd at tip.data, data.frame(merged[nid.tip,],
+ row.names=as.character(nid.tip)))
+ checkEquals(phyd at node.data, data.frame(merged[nid.int,],
+ row.names=as.character(nid.int)))
+ checkEquals(tdata(phyd, "all"), data.frame(merged, row.names=lab.all))
+
+ ## match with node numbers, tip, node & all data
+ phyd <- phylo4d(phy.alt, tip.data=tipDt, node.data=nodDt, all.data=allDt)
+ # merge alldata with tipdata
+ merged <- data.frame(merge(allDt[order(nid.all.r),],
+ tipDt[order(nid.tip.r),], all=TRUE, by=0)[-1])
+ # ...now merge this with nodedata
+ merged <- data.frame(merge(merged, nodDt[order(nid.int.r),], all=TRUE,
+ by=0, suffix=c("", ".1"))[-1])
+ # TODO: need the next line because factor node data are converted
+ # to character when supplied along with tip data (no merging)
+ merged$c.1 <- as.character(merged$c.1)
+ checkEquals(tdata(phyd, "all"), data.frame(merged, row.names=lab.all))
+ # TODO: need the next line because common column names across tip
+ # and node data are preserved in original form in the individual
+ # data slots, but not in the tdata(x, "all") output
+ names(merged)[names(merged)=="c.1"] <- "c"
+ checkEquals(tdata(phyd, "tip"), data.frame(merged[nid.tip,],
+ row.names=lab.tip, check.names=FALSE))
+ checkEquals(tdata(phyd, "internal"), data.frame(merged[nid.int,],
+ row.names=lab.int, check.names=FALSE))
+ checkEquals(phyd at tip.data, data.frame(merged[nid.tip,],
+ row.names=as.character(nid.tip), check.names=FALSE))
+ checkEquals(phyd at node.data, data.frame(merged[nid.int,],
+ row.names=as.character(nid.int), check.names=FALSE))
+
+ ## case 3: add data matching on character (label) row.names for tips
+ row.names(tipDt) <- c(lab.tip, lab.int)[nid.tip.r]
+ row.names(nodDt) <- c(lab.tip, lab.int)[nid.int.r]
+
+ ## match with names, tip data
+ phyd <- phylo4d(phy.alt, tip.data=tipDt)
+ checkEquals(phyd at tip.data, data.frame(tipDt[order(nid.tip.r),],
+ row.names=as.character(nid.tip)))
+ checkEquals(tdata(phyd, "tip"), data.frame(tipDt[order(nid.tip.r),],
+ row.names=lab.tip))
+
+ ## case 4: add data matching on mixed rowname types (for tips and
+ ## for internal nodes)
+ row.names(allDt)[match(nid.tip.r, nid.all.r)] <- lab.tip[nid.tip.r]
+ row.names(allDt)[match(nid.int.r, nid.all.r)] <- nid.int.r
+
+ ## match with names for tips and numbers for nodes with all data
+ phyd <- phylo4d(phy.alt, all.data=allDt)
+ checkEquals(tdata(phyd, "all"), data.frame(allDt[match(nid.all,
+ nid.all.r),], row.names=lab.all))
+ checkEquals(tdata(phyd, "tip"), data.frame(allDt[match(nid.tip,
+ nid.all.r),], row.names=lab.tip))
+ checkEquals(tdata(phyd, "internal"), data.frame(allDt[match(nid.int,
+ nid.all.r),], row.names=lab.int))
+ checkEquals(phyd at tip.data, data.frame(allDt[match(nid.tip, nid.all.r),],
+ row.names=as.character(nid.tip)))
+ checkEquals(phyd at node.data, data.frame(allDt[match(nid.int, nid.all.r),],
+ row.names=as.character(nid.int)))
+
+}
+
+test.phylo4d.matrix <- function() {
+}
+
+# note: this method mostly does phylo4(phylo), then phylo4d(phylo4),
+# then addData methods, which are tested more thoroughly elsewhere;
+# focus here is on metadata and check.node.labels="asdata" arguments
+test.phylo4d.phylo <- function() {
+ # function(x, tip.data=NULL, node.data=NULL, all.data=NULL,
+ # check.node.labels=c("keep", "drop", "asdata"), annote=list(),
+ # metadata=list(), ...)
+
+ # show that method basically just wraps phylo4d("phylo4")
+ phyd.tr <- phylo4d(tr, tip.data=tipDt, node.data=nodDt,
+ all.data=allDt, match.data=TRUE, merge.data=TRUE)
+ checkTrue(class(phyd.tr)=="phylo4d")
+ phyd.phy <- phylo4d(phy.alt, tip.data=tipDt, node.data=nodDt,
+ all.data=allDt, match.data=TRUE, merge.data=TRUE)
+ # reorder for edge order consistency, then test each slot (except
+ # edge labels, b/c phylo object has none)
+ phyd.tr <- reorder(phyd.tr)
+ phyd.phy <- reorder(phyd.phy)
+ checkIdentical(edges(phyd.tr), edges(phyd.phy))
+ checkIdentical(edgeLength(phyd.tr), edgeLength(phyd.phy))
+ checkIdentical(nNodes(phyd.tr), nNodes(phyd.phy))
+ checkIdentical(tipLabels(phyd.tr), tipLabels(phyd.phy))
+ checkIdentical(nodeLabels(phyd.tr), nodeLabels(phyd.phy))
+ checkIdentical(edgeOrder(phyd.tr), edgeOrder(phyd.phy))
+ checkIdentical(phyd.tr at annote, phyd.phy at annote)
+ # other misc checks
+ checkEquals(phylo4d(phylo4(tr)), phylo4d(tr))
+ checkEquals(phylo4d(phylo4(tr, check.node.labels="drop")),
+ phylo4d(tr, check.node.labels="drop"))
+
+ ##
+ ## metadata
+ ##
+
+ metadata <- list(x="metadata")
+ phyd <- phylo4d(tr, metadata=metadata)
+ checkIdentical(metadata, phyd at metadata)
+
+ ##
+ ## check.node.labels
+ ##
+
+ # case 0: no node labels
+ tr$node.label <- NULL
+ phyd <- phylo4d(tr)
+ checkTrue(!hasNodeLabels(phyd))
+
+ # case 1: can't currently keep arbitrary character labels as data
+ tr$node.label <- paste("n", 1:4, sep="")
+ phyd <- phylo4d(tr, check.node.labels="asdata")
+ checkTrue(!hasNodeLabels(phyd))
+ checkTrue(all(is.na(tdata(phyd, "internal")$labelValues)))
+ # the above should've produced a warning:
+ opt <- options(warn=3)
+ checkException(phylo4d(tr, check.node.labels="asdata"))
+ options(opt)
+
+ # case 2: convert number-like characters labels to numeric data
+ tr$node.label <- as.character(1:4)
+ phyd <- phylo4d(tr, check.node.labels="asdata")
+ checkTrue(!hasNodeLabels(phyd))
+ checkIdentical(tdata(phyd, "internal")$labelValues,
+ as.numeric(tr$node.label))
+
+ # case 3: convert numeric labels to numeric data
+ tr$node.label <- as.numeric(1:4)
+ phyd <- phylo4d(tr, check.node.labels="asdata")
+ checkTrue(!hasNodeLabels(phyd))
+ checkIdentical(tdata(phyd, "internal")$labelValues, tr$node.label)
+
+ # case 4: non-unique labels can be converted to data
+ tr$node.label <- rep(99, 4)
+ checkException(phylo4d(tr))
+ phyd <- phylo4d(tr, check.node.labels="asdata")
+ checkTrue(!hasNodeLabels(phyd))
+ checkIdentical(tdata(phyd, "internal")$labelValues, tr$node.label)
+
+}
+
+## phylo4d->phylo4d is currently unallowed
+test.phylo4d.phylo4d <- function() {
+ phyd <- phylo4d(phy)
+ checkException(phylo4d(phyd))
+}
+
Modified: pkg/inst/unitTests/runit.methods-phylo4d.R
===================================================================
--- pkg/inst/unitTests/runit.methods-phylo4d.R 2009-09-17 01:52:17 UTC (rev 653)
+++ pkg/inst/unitTests/runit.methods-phylo4d.R 2009-09-21 06:15:10 UTC (rev 654)
@@ -1,111 +1,111 @@
#
-# --- Test methods-phylo4.R ---
+# --- Test methods-phylo4d.R ---
#
-# Create sample tree for testing (ape::phylo object)
-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;")
-phy <- as(tr, "phylo4")
-## label node ancestr edge.length node.type
-## 6 <NA> 6 NA 0.40 root
-## 7 <NA> 7 6 0.20 internal
-## 8 <NA> 8 7 0.50 internal
-## 9 <NA> 9 8 0.15 internal
-## 1 spA 1 8 0.20 tip
-## 2 spB 2 9 0.10 tip
-## 3 spC 3 9 0.10 tip
-## 4 spD 4 7 0.70 tip
-## 5 spE 5 6 1.00 tip
-allDt <- data.frame(a=rnorm(nTips(phy)+nNodes(phy)))
-tipDt <- data.frame(b=letters[1:nTips(phy)], c=rnorm(nTips(phy)))
-nodDt <- data.frame(d=rnorm(nNodes(phy)))
-rownames(tipDt) <- 1:nTips(phy)
-rownames(nodDt) <- (nTips(phy)+1):(nTips(phy)+nNodes(phy))
-rownames(allDt) <- 1:(nTips(phy)+nNodes(phy))
+# create phylo4 object with a full complement of valid slots
+ancestor <- as.integer(c(6,7,7,6,8,NA,8,9,9))
+descendant <- as.integer(c(7,1,2,8,3,6,9,4,5))
+edge <- cbind(ancestor, descendant)
+nid.tip <- 1:5
+nid.int <- 6:9
+nid.all <- c(nid.tip, nid.int)
+lab.tip <- paste("t", nid.tip, sep="")
+lab.int <- paste("n", nid.int, sep="")
+lab.all <- c(lab.tip, lab.int)
+elen <- descendant/10
+elab <- paste("e", ancestor, descendant, sep="-")
+phy <- phylo4(x=edge, tip.label=lab.tip, node.label=lab.int,
+ edge.length=elen, edge.label=elab)
+
+# now create phylo4d by adding data (with node IDs as row.names)
+allDt <- data.frame(a=letters[nid.all], b=10*nid.all)
+tipDt <- data.frame(c=letters[nid.tip], d=10*nid.tip)
+nodDt <- data.frame(c=letters[nid.int], e=10*nid.int)
+row.names(allDt) <- nid.all
+row.names(tipDt) <- nid.tip
+row.names(nodDt) <- nid.int
phyd <- phylo4d(phy, tip.data=tipDt, node.data=nodDt, all.data=allDt,
match.data=TRUE, merge.data=TRUE)
+# create altered version such that each slot is out of order with
+# respect to all others; methods should be able to handle this
+phyd.alt <- phyd
+phyd.alt at tip.label <- rev(phyd at tip.label)
+phyd.alt at node.label <- rev(phyd at node.label)
+phyd.alt at edge <- phyd at edge[c(6:9, 1:5), ]
+phyd.alt at edge.length <- phyd at edge.length[c(7:9, 1:6)]
+phyd.alt at edge.label <- phyd at edge.label[c(8:9, 1:7)]
+nid.tip.r <- c(2,5,4,3,1)
+nid.int.r <- c(8,7,9,6)
+nid.all.r <- c(nid.tip.r, nid.int.r)
+phyd.alt at tip.data <- phyd at tip.data[rank(nid.tip.r), ]
+phyd.alt at node.data <- phyd at node.data[rank(nid.int.r), ]
+#-----------------------------------------------------------------------
+
test.tdata.phylo4d <- function() {
+DEACTIVATED("turned off until tdata can handle out-of-order rows in data slots")
# function(x, type=c("tip", "internal", "allnode"),
# label.type=c("row.names","column"), empty.columns=TRUE, ...)
- compDt <- cbind(tipLabels(phy), a=allDt[1:nTips(phy), ], tipDt)
- colnames(compDt)[1] <- "label"
- checkIdentical(tdata(phyd, type="tip", label.type="column",
- empty.columns=FALSE), compDt)
- phyd <- reorder(phyd, "preorder")
- checkIdentical(tdata(phyd, label.type="column",
- empty.columns=FALSE), compDt)
- phyd <- reorder(phyd, "postorder")
- checkIdentical(tdata(phyd, label.type="column",
- empty.columns=FALSE), compDt)
-}
+ # TODO: flesh out these tests!
+ tip.data <- tdata(phyd.alt, type="tip")
+ checkTrue(is.data.frame(tip.data))
+ int.data <- tdata(phyd.alt, type="internal")
+ checkTrue(is.data.frame(int.data))
+ all.data <- tdata(phyd.alt, type="all")
+ checkTrue(is.data.frame(all.data))
-test.Replace.tdata.phylo4d <- function() {
- # function(object, type = c("tip", "internal", "allnode"), ...,
- # value)
+ #
+ # label.type
+ #
- op <- options()
- options(stringsAsFactors=FALSE)
+ # label.type="row.names"
+ compDt <- data.frame(allDt[nid.tip, ], tipDt, row.names=lab.tip)
+ checkIdentical(tdata(phyd.alt, type="tip", label.type="row.names",
+ empty.columns=FALSE), compDt)
+ # label.type="column"
+ compDt <- cbind(label=lab.tip, allDt[nid.tip, ], tipDt,
+ row.names=as.character(nid.tip))
+ checkIdentical(tdata(phyd.alt, type="tip", label.type="column",
+ empty.columns=FALSE), compDt)
- newTipDt <- data.frame(a=1:nTips(phy), b=10+(1:nTips(phy)))
- rownames(newTipDt) <- nodeId(phy, "tip")
- newNodDt <- data.frame(c=1:nNodes(phy), d=10+(1:nNodes(phy)))
- rownames(newNodDt) <- nodeId(phy, "internal")
- newAllDt <- data.frame(e=1:(nTips(phy)+nNodes(phy)))
- rownames(newAllDt) <- nodeId(phy, "all")
+ #
+ # empty.columns
+ #
- ## default ordering
- tmpTip <- tmpNod <- tmpAll <- phyd
- tdata(tmpTip, type="tip") <- newTipDt
- compTip <- data.frame(label=tipLabels(tmpTip), newTipDt)
- checkIdentical(tdata(tmpTip, type="tip", label.type="column"), compTip)
+ #
+ # misc tests
+ #
- tdata(tmpNod, type="internal") <- newNodDt
- compNod <- data.frame(label=nodeId(tmpNod, "internal"), newNodDt)
- rownames(compNod) <- as.character(nodeId(tmpNod, "internal"))
- checkIdentical(tdata(tmpNod, type="internal", label.type="column",
- empty.columns=FALSE), compNod)
+ # check with other tree orderings
+ phyd.pre <- reorder(phyd.alt, "preorder")
+ checkIdentical(tdata(phyd.pre, label.type="column",
+ empty.columns=FALSE), compDt)
+ phyd.post <- reorder(phyd.alt, "postorder")
+ checkIdentical(tdata(phyd.post, label.type="column",
+ empty.columns=FALSE), compDt)
- tdata(tmpAll, type="all") <- newAllDt
- compAll <- data.frame(label=c(tipLabels(tmpNod), nodeId(tmpNod, "internal")),
- newAllDt)
- checkIdentical(tdata(tmpAll, type="all", label.type="column"), compAll)
+}
- ## Preorder
- tmpTip <- tmpNod <- tmpAll <- reorder(phyd, "preorder")
- tdata(tmpTip, type="tip") <- newTipDt
- compTip <- data.frame(label=tipLabels(tmpTip), newTipDt)
- checkIdentical(tdata(tmpTip, type="tip", label.type="column"), compTip)
+## currently just basic tests of tdata replacement; using out-of-order
+## data, but only with default args (e.g. row.name-nodeID matching)
+test.Replace.tdata.phylo4d <- function() {
- tdata(tmpNod, type="internal") <- newNodDt
- compNod <- data.frame(label=nodeId(tmpNod, "internal"), newNodDt)
- rownames(compNod) <- as.character(nodeId(tmpNod, "internal"))
- checkIdentical(tdata(tmpNod, type="internal", label.type="column",
- empty.columns=FALSE), compNod)
+ ## 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))
- tdata(tmpAll, type="all") <- newAllDt
- compAll <- data.frame(label=c(tipLabels(tmpNod), nodeId(tmpNod, "internal")),
- newAllDt)
- checkIdentical(tdata(tmpAll, type="all", label.type="column"), compAll)
+ ## 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))
- ## Postorder
- tmpTip <- tmpNod <- tmpAll <- reorder(phyd, "postorder")
- tdata(tmpTip, type="tip") <- newTipDt
- compTip <- data.frame(label=tipLabels(tmpTip), newTipDt)
- checkIdentical(tdata(tmpTip, type="tip", label.type="column"), compTip)
-
- tdata(tmpNod, type="internal") <- newNodDt
- compNod <- data.frame(label=nodeId(tmpNod, "internal"), newNodDt)
- rownames(compNod) <- as.character(nodeId(tmpNod, "internal"))
- checkIdentical(tdata(tmpNod, type="internal", label.type="column"), compNod)
-
- tdata(tmpAll, type="all") <- newAllDt
- compAll <- data.frame(label=c(tipLabels(tmpNod), nodeId(tmpNod, "internal")),
- newAllDt)
- checkIdentical(tdata(tmpAll, type="all", label.type="column"), compAll)
-
- options(op)
+ ## 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,
+ row.names=lab.all))
}
test.addData.phylo4d <- function() {
Deleted: pkg/inst/unitTests/runit.phylo.R
===================================================================
--- pkg/inst/unitTests/runit.phylo.R 2009-09-17 01:52:17 UTC (rev 653)
+++ pkg/inst/unitTests/runit.phylo.R 2009-09-21 06:15:10 UTC (rev 654)
@@ -1,101 +0,0 @@
-#
-# --- Test ape import and handling ---
-#
-
-# Create sample tree for testing (ape::phylo object)
-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;")
-
-test.phylo.to.phylo4.simple <- function() {
- phy <- as(tr, "phylo4")
- checkTrue(class(phy)=="phylo4")
- checkEquals(phy, phylo4(tr))
-}
-
-test.phylo.to.phylo4d.simple <- function() {
- phyd <- as(tr, "phylo4d")
- checkTrue(class(phyd)=="phylo4d")
- checkEquals(phyd, phylo4d(tr))
-}
-
-test.roundtrip.phylo.to.phylo4 <- function() {
- phy <- as(tr, "phylo4")
- checkEquals(tr, as(phy, "phylo"))
-}
-
-test.roundtrip.phylo.to.phylo4d <- function() {
- phyd <- as(tr, "phylo4d")
- checkEquals(tr, as(phyd, "phylo"))
-}
-
-test.phylo.import.with.character.node.labels <- function() {
-
- # case 1: unique non-numeric characters
- tr$node.label <- paste("n", 1:4, sep="")
-
- # import to phylo4
- tmp <- phylo4(tr, check.node.labels="keep")
- checkEquals(tmp, phylo4(tr))
-
- # import to phylo4d
- tmp <- phylo4d(tr, check.node.labels="keep")
- checkEquals(tmp, phylo4d(tr))
- checkEquals(unname(nodeLabels(tmp)), tr$node.label)
- checkEquals(nrow(tdata(tmp)), 0)
-
- # case 2: unique number-like characters
- tr$node.label <- as.character(1:4)
-
- # import to phylo4
- tmp <- phylo4(tr, check.node.labels="keep")
- checkEquals(tmp, phylo4(tr))
-
- # import to phylo4d
- tmp <- phylo4d(tr, check.node.labels="keep")
- checkEquals(tmp, phylo4d(tr))
- checkEquals(unname(nodeLabels(tmp)), tr$node.label)
- checkEquals(nrow(tdata(tmp)), 0)
-
- # case 3: non-unique characters
- tr$node.label <- rep("x", 4)
-
- # import to phylo4
- checkException(phylo4(tr))
- checkException(phylo4(tr, check.node.labels="keep"))
-
- # import to phylo4d
- checkException(phylo4d(tr))
- checkException(phylo4d(tr, check.node.labels="keep"))
-
-}
-
-test.phylo.import.with.numeric.node.labels <- function() {
-
- tr$node.label <- 1:4
-
- # keeping node labels should be the default
- checkEquals(phylo4(tr), phylo4(tr, check.node.labels="keep"))
- checkEquals(phylo4d(tr), phylo4d(tr, check.node.labels="keep"))
-
- # import to phylo4, dropping node labels
- tmp <- phylo4(tr, check.node.labels="drop")
- checkTrue(all(is.na(tmp at node.label)))
-
- # import to phylo4d, dropping node labels
- tmp <- phylo4d(tr, check.node.labels="drop")
- checkTrue(all(is.na(tmp at node.label)))
- checkEquals(nrow(tdata(tmp)), 0)
-
- # import to phylo4d, converting node labels to data
- tmp <- phylo4d(tr, check.node.labels="asdata")
- checkEquals(tdata(tmp, "internal", label.type="column")$labelValues,
- 1:4)
- checkTrue(all(is.na(tmp at node.label)))
-}
-
-test.phylo.import.2tips <- function() {
- tr2 <- drop.tip(tr, 3:Ntip(tr))
- phy2 <- as(tr2, "phylo4")
- checkEquals(nTips(as(tr2, "phylo4")), 2)
- checkEquals(nNodes(as(tr2, "phylo4")), 1)
-}
-
Deleted: pkg/inst/unitTests/runit.phylo4d.R
===================================================================
--- pkg/inst/unitTests/runit.phylo4d.R 2009-09-17 01:52:17 UTC (rev 653)
+++ pkg/inst/unitTests/runit.phylo4d.R 2009-09-21 06:15:10 UTC (rev 654)
@@ -1,136 +0,0 @@
-test.Phylo4d.bruteforce <- function() {
- data(geospiza_raw)
- ## using the raw data
- tr <- geospiza_raw$tree
- tr <- as(tr, "phylo4")
-
- ## creating some data with rownames matching tip numbers
- tDt <- data.frame(testData1 = 1:nTips(tr),
- testData2 = (1:nTips(tr))*2)
- tDt <- tDt[sample(1:nrow(tDt)),]
-
- nDt <- data.frame(testData1 = 1:nNodes(tr))
- nDt <- nDt[sample(1:nrow(nDt)),]
-
- aDt <- data.frame(testData1 = 1:(nNodes(tr)+nTips(tr)))
- aDt <- aDt[sample(1:nrow(aDt)) ,, drop=FALSE]
-
- ## brute force: no matching; with tip data
- xx <- phylo4d(tr, tip.data=tDt, match.data=FALSE)
- checkEquals(xx at tip.data[,1], tDt[,1])
- checkEquals(tdata(xx)[,1], tDt[,1])
-
- ## brute force: no matching; with node data
- yy <- phylo4d(tr, node.data=nDt, match.data=FALSE)
- checkEquals(yy at node.data[,1], nDt)
- checkEquals(tdata(yy, "internal")[,1], nDt)
-
- ## brute force: no matching; with all.data
- zz <- phylo4d(tr, all.data=aDt, match.data=FALSE)
- checkEquals(zz at tip.data[,1], aDt[1:nTips(tr),1])
- checkEquals(zz at node.data[,1], aDt[(nTips(tr)+1):(nTips(tr)+nNodes(tr)),1])
- checkEquals(tdata(zz, "all")[,1], aDt[,1])
-
- ## brute force: no matching; with tip & node data
- ## no merging (data names don't match)
- xx <- phylo4d(tr, tip.data=tDt, node.data=nDt, match.data=FALSE)
- checkEquals(xx at tip.data[,1], tDt[,1])
- checkEquals(xx at node.data[,3], nDt)
- checkEquals(tdata(xx, "tip")[,1], tDt[,1])
- checkEquals(tdata(xx, "internal")[,3], nDt)
-
- ## brute force: no matching; with tip & node data
- ## merging
- nDt <- data.frame(nDt)
- names(nDt) <- names(tDt)[1]
- xx <- phylo4d(tr, tip.data=tDt[,1,drop=F], node.data=nDt, match.data=FALSE)
- checkEquals(xx at tip.data[,1], tDt[,1])
- checkEquals(xx at node.data[,1], nDt[,1])
- checkEquals(tdata(xx, "tip")[,1], tDt[,1])
- checkEquals(tdata(xx, "internal")[,1], nDt[,1])
-
-}
-
-test.Phylo4d.withNb <- function() {
- data(geospiza_raw)
- ## using the raw data
- tr <- geospiza_raw$tree
- tr <- as(tr, "phylo4")
-
- ## creating some data with rownames matching tip numbers
- tDt <- data.frame(testData1 = 1:nTips(tr),
- testData2 = (1:nTips(tr))*2)
- tDt <- tDt[sample(1:nrow(tDt)),]
-
- nDt <- data.frame(testData1 = 1:nNodes(tr))
- rownames(nDt) <- nodeId(tr, "internal")
- nDt <- nDt[sample(1:nrow(nDt)) ,, drop=FALSE]
-
- aDt <- data.frame(testData1 = 1:(nNodes(tr)+nTips(tr)))
- aDt <- aDt[sample(1:nrow(aDt)) ,, drop=FALSE]
-
- ## match with node numbers, tip data
- xx <- phylo4d(tr, tip.data=tDt)
- checkEquals(xx at tip.data[,1], 1:nTips(tr))
- checkEquals(tdata(xx, "tip")[,1], 1:nTips(tr))
-
- ## match with node numbers, node data
- xx <- phylo4d(tr, node.data=nDt)
- checkEquals(xx at node.data[,1], 1:nNodes(tr))
- checkEquals(tdata(xx, "internal")[,1], 1:nNodes(tr))
-
- ## match with node numbers, tip & node data
- xx <- phylo4d(tr, tip.data=tDt, node.data=nDt)
- checkEquals(xx at tip.data[,1], 1:nTips(tr))
- checkEquals(xx at node.data[,3], 1:nNodes(tr))
- checkEquals(tdata(xx, "tip")[,1], 1:nTips(tr))
- checkEquals(tdata(xx, "internal")[,3], 1:nNodes(tr))
-
- ## match with node numbers, tip & all data
- xx <- phylo4d(tr, tip.data=tDt, all.data=aDt)
- checkEquals(xx at tip.data[,1], 1:nTips(tr))
- checkEquals(xx at node.data[,1], (nTips(tr)+1):(nTips(tr)+nNodes(tr)))
- checkEquals(tdata(xx, "all")[,1], 1:(nTips(tr)+nNodes(tr)))
-
- ## match with node numbers, node & all data
- xx <- phylo4d(tr, node.data=nDt, all.data=aDt)
- checkEquals(xx at tip.data[,1], 1:nTips(tr))
- checkEquals(xx at node.data[,2], 1:nNodes(tr))
- checkEquals(tdata(xx, "all")[,1], 1:(nTips(tr)+nNodes(tr)))
-
- ## match with node numbers, tip, node & all data
- xx <- phylo4d(tr, tip.data=tDt, node.data=nDt, all.data=aDt)
- checkEquals(xx at tip.data[,1], 1:nTips(tr))
- checkEquals(xx at tip.data[,2], 1:nTips(tr))
- checkEquals(xx at node.data[,1], (nTips(tr)+1):(nTips(tr)+nNodes(tr)))
- checkEquals(xx at node.data[,4], 1:nNodes(tr))
- checkEquals(tdata(xx, "all")[,1], 1:(nTips(tr)+nNodes(tr)))
-}
-
-test.Phylo4d.withNames <- function() {
- data(geospiza_raw)
- ## using the raw data
- tr <- geospiza_raw$tree
- tr <- as(tr, "phylo4")
-
- ## creating some data with rownames matching tip numbers
- tDt <- data.frame(testData1 = 1:nTips(tr),
- testData2 = (1:nTips(tr))*2)
- rownames(tDt) <- tipLabels(tr)
- tDt <- tDt[sample(1:nrow(tDt)),]
-
- aDt <- data.frame(testData1 = 1:(nNodes(tr)+nTips(tr)))
- rownames(aDt)[1:nTips(tr)] <- tipLabels(tr)
- aDt <- aDt[sample(1:nrow(aDt)) ,, drop=FALSE]
-
- ## match with names, tip data
- xx <- phylo4d(tr, tip.data=tDt)
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/phylobase -r 654
More information about the Phylobase-commits
mailing list