tests/testthat/test.class-phylo4.R

In phylobase: Base package for phylogenetic structures and comparative data

#
# --- 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@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@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)
})