TestFile <- function(filename = "") { system.file("extdata", "tests", filename, package = "TreeTools") } test_that("File time is read correctly", { fileName <- TestFile("ape-tree.nex") expect_equal("2018-07-18 13:47:46", ApeTime(fileName, "string")) expect_error(ApeTime(rep(fileName, 2))) }) test_that("Nexus file can be parsed", { # Errors as lists: expect_equal("MATRIX block not found in Nexus file.", ReadCharacters(TestFile("ape-tree.nex"))[[1]]) filename <- TestFile("parse-nexus.nexus") read <- ReadCharacters(filename) expect_equal(192, ncol(read)) expect_equal(80, nrow(read)) expect_equal("Wiwaxia", rownames(read)[4]) expect_equal("(01)", as.character(read[1, 27])) filename <- TestFile("continuous.nex") read <- ReadCharacters(filename) expect_equal(1L, unique(as.integer(read[1, ]))) expect_equal(setNames("?", "B_alienus"), read["B_alienus", 4]) expect_equal(3L, unique(as.integer(read[3, ]))) }) test_that("NexusTokens() fails gracefully", { expect_error(NexusTokens("0123012301230123", integer(0))) expect_equal("Character number must be between 1 and 16.", NexusTokens("0123012301230123", 0)[[1]]) }) test_that("Matrix converts to phyDat", { mat <- matrix(c(1,0,1,0,1,0,1,0,0,1,0,1,0,1,0,1,2,2,2,2,2,2,2,"?"), nrow = 3, byrow = TRUE) rownames(mat) <- LETTERS[1:3] expect_equal(mat, as.matrix(MatrixToPhyDat(mat))) }) test_that(".PhyDatWithContrast() fails gracefully", { expect_error(.PhyDatWithContrast(matrix(0, 2, 2), matrix(c(1, 0, 0, 1), 2, 2, FALSE, list(0:1, 0:1)))) }) test_that("PhyDatToMatrix() with ambigs", { mat <- matrix(c(1,0,1,0,1,0,1,0,0,1,0,1,0,1,0,1,2,2,2,2,"{12}","(01)","-","?"), nrow = 3, byrow = TRUE) rownames(mat) <- LETTERS[1:3] expectation <- mat expectation[3, 5:8] <- NA_character_ expect_equal(PhyDatToMatrix(MatrixToPhyDat(mat), TRUE, TRUE), expectation) expect_equal(PhyDatToMatrix(MatrixToPhyDat(mat), TRUE, FALSE)[3, 5:8], c(NA, NA, "-", NA)) expect_equal(PhyDatToMatrix(MatrixToPhyDat(mat), FALSE, TRUE)[3, 5:8], c("{12}", "{01}", NA_character_, "?")) expect_equal( PhyDatToMatrix(MatrixToPhyDat(mat), ambigNA = FALSE, inappNA = TRUE, parentheses = NULL )[3, 5:8], c("{12}", "(01)", NA_character_, "?")) expect_equal( PhyDatToMatrix(MatrixToPhyDat(mat), ambigNA = FALSE, inappNA = TRUE, parentheses = c("<>"), sep = "/" )[3, 5:8], c("<1/2>", "<0/1>", NA_character_, "?")) }) test_that("Modified phyDat objects can be converted", { # Obtained by subsetting, i.e. dataset <- biggerDataset[1:4] dataset <- structure(list(a = c(1L, 1L, 1L, 1L), c = c(2L, 1L, 1L, 2L), d = c(2L, 1L, 2L, 1L), e = c(2L, 2L, 2L, 2L)), weight = c(3L, 3L, 0L, 0L), nr = 4L, nc = 2L, index = c(2L, 1L, 1L, 1L, 2L, 2L), .Label = c("0", "1"), allLevels = c("0", "1"), type = "USER", contrast = structure(c(1, 0, 0, 1), .Dim = c(2L, 2L), .Dimnames = list(NULL, c("0", "1"))), class = "phyDat") expect_equal(c(4, 6), dim(PhyDatToMatrix(dataset))) }) test_that("MatrixToPhyDat() warns when characters blank", { # May occur when loading an excel file with empty cells mat <- matrix(c(1,0,1,0,1,0,1,0,0,"","","",0,1,0,1,2,2,2,2,2,2,2,"?"), nrow = 3, byrow = TRUE) rownames(mat) <- LETTERS[1:3] expect_warning(MatrixToPhyDat(mat)) }) test_that("MatrixToPhyDat() returns phyDat if passed", { expect_warning(expect_equal(Lobo.phy, MatrixToPhyDat(Lobo.phy)), "phyDat") }) test_that("StringToPhyDat()", { expect_equal(as.integer(StringToPhyDat("1111????", letters[1:8])), rep(1:2, each = 4)) expect_equal(as.integer(StringToPhyDat("----????", letters[1:8])), rep(1:2, each = 4)) expect_equal(as.integer(StringToPhyDat("----????")), rep(1:2, each = 4)) expect_equal(names(StringToPhyDat("----????")), paste0("t", 1:8)) }) test_that("PhyToString() supports long levels", { skip_if_not_installed("phangorn") longLevels <- phangorn::phyDat(rbind(x = c("-", "?", 0:12), y = c(12:0, "-", "?")), type = "USER", levels = c(0:6, "-", 7:12)) expect_equal("-?0123456789ABCCBA9876543210-?", PhyToString(longLevels)) # Two -s → error attr(longLevels, "allLevels")[1] <- "-" expect_error(PhyToString(longLevels)) # 10 → 1 longLevels <- phangorn::phyDat(rbind(x = c("-", "?", 1:10), y = c(10:1, "-", "?")), type = "USER", levels = c(1:6, "-", 7:10)) expect_equal("-?12345678900987654321-?", PhyToString(longLevels)) }) test_that("PhyToString() works", { phy <- StringToPhyDat("012[01]", letters[1:4]) expect_equal("012{01}", PhyToString(phy)) expect_equal("012<01>", PhyToString(phy, parentheses = "<")) expect_equal("012<01>", PhyToString(phy, parentheses = ">")) expect_equal("012(01)", PhyToString(phy, parentheses = "(")) expect_equal("012(01)", PhyToString(phy, parentheses = ")")) expect_equal("012[01]", PhyToString(phy, parentheses = "]")) expect_equal("012[01]", PhyToString(phy, parentheses = "[")) expect_equal("012{01}", PhyToString(phy, parentheses = "}")) expect_equal("012{01}", PhyToString(phy, parentheses = "{")) expect_equal("012{01}", PhyToString(phy, parentheses = "!")) str <- "012{01}0123" phy <- StringToPhyDat(str, letters[1:4]) expect_equal(str, PhyToString(StringToPhyDat(str, letters[1:4]))) expect_equal(str, PhyToString(StringToPhyDat(str, letters[1:4], byTaxon = TRUE), byTaxon = TRUE)) }) test_that("EndSentence() works correctly", { expect_equal(EndSentence("Hi"), "Hi.") expect_equal(EndSentence("Hi."), "Hi.") expect_equal(EndSentence("Hi?"), "Hi?") expect_equal(EndSentence("Hi!"), "Hi!") expect_equal(EndSentence(character(0)), character(0)) }) test_that("Unquote() unquotes", { expect_equal(Unquote("'Unquoted'"), "Unquoted") expect_equal(Unquote("\"Unquoted\""), "Unquoted") expect_equal(Unquote("'Unquoted '"), "Unquoted") expect_equal(Unquote("\" Unquoted \""), "Unquoted") expect_equal( Unquote("'Unquoted's '"), "Unquoted's") expect_equal(Unquote(.UnescapeQuotes("'Unquoted''s '")), "Unquoted's") expect_equal(Unquote("\"\""), "") expect_equal(Unquote("''"), "") }) test_that("ReadNotes() reads notes", { notes <- ReadNotes(system.file("extdata/input/notes.nex", package = "TreeTools")) expect_equal(length(unlist(notes$`1`)), 0) expect_equal(notes[[2]][[2]], setNames("Taxon 2, char 2.", "taxon_b")) expect_equal(notes[[3]][[1]], "Three's a crowd.") expect_equal(notes[[3]][[2]], setNames("Tax1-Char3.", "taxon_a")) }) test_that("ReadNotes() handles absence of character-taxon notes", { expect_equal(ReadNotes(system.file("extdata/tests/taxon-notes.nex", package = "TreeTools")), structure(list(), names = character(0))) }) test_that("ReadNotes() handles misspecified encoding", { expect_message( expect_equal(ReadNotes(system.file("extdata/tests/encoding.nex", package = "TreeTools"))[[1]][[2]], setNames("\u0080ncoding.", "Two")), "trying latin1 .*encoding") }) test_that("ReadCharacters() reads CHARSTATELABELS", { labels <- ReadCharacters(system.file("extdata/input/dataset.nex", package = "TreeTools")) expect_equal(colnames(labels), c("Character one", "Character two", "lots-of-punctuation, and \"so on\"!", "Character n", "Character 5", "Character 6", "final character")) ap <- c("absent", "present") expect_equal(attr(labels, "state.labels"), list(ap, ap, c("here", "there", "everywhere"), c("a long description", "present"), c("simple", "more complex", "with (parentheses)", "more complex, 6 still"), c("this one has", "multiple lines"), ap)); labels3 <- ReadCharacters(system.file("extdata/input/dataset.nex", package = "TreeTools"), 3) expect_equal(labels3, labels[, 3, drop = FALSE], ignore_attr = TRUE) expect_equal(attr(labels3, "state.labels"), attr(labels, "state.labels")[3]) }) test_that("MorphoBankDecode() decodes", { expect_equal("' -- x \n 1--2", MorphoBankDecode("'' - x^n 1-2")) }) test_that("NewickTree() works", { expect_equal("((Test taxon,Another test),(What's this?,Number 12.3));", NewickTree(BalancedTree(c("Test taxon", "Another_test", "What's this?", "Number 12.3")))) }) test_that("as_newick() fails gracefully", { expect_equal(as_newick(matrix(0L, 0L, 2L)), ";") expect_equal(as_newick(matrix(1:0, 1L, 2L)), "(0);") expect_equal(as_newick(Postorder(BalancedTree(4)$edge) - 1L), as_newick(BalancedTree(4)$edge - 1L)) expect_error(as_newick(matrix(0L, 8192 * 2L, 2L)), "Too many nodes") expect_error(as_newick(matrix(0L, 3, 3)), "`edge` must have two columns") expect_error(as_newick(matrix(c(4, 4, 4, 1:3), 3, 2)), "`min.edge.` must be zero") expect_error(as_newick(matrix(c(3, NA, 3, 0:2), 3, 2)), "`edge`.* NA") expect_error(as_newick(matrix(c(4, 4, 3, 0:2), 3, 2)), "`edge` is malformed") })