[Phylobase-commits] r860 - pkg/inst/unitTests

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Mon Mar 10 06:21:26 CET 2014


Author: francois
Date: 2014-03-10 06:21:26 +0100 (Mon, 10 Mar 2014)
New Revision: 860

Removed:
   pkg/inst/unitTests/runit.methods-phylo4.R
Log:
forgot to delete that file

Deleted: pkg/inst/unitTests/runit.methods-phylo4.R
===================================================================
--- pkg/inst/unitTests/runit.methods-phylo4.R	2014-03-10 04:37:34 UTC (rev 859)
+++ pkg/inst/unitTests/runit.methods-phylo4.R	2014-03-10 05:21:26 UTC (rev 860)
@@ -1,501 +0,0 @@
-                                        #
-# --- Test methods-phylo4.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,0,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)
-eid <- paste(ancestor, descendant, sep="-")
-elen <- descendant/10
-elab <- paste("e", eid, 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 label <- rev(phy at 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)]
-
-# update test targets for edge-related slots
-ancestor <- ancestor[c(6:9, 1:5)]
-descendant <- descendant[c(6:9, 1:5)]
-edge <- cbind(ancestor, descendant)
-eid <- eid[c(6:9, 1:5)]
-elen <- elen[c(6:9, 1:5)]
-elab <- elab[c(6:9, 1:5)]
-
-op <- phylobase.options()
-#-----------------------------------------------------------------------
-
-test.nTips.phylo4 <- function() {
-  checkEquals(nTips(phy.alt), length(nid.tip))
-}
-
-test.depthTips.phylo4 <- function() {
-  edgeLengthVec <- c(1.2, 1.8, 1.8, 2.1, 2.3)
-  names(edgeLengthVec) <- tipLabels(phy.alt)
-  checkEquals(depthTips(phy.alt), edgeLengthVec)
-  tmpPhy <- phy.alt
-  edgeLength(tmpPhy) <- NA
-  checkTrue(is.null(depthTips(tmpPhy)))
-}
-
-test.nTips.ANY <- function() {
-  # nTips phylo
-  checkEquals(nTips(tr), 5)
-}
-
-test.nNodes.phylo4 <- function() {
-  checkEquals(nNodes(phy.alt), length(nid.int))
-}
-
-test.nodeType.phylo4 <- function() {
-  checkIdentical(nodeType(phy.alt), setNames(c(rep("tip", length(nid.tip)),
-    "root", rep("internal", length(nid.int)-1)), c(nid.tip, nid.int)))
-}
-
-test.nodeId.phylo4 <- function() {
-  checkIdentical(nodeId(phy.alt), c(nid.tip, nid.int))
-  checkIdentical(nodeId(phy.alt, "all"), c(nid.tip, nid.int))
-  checkIdentical(nodeId(phy.alt, "tip"), nid.tip)
-  checkIdentical(nodeId(phy.alt, "internal"), nid.int)
-  checkIdentical(nodeId(phy.alt, "root"), nid.int[1])
-}
-
-test.nEdges.phylo4 <- function() {
-  checkIdentical(nEdges(phy.alt), nrow(edge))
-}
-
-test.nodeDepth.phylo4 <- function() {
-  allDepths <- c(1.2, 1.8, 1.8, 2.1, 2.3, 0.9, 1.0, 1.2, 1.6)
-  names(allDepths) <- names(getNode(phy.alt))
-  checkIdentical(nodeDepth(phy.alt), allDepths)
-  checkIdentical(nodeDepth(phy.alt, 1), allDepths[1])
-  checkIdentical(nodeDepth(phy.alt, "t1"), allDepths[1])
-  tmpPhy <- phy.alt
-  edgeLength(tmpPhy) <- NA
-  checkTrue(is.null(nodeDepth(tmpPhy)))
-}
-
-test.edges.phylo4 <- function() {
-  checkIdentical(edges(phy.alt), edge)
-  checkIdentical(edges(phy.alt, drop.root=TRUE), edge[edge[,1] != 0,])
-}
-
-test.edgeOrder.phylo4 <- function() {
-  checkIdentical(edgeOrder(phy.alt), "unknown")
-  checkIdentical(edgeOrder(reorder(phy.alt, "preorder")), "preorder")
-  checkIdentical(edgeOrder(reorder(phy.alt, "postorder")), "postorder")
-}
-
-test.edgeId.phylo4 <- function() {
-  checkIdentical(edgeId(phy.alt), eid)
-  checkIdentical(edgeId(phy.alt, "all"), eid)
-  checkIdentical(edgeId(phy.alt, "tip"), eid[descendant %in% nid.tip])
-  checkIdentical(edgeId(phy.alt, "internal"), eid[!descendant %in% nid.tip])
-  checkIdentical(edgeId(phy.alt, "root"), eid[ancestor == 0])
-}
-
-test.hasEdgeLength.phylo4 <- function() {
-  checkTrue(hasEdgeLength(phy.alt))
-  phy.alt at edge.length <- NA_real_
-  checkTrue(!hasEdgeLength(phy.alt))
-}
-
-test.edgeLength.phylo4 <- function() {
-    ## all edge lengths
-    checkIdentical(edgeLength(phy.alt), setNames(elen, eid))
-    ## one edge length, by label
-    checkEquals(edgeLength(phy.alt, "t1"), c(`7-1`=0.1))
-    ## one edge length, by node ID
-    checkEquals(edgeLength(phy.alt, 1), c(`7-1`=0.1))
-    ## non-existent edge, by label
-    ans <- structure(NA_real_, .Names = NA_character_)
-    checkEquals(suppressWarnings(edgeLength(phy.alt, "xxx")), ans)
-    ## non-existent edge, by number
-    checkEquals(suppressWarnings(edgeLength(phy.alt, 999)), ans)
-    ## wrong number of edge lengths
-    phy.tmp1 <- phy.alt
-    phy.tmp1 at edge.length <- phy.alt at edge.length[-1]
-    checkTrue(nzchar(checkPhylo4(phy.tmp1)))
-    phy.tmp1 <- phy.alt
-    phy.tmp1 at edge.length <- c(phy.alt at edge.length, 1)
-    checkTrue(nzchar(checkPhylo4(phy.tmp1)))
-    ## negative edge lengths
-    phy.tmp1 <- phy.alt
-    phy.tmp1 at edge.length[3] <- -1
-    checkTrue(nzchar(checkPhylo4(phy.tmp1)))
-    ## edge incorrectly labeled
-    phy.tmp1 <- phy.alt
-    names(phy.tmp1 at edge.length)[1] <- "9-10"
-    checkTrue(nzchar(checkPhylo4(phy.tmp1)))
-}
-
-test.Replace.edgeLength.phylo4 <- function() {
-
-    emptyVec <- numeric()
-    attributes(emptyVec) <- list(names=character(0))
-    
-    ## dropping all should produce empty slot
-    edgeLength(phy.alt) <- numeric()
-    checkIdentical(edgeLength(phy.alt), setNames(rep(NA_real_, 9), edgeId(phy.alt, "all")))
-    checkIdentical(phy.alt at edge.length, emptyVec)
-    edgeLength(phy.alt) <- NA_real_
-    checkIdentical(edgeLength(phy.alt), setNames(rep(NA_real_, 9), edgeId(phy.alt, "all")))
-    checkIdentical(phy.alt at edge.length, emptyVec)
-
-    ##
-    ## complete replacement
-    ##
-
-    ## vector with reversed names, which get matched by default
-    edgeLength(phy.alt) <- numeric()
-    revElen <- setNames(elen, rev(eid))
-    edgeLength(phy.alt) <- revElen
-    checkIdentical(edgeLength(phy.alt), revElen[edgeId(phy.alt, "all")])
-    ## vector with reversed names, but specify no matching
-    edgeLength(phy.alt) <- numeric()
-    edgeLength(phy.alt, use.names=FALSE) <- revElen
-    elen1 <- elen
-    checkIdentical(edgeLength(phy.alt), setNames(elen1, edgeId(phy.alt, "all")))
-    ## vector with no names, should match to edgeId order
-    edgeLength(phy.alt) <- numeric()
-    edgeLength(phy.alt) <- elen
-    elen2 <- elen
-    checkIdentical(edgeLength(phy.alt), setNames(elen2, edgeId(phy.alt, "all")))
-
-    ## 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), edgeId(phy.alt, "all")))
-
-    ##
-    ## 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), edgeId(phy.alt, "all")))
-    ## and back again, now using character index
-    edgeLength(phy.alt)["8-3"] <- 0.3
-    elen3 <- elen
-    checkIdentical(edgeLength(phy.alt), setNames(elen3, edgeId(phy.alt, "all")))
-    ## 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]), edgeId(phy.alt, "all")))
-    edgeLength(phy.alt) <- elen
-    checkException(edgeLength(phy.alt)["8-3"] <- NA)
-}
-
-test.sumEdgeLength.phylo4 <- function() {
-  #TODO function(phy, node)
-}
-
-test.isRooted.phylo4 <- function() {
-  checkTrue(isRooted(phy.alt))
-}
-
-test.rootNode.phylo4 <- function() {
-  checkIdentical(rootNode(phy.alt), nid.int[1])
-}
-
-test.Replace.rootNode.phylo4 <- function() {
-  #TODO function(x, value)
-}
-
-test.labels.phylo4 <- function() {
-  # function(object, type = c("all", "tip", "internal"))
-  checkIdentical(labels(phy.alt), setNames(c(lab.tip, lab.int), c(nid.tip,
-    nid.int)))
-  checkIdentical(labels(phy.alt, "all"), setNames(c(lab.tip, lab.int),
-    c(nid.tip, nid.int)))
-  checkIdentical(labels(phy.alt, "tip"), setNames(lab.tip, nid.tip))
-  checkIdentical(labels(phy.alt, "internal"), setNames(lab.int, nid.int))
-}
-
-test.Replace.labels.phylo4 <- function() {
-
-  ## dropping all should produce default tip labels, no internal labels
-  labels(phy.alt) <- character()
-  checkIdentical(labels(phy.alt), setNames(c(paste("T", 1:5, sep=""),
-      rep(NA, 4)), nid.all))
-
-  #
-  # complete replacement
-  #
-
-  # vector with reversed names, but names not used
-  labels(phy.alt) <- character()
-  labels(phy.alt) <- setNames(lab.all, rev(nid.all))
-  checkIdentical(labels(phy.alt), setNames(lab.all, nid.all))
-  labels(phy.alt) <- character()
-  labels(phy.alt, "tip") <- setNames(lab.tip, rev(nid.tip))
-  checkIdentical(tipLabels(phy.alt), setNames(lab.tip, nid.tip))
-  labels(phy.alt) <- character()
-  labels(phy.alt, "internal") <- setNames(lab.int, rev(nid.int))
-  checkIdentical(nodeLabels(phy.alt), setNames(lab.int, nid.int))
-  # as above, but specify name matching, hence labels get reversed too
-  labels(phy.alt) <- character()
-  labels(phy.alt, use.names=TRUE) <- setNames(lab.all, rev(nid.all))
-  checkIdentical(labels(phy.alt), setNames(rev(lab.all), nid.all))
-  labels(phy.alt) <- character()
-  labels(phy.alt, "tip", use.names=TRUE) <- setNames(lab.tip, rev(nid.tip))
-  checkIdentical(tipLabels(phy.alt), setNames(rev(lab.tip), nid.tip))
-  labels(phy.alt) <- character()
-  labels(phy.alt, "internal", use.names=TRUE) <- setNames(lab.int, rev(nid.int))
-  checkIdentical(nodeLabels(phy.alt), setNames(rev(lab.int), nid.int))
-  # vector with no names, should match to nodeId order
-  labels(phy.alt) <- character()
-  labels(phy.alt) <- lab.all
-  checkIdentical(labels(phy.alt), setNames(lab.all, nid.all))
-  labels(phy.alt) <- character()
-  labels(phy.alt, type="tip") <- lab.tip
-  checkIdentical(tipLabels(phy.alt), setNames(lab.tip, nid.tip))
-  labels(phy.alt) <- character()
-  labels(phy.alt, type="internal") <- lab.int
-  checkIdentical(nodeLabels(phy.alt), setNames(lab.int, nid.int))
-
-  #
-  # partial replacement
-  #
-
-  labels(phy.alt) <- lab.all
-  # replace a tip using numeric index
-  labels(phy.alt)[5] <- "t5a"
-  checkIdentical(tipLabels(phy.alt), setNames(c(lab.tip[1:4], "t5a"), nid.tip))
-  # and back again, now using character index
-  labels(phy.alt)["5"] <- "t5"
-  checkIdentical(labels(phy.alt), setNames(lab.all, nid.all))
-  # replace an internal node using numeric index
-  labels(phy.alt)[9] <- "n9a"
-  checkIdentical(nodeLabels(phy.alt), setNames(c(lab.int[1:3], "n9a"), nid.int))
-  # and back again, now using character index
-  labels(phy.alt)["9"] <- "n9"
-  checkIdentical(labels(phy.alt), setNames(lab.all, nid.all))
-  # error to produce duplicate tip or internal label
-  phylobase.options(allow.duplicated.labels="fail")
-  checkException(labels(phy.alt)[1] <- "t2")
-  checkException(labels(phy.alt)[6] <- "n7")
-  # no error in allow.duplicated.labels is ok
-  phylobase.options(allow.duplicated.labels="ok")
-  labels(phy.alt)[1] <- "t2"
-  labels(phy.alt)[6] <- "n7"
-  checkIdentical(tipLabels(phy.alt), setNames(c("t2", "t2", "t3", "t4", "t5"), nid.tip))
-  checkIdentical(nodeLabels(phy.alt), setNames(c("n7", "n7", "n8", "n9"), nid.int))
-  # error to add labels for nodes that don't exist
-  checkException(labels(phy.alt)["fake"] <- "xxx")
-  checkException(labels(phy.alt)[999] <- "xxx")
-
-}
-
-test.nodeLabels.phylo4 <- function() {
-  checkIdentical(nodeLabels(phy.alt), setNames(lab.int, nid.int))
-}
-
-test.hasNodeLabels.phylo4 <- function() {
-  checkTrue(hasNodeLabels(phy.alt))
-  nodeLabels(phy.alt) <- NA_character_
-  checkTrue(!hasNodeLabels(phy.alt))
-}
-
-test.Replace.nodeLabels.phylo4 <- function() {
-
-  ## dropping all should produce no internal labels
-  nodeLabels(phy.alt) <- character()
-  checkTrue(!any(nid.int %in% names(phy.alt at label)))
-  checkIdentical(nodeLabels(phy.alt), setNames(rep(NA_character_, 4), nid.int))
-
-  #
-  # partial replacement
-  #
-
-  labels(phy.alt) <- lab.all
-  # replace an internal node using numeric index
-  nodeLabels(phy.alt)[4] <- "n9a"
-  checkIdentical(nodeLabels(phy.alt), setNames(c(lab.int[1:3], "n9a"), nid.int))
-  # and back again, now using character index
-  nodeLabels(phy.alt)["9"] <- "n9"
-  checkIdentical(labels(phy.alt), setNames(lab.all, nid.all))
-  # error to produce duplicate internal label
-  phylobase.options(allow.duplicated.labels="fail")
-  checkException(nodeLabels(phy.alt)["6"] <- "n7")
-  phylobase.options(op)
-  phylobase.options(allow.duplicated.labels="ok")
-  nodeLabels(phy.alt)["6"] <- "n7"
-  checkIdentical(nodeLabels(phy.alt), setNames(c("n7", "n7", "n8", "n9"), nid.int))
-  phylobase.options(op)
-  # error to add labels for nodes that don't exist
-  checkException(nodeLabels(phy.alt)["fake"] <- "xxx")
-  checkException(nodeLabels(phy.alt)[999] <- "xxx")
-}
-
-test.tipLabels.phylo4 <- function() {
-  checkIdentical(tipLabels(phy.alt), setNames(lab.tip, nid.tip))
-}
-
-test.Replace.tipLabels.phylo4 <- function() {
-
-  ## dropping all tip labels should produce default labels
-  tipLabels(phy.alt) <- character()
-  checkIdentical(tipLabels(phy.alt), setNames(paste("T", 1:5, sep=""), nid.tip))
-
-  #
-  # partial replacement
-  #
-
-  labels(phy.alt) <- lab.all
-  # replace a tip using numeric index
-  tipLabels(phy.alt)[5] <- "t5a"
-  checkIdentical(tipLabels(phy.alt), setNames(c(lab.tip[1:4], "t5a"), nid.tip))
-  # and back again, now using character index
-  tipLabels(phy.alt)["5"] <- "t5"
-  checkIdentical(labels(phy.alt), setNames(lab.all, nid.all))
-  # error to produce duplicate tip or internal label
-  phylobase.options(allow.duplicated.labels="fail")
-  checkException(tipLabels(phy.alt)[1] <- "t2")
-  phylobase.options(op)
-  phylobase.options(allow.duplicated.labels="ok")
-  tipLabels(phy.alt)[1] <- "t2"
-  checkIdentical(tipLabels(phy.alt), setNames(c("t2", "t2", "t3", "t4", "t5"), nid.tip))
-  phylobase.options(op)
-  # error to add labels for nodes that don't exist
-  checkException(tipLabels(phy.alt)["fake"] <- "xxx")
-  checkException(tipLabels(phy.alt)[999] <- "xxx")
-}
-
-test.hasEdgeLabels.phylo4 <- function() {
-  checkTrue(hasEdgeLabels(phy.alt))
-  phy.alt at edge.label <- NA_character_
-  checkTrue(!hasEdgeLabels(phy.alt))
-}
-
-test.edgeLabels.phylo4 <- function() {
-
-  # basic usage
-  checkIdentical(edgeLabels(phy.alt), setNames(elab, eid))
-  # should return named vector of NAs if edge labels are missing or NA
-  phy.alt at edge.label <- NA_character_
-  checkIdentical(edgeLabels(phy.alt), setNames(rep(NA_character_, 9), eid))
-  phy.alt at edge.label <- character()
-  checkIdentical(edgeLabels(phy.alt), setNames(rep(NA_character_, 9), eid))
-  # if only some labels exists, should fill in NA for the others
-  phy.alt at edge.label <- setNames(elab[-1], eid[-1])
-  checkIdentical(edgeLabels(phy.alt), setNames(c(NA, elab[-1]), eid))
-
-}
-
-test.Replace.edgeLabels.phylo4 <- function() {
-
-  ## dropping all should produce empty slot
-  edgeLabels(phy.alt) <- character()
-  checkIdentical(edgeLabels(phy.alt), setNames(rep(NA_character_, 9), eid))
-
-  #
-  # complete replacement
-  #
-
-  # vector with reversed names, which always get matched
-  edgeLabels(phy.alt) <- character()
-  edgeLabels(phy.alt) <- setNames(elab, rev(eid))
-  checkIdentical(edgeLabels(phy.alt), setNames(rev(elab), eid))
-  # vector with no names, should match to edgeId order
-  edgeLabels(phy.alt) <- character()
-  edgeLabels(phy.alt) <- elab
-  checkIdentical(edgeLabels(phy.alt), setNames(elab, eid))
-
-  # recycling applies if fewer the nEdges elements are supplied
-  # (duplicate edge labels are okay)
-  edgeLabels(phy.alt) <- "x"
-  checkIdentical(edgeLabels(phy.alt), setNames(rep("x", 9), eid))
-
-  #
-  # partial replacement
-  #
-
-  edgeLabels(phy.alt) <- elab
-  # replace an edge label using numeric index
-  edgeLabels(phy.alt)[9] <- "e8-3a"
-  checkIdentical(edgeLabels(phy.alt), setNames(c(elab[1:8], "e8-3a"), eid))
-  # and back again, now using character index
-  edgeLabels(phy.alt)["8-3"] <- "e8-3"
-  checkIdentical(edgeLabels(phy.alt), setNames(elab, eid))
-  # error to add labels for edges that don't exist
-  checkException(edgeLabels(phy.alt)["fake"] <- "xxx")
-  checkException(edgeLabels(phy.alt)[999] <- "xxx")
-}
-
-## this is also the print method
-## this mostly just wraps .phylo4ToDataFrame, which is tested elsewhere
-##test.show.phylo4 <- function() {
-##}
-
-test.names.phylo4 <- function() {
-  #TODO?
-}
-
-test.head.phylo4 <- function() {
-  #TODO?
-}
-
-test.tail.phylo4 <- function() {
-  #TODO?
-}
-
-test.summary.phylo4 <- function() {
-  phy.sum <- summary(phy.alt, quiet=TRUE)
-  checkIdentical(phy.sum$name, "phy.alt")
-  checkIdentical(phy.sum$nb.tips, length(nid.tip))
-  checkIdentical(phy.sum$nb.nodes, length(nid.int))
-  checkIdentical(phy.sum$mean.el, mean(elen))
-  checkIdentical(phy.sum$var.el, var(elen))
-  checkIdentical(phy.sum$sumry.el, summary(elen))
-  # now make root edge length NA
-  edgeLength(phy.alt)[edgeId(phy.alt, "root")] <- NA
-  phy.sum2 <- summary(phy.alt, quiet=TRUE)
-  checkIdentical(phy.sum2$mean.el, mean(edgeLength(phy.alt), na.rm=TRUE))
-  checkIdentical(phy.sum2$var.el, var(edgeLength(phy.alt), na.rm=TRUE))
-  checkIdentical(phy.sum2$sumry.el, summary(na.omit(edgeLength(phy.alt))))
-  # now remove edge lengths altogether
-  phy.alt at edge.length[] <- NA
-  phy.sum3 <- summary(phy.alt, quiet=TRUE)
-  checkTrue(is.null(phy.sum3$mean.el))
-  checkTrue(is.null(phy.sum3$var.el))
-  checkTrue(is.null(phy.sum3$sumry.el))
-}
-
-# not an exported function -- called internally by reorder("phylo4")
-#test.orderIndex <- function() {
-#}
-
-test.reorder.phylo4 <- function() {
-  #TODO
-}
-
-test.isUltrametric <- function() {
-  checkTrue(!isUltrametric(phy.alt))
-  tmpPhy <- as(rcoal(10), "phylo4")
-  checkTrue(isUltrametric(tmpPhy))
-  tmpPhy <- phy.alt
-  edgeLength(tmpPhy) <- NA
-  checkException(isUltrametric(tmpPhy))
-}
-
-phylobase.options(op)



More information about the Phylobase-commits mailing list