[Phylobase-commits] r937 - in pkg: inst/unitTests tests/testthat

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Wed May 7 16:56:51 CEST 2014


Author: francois
Date: 2014-05-07 16:56:51 +0200 (Wed, 07 May 2014)
New Revision: 937

Added:
   pkg/tests/testthat/test.class-phylo4.R
Removed:
   pkg/inst/unitTests/runit.class-phylo4.R
Log:
moved/convert class-phylo4 tests

Deleted: pkg/inst/unitTests/runit.class-phylo4.R
===================================================================
--- pkg/inst/unitTests/runit.class-phylo4.R	2014-05-06 20:28:21 UTC (rev 936)
+++ pkg/inst/unitTests/runit.class-phylo4.R	2014-05-07 14:56:51 UTC (rev 937)
@@ -1,99 +0,0 @@
-#
-# --- Test class-phylo4.R ---
-#
-
-op <- phylobase.options()
-
-test.phylo4.matrix <- function() {
-    edge <- structure(c(6L, 7L, 8L, 8L, 9L, 9L, 7L, 6L, 7L, 8L, 1L, 9L,
-      2L, 3L, 4L, 5L), .Dim = c(8, 2))
-    edge.length <- c(0.2, 0.5, 0.2, 0.15, 0.1, 0.1, 0.7, 1)
-    tip.label <- paste("t", 1:5, sep="")
-    node.label <- paste("n", 1:4, sep="")
-    edge.label <- paste("e", 1:8, sep="")
-    order="preorder"
-    annote <- list(x="annotation")
-    phy <- phylo4(edge, edge.length=edge.length, tip.label=tip.label,
-      node.label=node.label, edge.label=edge.label, order=order,
-      annote=annote)
-
-    # test each slot
-    checkIdentical(edge, unname(edges(phy)))
-    checkIdentical(edge.length, unname(edgeLength(phy)))
-    checkIdentical(4L, nNodes(phy))
-    checkIdentical(tip.label, unname(tipLabels(phy)))
-    checkIdentical(node.label, unname(nodeLabels(phy)))
-    checkIdentical(edge.label, unname(edgeLabels(phy)))
-    checkIdentical(order, edgeOrder(phy))
-    checkIdentical(annote, phy at annote)
-
-    # test improper cases
-    #checkException(phylo4(edge, edge.length=999))  # recycling is allowed?
-    checkException(phylo4(edge, tip.label=999))
-    checkException(phylo4(edge, node.label=999))
-    #checkException(phylo4(edge, edge.label=999))  # recycling is allowed?
-    checkException(phylo4(edge, order="invalid order"))
-    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 <- ape::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, annote=annote)
-    checkIdentical(annote, phy at annote)
-
-    ##
-    ## 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)
-    ## with options allow.duplicated.labels="fail"
-    phylobase.options(allow.duplicated.labels="fail")
-    checkException(phylo4(tr))
-    checkException(phylo4(tr, check.node.labels="keep"))
-    phylobase.options(op)
-    ## test dropping node labels
-    phy <- phylo4(tr, check.node.labels="drop")
-    checkTrue(!hasNodeLabels(phy))
-    ## with options allow.duplicated.labels="ok"
-    phylobase.options(allow.duplicated.labels="ok")
-    phy <- phylo4(tr)
-    checkIdentical(unname(nodeLabels(phy)), tr$node.label)
-    phy <- phylo4(tr, check.node.labels="keep")
-    checkIdentical(unname(nodeLabels(phy)), tr$node.label)
-    phy <- phylo4(tr, check.node.labels="drop")
-    checkTrue(!hasNodeLabels(phy))
-    phylobase.options(op)
-}

Copied: pkg/tests/testthat/test.class-phylo4.R (from rev 880, pkg/inst/unitTests/runit.class-phylo4.R)
===================================================================
--- pkg/tests/testthat/test.class-phylo4.R	                        (rev 0)
+++ pkg/tests/testthat/test.class-phylo4.R	2014-05-07 14:56:51 UTC (rev 937)
@@ -0,0 +1,101 @@
+#
+# --- Test class-phylo4.R ---
+#
+
+op <- phylobase.options()
+
+context("test phylo4 class")
+
+test_that("building from matrix works", {
+    edge <- structure(c(6L, 7L, 8L, 8L, 9L, 9L, 7L, 6L, 7L, 8L, 1L, 9L,
+                        2L, 3L, 4L, 5L), .Dim = c(8, 2))
+    edge.length <- c(0.2, 0.5, 0.2, 0.15, 0.1, 0.1, 0.7, 1)
+    tip.label <- paste("t", 1:5, sep="")
+    node.label <- paste("n", 1:4, sep="")
+    edge.label <- paste("e", 1:8, sep="")
+    order <- "preorder"
+    annote <- list(x="annotation")
+    phy <- phylo4(edge, edge.length=edge.length, tip.label=tip.label,
+                  node.label=node.label, edge.label=edge.label, order=order,
+                  annote=annote)
+
+    ## test each slot
+    expect_equal(edge, unname(edges(phy)))
+    expect_equal(edge.length, unname(edgeLength(phy)))
+    expect_equal(4L, nNodes(phy))
+    expect_equal(tip.label, unname(tipLabels(phy)))
+    expect_equal(node.label, unname(nodeLabels(phy)))
+    expect_equal(edge.label, unname(edgeLabels(phy)))
+    expect_equal(order, edgeOrder(phy))
+    expect_equal(annote, phy at annote)
+
+    ## test improper cases
+    ## expect_error(phylo4(edge, edge.length=999))  # recycling is allowed? FM (20140506: yes)
+    expect_error(phylo4(edge, tip.label=999))
+    expect_error(phylo4(edge, node.label=999))
+    ## expect_error(phylo4(edge, edge.label=999))  # recycling is allowed? FM (20140506: yes)
+    expect_error(phylo4(edge, order="invalid order"))
+    expect_error(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_that("phylo4 can be built from phylo (tests on what's not done in setAs tests)", {
+    tr <- ape::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, annote=annote)
+    expect_equal(annote, phy at annote)
+
+    ##
+    ## check.node.labels
+    ##
+
+    # case 0: no node labels
+    phy <- phylo4(tr)
+    expect_true(!hasNodeLabels(phy))
+
+    # case 1: keep unique character labels
+    tr$node.label <- paste("n", 1:4, sep="")
+    phy <- phylo4(tr, check.node.labels="keep")
+    expect_equal(tr$node.label, unname(nodeLabels(phy)))
+    # keeping node labels should be the default
+    expect_equal(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")
+    expect_equal(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")
+    expect_equal(as.character(tr$node.label), unname(nodeLabels(phy)))
+
+    # case 4: must drop non-unique labels
+    tr$node.label <- rep("x", 4)
+    ## with options allow.duplicated.labels="fail"
+    phylobase.options(allow.duplicated.labels="fail")
+    expect_error(phylo4(tr))
+    expect_error(phylo4(tr, check.node.labels="keep"))
+    phylobase.options(op)
+    ## test dropping node labels
+    phy <- phylo4(tr, check.node.labels="drop")
+    expect_true(!hasNodeLabels(phy))
+    ## with options allow.duplicated.labels="ok"
+    phylobase.options(allow.duplicated.labels="ok")
+    phy <- phylo4(tr)
+    expect_equal(unname(nodeLabels(phy)), tr$node.label)
+    phy <- phylo4(tr, check.node.labels="keep")
+    expect_equal(unname(nodeLabels(phy)), tr$node.label)
+    phy <- phylo4(tr, check.node.labels="drop")
+    expect_true(!hasNodeLabels(phy))
+    phylobase.options(op)
+})



More information about the Phylobase-commits mailing list