[Phylobase-commits] r680 - in pkg: R inst/unitTests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Sep 29 23:13:52 CEST 2009
Author: regetz
Date: 2009-09-29 23:13:52 +0200 (Tue, 29 Sep 2009)
New Revision: 680
Modified:
pkg/R/methods-phylo4.R
pkg/inst/unitTests/runit.methods-phylo4.R
Log:
changed edgeLength<- method to use .createEdge helper function, so now
it gets the order right (edgeId order) if names are missing; added tests
Modified: pkg/R/methods-phylo4.R
===================================================================
--- pkg/R/methods-phylo4.R 2009-09-29 20:30:46 UTC (rev 679)
+++ pkg/R/methods-phylo4.R 2009-09-29 21:13:52 UTC (rev 680)
@@ -203,13 +203,13 @@
setReplaceMethod("edgeLength", signature(x="phylo4"),
function(x, use.names=TRUE, ..., value) {
- if(use.names && !is.null(names(value))) {
- if(!all(names(value) %in% edgeId(x, "all")))
- stop("Names provided don't match internal edge labels")
- x at edge.length[match(names(value), names(x at edge.length))] <- value
+ len <- .createEdge(value, x at edge, type="lengths", use.names)
+ ## return empty vector if all values are NA
+ if (all(is.na(len))) {
+ x at edge.length <- numeric()
+ } else {
+ x at edge.length <- len
}
- else
- x at edge.length[1:nEdges(x)] <- value
if(is.character(checkval <- checkPhylo4(x))) stop(checkval)
x
})
Modified: pkg/inst/unitTests/runit.methods-phylo4.R
===================================================================
--- pkg/inst/unitTests/runit.methods-phylo4.R 2009-09-29 20:30:46 UTC (rev 679)
+++ pkg/inst/unitTests/runit.methods-phylo4.R 2009-09-29 21:13:52 UTC (rev 680)
@@ -110,7 +110,56 @@
}
test.Replace.edgeLength.phylo4 <- function() {
+
#TODO function(x, use.names=TRUE, ..., value)
+ ## dropping all should produce empty slot
+ edgeLength(phy.alt) <- numeric()
+ checkIdentical(edgeLength(phy.alt), setNames(rep(NA_real_, 9), eid))
+ checkIdentical(phy.alt at edge.length, numeric())
+ edgeLength(phy.alt) <- NA_real_
+ checkIdentical(edgeLength(phy.alt), setNames(rep(NA_real_, 9), eid))
+ checkIdentical(phy.alt at edge.length, numeric())
+
+ #
+ # complete replacement
+ #
+
+ # vector with reversed names, which get matched by default
+ edgeLength(phy.alt) <- numeric()
+ edgeLength(phy.alt) <- setNames(elen, rev(eid))
+ checkIdentical(edgeLength(phy.alt), setNames(rev(elen), eid))
+ # vector with reversed names, but specify no matching
+ edgeLength(phy.alt) <- numeric()
+ edgeLength(phy.alt, use.names=FALSE) <- setNames(elen, rev(eid))
+ checkIdentical(edgeLength(phy.alt), setNames(elen, eid))
+ # vector with no names, should match to edgeId order
+ edgeLength(phy.alt) <- numeric()
+ edgeLength(phy.alt) <- elen
+ checkIdentical(edgeLength(phy.alt), setNames(elen, eid))
+
+ # recycling applies if fewer the nEdges elements are supplied
+ # (duplicate edge length are okay)
+ edgeLength(phy.alt) <- 1
+ checkIdentical(edgeLength(phy.alt), setNames(rep(1, 9), eid))
+
+ #
+ # partial replacement
+ #
+
+ edgeLength(phy.alt) <- elen
+ # replace an edge length using numeric index
+ edgeLength(phy.alt)[9] <- 83
+ checkIdentical(edgeLength(phy.alt), setNames(c(elen[1:8], 83), eid))
+ # and back again, now using character index
+ edgeLength(phy.alt)["8-3"] <- 0.3
+ checkIdentical(edgeLength(phy.alt), setNames(elen, eid))
+ # error to add length for edges that don't exist
+ checkException(edgeLength(phy.alt)["fake"] <- 999)
+ checkException(edgeLength(phy.alt)[999] <- 999)
+ # NAs permitted only for root edge (or for *all* edges)
+ edgeLength(phy.alt)[edgeId(phy.alt, "root")] <- NA
+ checkIdentical(edgeLength(phy.alt), setNames(c(NA, elen[2:9]), eid))
+ checkException(edgeLength(phy.alt)["8-3"] <- NA)
}
test.sumEdgeLength.phylo4 <- function() {
@@ -293,7 +342,7 @@
test.Replace.edgeLabels.phylo4 <- function() {
- ## dropping all should produce default tip labels, no internal labels
+ ## dropping all should produce empty slot
edgeLabels(phy.alt) <- character()
checkIdentical(edgeLabels(phy.alt), setNames(rep(NA_character_, 9), eid))
More information about the Phylobase-commits
mailing list