tests/testthat/test-taxonomy.R

In rotl: Interface to the 'Open Tree of Life' API

context("taxonomy")

############################################################################
## taxonomy about                                                         ##
############################################################################

test_that("taxonomy_about is a list", {
  skip_on_cran()
  tt <- taxonomy_about()
  expect_true(inherits(tt, "list"))
})

test_that("taxonomy_about has the names listed in documentation (if it breaks update documentation)", {
  skip_on_cran()
  tt <- taxonomy_about()
  expect_true(all(names(tt) %in% c("weburl", "author", "name", "source", "version")))
})


############################################################################
## taxon Info                                                             ##
############################################################################

test_that("taxonomy taxon info", {
  skip_on_cran()
  tid <- 515698
  tt <- taxonomy_taxon_info(tid)
  expect_equal(tt[[1]][["ott_id"]], tid)
  expect_true(inherits(tt, "taxon_info"))
})

test_that("taxonomy with include_lineage=TRUE", {
  skip_on_cran()
  tt <- taxonomy_taxon_info(515698, include_lineage = TRUE)
  expect_true(exists("lineage", tt[[1]]))
  expect_true(length(tt[[1]]$lineage) > 1)
})

test_that("taxonomy with include_lineage=FALSE", {
  skip_on_cran()
  tt <- taxonomy_taxon_info(515698, include_lineage = FALSE)
  expect_false(exists("lineage", tt[[1]]))
})

test_that("taxonomy with include_terminal_descendants=TRUE", {
  skip_on_cran()
  tt <- taxonomy_taxon_info(515698, include_terminal_descendants = TRUE)
  expect_true(exists("terminal_descendants", tt[[1]]))
  expect_true(length(tt[[1]][["terminal_descendants"]]) > 1)
})

test_that("taxonomy with include_terminal_descendants=FALSE", {
  skip_on_cran()
  tt <- taxonomy_taxon_info(515698, include_terminal_descendants = FALSE)
  expect_false(exists("terminal_descendants", tt[[1]]))
})

if (identical(Sys.getenv("NOT_CRAN"), "true")) {
  tid <- c(957430, 337928, 631176)
  tax_info <- taxonomy_taxon_info(tid)
}

test_that("taxonomy_taxon tax_rank method", {
  skip_on_cran()
  expect_true(inherits(
    tax_rank(tax_info),
    c("otl_tax_rank", "list")
  ))
  expect_equal(
    names(tax_rank(tax_info)),
    c(
      "Actinopyga", "Acanthaster",
      "Garrettia (genus in Opisthokonta)"
    )
  )
  expect_equal(
    unlist(unname(tax_rank(tax_info))),
    rep("genus", 3)
  )
})

test_that("taxonomy_taxon ott_taxon_name method", {
  skip_on_cran()
  expect_true(inherits(
    tax_name(tax_info),
    c("otl_tax_info", "list")
  ))
  expect_equal(
    names(tax_name(tax_info)),
    c(
      "Actinopyga", "Acanthaster",
      "Garrettia (genus in Opisthokonta)"
    )
  )
  expect_equal(
    unlist(unname(tax_name(tax_info))),
    c("Actinopyga", "Acanthaster", "Garrettia")
  )
})

test_that("taxonomy_taxon synonyms method", {
  skip_on_cran()
  expect_true(inherits(
    synonyms(tax_info),
    c("otl_synonyms", "list")
  ))
  expect_equal(
    names(synonyms(tax_info)),
    c(
      "Actinopyga", "Acanthaster",
      "Garrettia (genus in Opisthokonta)"
    )
  )
  expect_true(all(c("Diamema", "Centrechinus") %in%
    synonyms(tax_info)[[3]]))
})

test_that("taxonomy_taxon is_suppressed method", {
  skip_on_cran()
  expect_true(inherits(
    is_suppressed(tax_info),
    c("otl_is_suppressed", "list")
  ))
  expect_equal(
    names(is_suppressed(tax_info)),
    c(
      "Actinopyga", "Acanthaster",
      "Garrettia (genus in Opisthokonta)"
    )
  )
  expect_equal(
    unlist(unname(is_suppressed(tax_info))),
    c(FALSE, FALSE, FALSE)
  )
})

test_that("taxonomy_taxon flags method", {
  skip_on_cran()
  expect_true(inherits(
    flags(tax_info),
    c("otl_flags", "list")
  ))
  expect_equal(
    names(flags(tax_info)),
    c(
      "Actinopyga", "Acanthaster",
      "Garrettia (genus in Opisthokonta)"
    )
  )
  expect_equal(
    unlist(unname(flags(tax_info))),
    NULL
  )
})

test_that("higher taxonomy method", {
  skip_on_cran()
  expect_error(tax_lineage(tax_info), "needs to be created")
  lg <- tax_lineage(taxonomy_taxon_info(tid, include_lineage = TRUE))
  expect_true(inherits(lg, "list"))
  expect_true(inherits(lg[[1]], "data.frame"))
  expect_true(all(names(lg[[1]]) %in% c("rank", "name", "unique_name", "ott_id")))
  expect_true(any(grepl("no rank", lg[[1]][["rank"]])))
  expect_true(any(grep("life", lg[[1]][["name"]])))
})

### ott_id() --------------------------------------------------------------------

test_that("taxonomy_taxon_info with ott_id for tax_info", {
  skip_on_cran()
  expect_equivalent(
    ott_id(tax_info),
    ott_id(taxonomy_taxon_info(ott_id(tax_info)))
  )
})

test_that("taxonomy_subtree with ott_id for tax_info", {
  skip_on_cran()
  expect_error(
    taxonomy_subtree(ott_id = ott_id(tax_info)),
    "supply one"
  )
})

test_that("tol_node_info with ott_id for tax_info", {
  skip_on_cran()
  expect_error(
    tol_node_info(ott_id(tax_info)),
    "provide a single"
  )
})

test_that("tol_subtree with ott_id for tax_info", {
  skip_on_cran()
  expect_error(
    tol_subtree(ott_id = ott_id(tax_info)),
    "provide a single"
  )
})

test_that("tol_mrca with ott_id for tax_info", {
  skip_on_cran()
  expect_equivalent(
    list("Euleutheroza" = 317277),
    ott_id(tol_mrca(ott_id(tax_info)))
  )
})

test_that("tol_induced_subtree with ott_id for tax_info", {
  skip_on_cran()
  expect_warning(
    expect_true(inherits(
      tol_induced_subtree(ott_id(tax_info)),
      "phylo"
    ))
  )
})

test_that("taxonomy_mrca with ott_id for tax_info", {
  skip_on_cran()
  expect_equivalent(
    list("Euleutheroza" = 317277),
    ott_id(taxonomy_mrca(ott_id(tax_info)))
  )
})


test_that("ott_id subset works", {
  skip_on_cran()
  expect_true(inherits(ott_id(tax_info), "otl_ott_id"))
  expect_true(inherits(ott_id(tax_info)[1], "otl_ott_id"))
  expect_true(!is.null(names(ott_id(tax_info))))
})




############################################################################
## taxon subtree                                                          ##
############################################################################

test_that("taxonomy subtree raw output", {
  skip_on_cran()
  tt <- taxonomy_subtree(515698, output_format = "raw")
  expect_true(inherits(tt, "list"))
  expect_identical(names(tt), "newick")
})

test_that("taxonomy subtree returns warning if file is provided with something else than newick output", {
  skip_on_cran()
  expect_warning(
    taxonomy_subtree(515698, output_format = "raw", file = "/foo/bar"),
    "ignored"
  )
})

test_that("taxonomy subtree writes a 'valid' newick file", {
  skip_on_cran()
  ff <- tempfile(fileext = ".tre")
  tt <- taxonomy_subtree(515698, output_format = "newick", file = ff)
  expect_true(tt)
  expect_true(grepl("^\\(", readLines(ff, n = 1, warn = FALSE)))
})

test_that("taxonomy subtree returns a valid newick string", {
  skip_on_cran()
  tt <- taxonomy_subtree(515698, output_format = "newick")
  expect_true(inherits(ape::read.tree(text = tt), "phylo"))
})

test_that("taxonomy subtree returns a valid phylo object", {
  skip_on_cran()
  tt <- taxonomy_subtree(515698, output_format = "phylo")
  expect_true(inherits(tt, "phylo"))
})

test_that("taxonomy subtree returns valid internal node names", {
  skip_on_cran()
  tt <- taxonomy_subtree(515698, output_format = "taxa")
  expect_true(inherits(tt, "list"))
  expect_equal(length(tt), 2)
  expect_equal(length(tt$tip_label), 32)
  expect_equal(length(tt$edge_label), 2)
})

test_that("taxonomy subtree works if taxa has only 1 descendant", {
  skip_on_cran()
  tt <- taxonomy_subtree(ott_id = 3658331, output_format = "taxa")
  expect_true(inherits(tt, "list"))
  expect_equal(length(tt), 2)
  expect_true(inherits(tt$tip_label, "character"))
})



############################################################################
## taxonomic MRCA                                                         ##
############################################################################

if (identical(Sys.getenv("NOT_CRAN"), "true")) {
  tax_mrca <- taxonomy_mrca(ott_ids = c(515698, 590452, 643717))
  tax_mrca_mono <- taxonomy_mrca(ott_ids = c(79623, 962377))
}

test_that("taxonomic most recent common ancestor", {
  skip_on_cran()
  expect_true(inherits(tax_mrca, "taxon_mrca"))
  expect_true(inherits(tax_mrca, "list"))
})

test_that("mrca tax_rank method", {
  skip_on_cran()
  expect_equal(
    tax_rank(tax_mrca)[1],
    list("Asterales" = "order")
  )
})

test_that("mrca tax_name method", {
  skip_on_cran()
  expect_equal(
    tax_name(tax_mrca)[1],
    list("Asterales" = "Asterales")
  )
})

test_that("mrca ott_id method", {
  skip_on_cran()
  expect_equivalent(
    ott_id(tax_mrca)[1],
    list("Asterales" = 1042120)
  )
  expect_true(inherits(ott_id(tax_mrca), "otl_ott_id"))
})

test_that("mrca unique_name method", {
  skip_on_cran()
  expect_equal(
    unique_name(tax_mrca)[1],
    list("Asterales" = "Asterales")
  )
  expect_true(inherits(
    unique_name(tax_mrca),
    "otl_unique_name"
  ))
})

test_that("mrca tax_sources method", {
  skip_on_cran()
  ## issue with their taxonomy
  skip("need to fixed upstream")
  expect_equal(
    tax_sources(tax_mrca)[1],
    list(
      "Asterales" =
        c(
          "ncbi:4209", "worms:234044",
          "gbif:414", "irmng:10011"
        )
    )
  )
  expect_true(inherits(
    tax_sources(tax_mrca),
    "otl_tax_sources"
  ))
})

test_that("mrca is_suppressed method", {
  skip_on_cran()
  expect_true(inherits(
    is_suppressed(tax_mrca),
    c("otl_is_suppressed", "list")
  ))
  expect_equal(
    is_suppressed(tax_mrca)[1],
    list("Asterales" = FALSE)
  )
})

test_that("mrca flags method", {
  skip_on_cran()
  expect_true(inherits(
    flags(tax_mrca),
    c("otl_flags", "list")
  ))
  expect_equal(
    flags(tax_mrca)[1],
    list("Asterales" = NULL)
  )
})

### ott_id() --------------------------------------------------------------------

test_that("taxonomy_taxon_info with ott_id for tax_mrca", {
  skip_on_cran()
  expect_equivalent(
    ott_id(tax_mrca_mono),
    ott_id(taxonomy_taxon_info(ott_id(tax_mrca_mono)))
  )
})

test_that("taxonomy_subtree with ott_id for tax_mrca", {
  skip_on_cran()
  tt <- taxonomy_subtree(ott_id = ott_id(tax_mrca_mono))
  expect_true(length(tt[["tip_label"]]) > 10)
  expect_true(length(tt[["edge_label"]]) > 1)
})

test_that("tol_node_info with ott_id for tax_mrca", {
  skip_on_cran()
  expect_equivalent(
    ott_id(tax_mrca_mono),
    ott_id(tol_node_info(ott_id(tax_mrca_mono)))
  )
})

test_that("tol_subtree with ott_id for tax_mrca", {
  skip_on_cran()
  expect_warning(
    tt <- tol_subtree(ott_id = ott_id(tax_mrca_mono)),
    "Dropping"
  )
  expect_true(inherits(tt, "phylo"))
  expect_true(length(tt$tip.label) > 1)
  expect_true(length(tt$node.label) > 1)
})

test_that("tol_mrca with ott_id for tax_mrca", {
  skip_on_cran()
  expect_equivalent(
    ott_id(tax_mrca_mono),
    ott_id(tol_mrca(ott_id(tax_mrca_mono)))
  )
})

test_that("tol_induced_subtree with ott_id for tax_mrca", {
  skip_on_cran()
  expect_error(
    tol_induced_subtree(ott_id(tax_mrca_mono)),
    "least two valid"
  )
})

test_that("taxonomy_mrca with ott_id for tax_mrca", {
  skip_on_cran()
  expect_equivalent(
    ott_id(tax_mrca_mono),
    ott_id(taxonomy_mrca(ott_id(tax_mrca_mono)))
  )
})

test_that("ott_id subset works", {
  skip_on_cran()
  expect_true(inherits(ott_id(tax_mrca_mono), "otl_ott_id"))
  expect_true(inherits(ott_id(tax_mrca_mono)[1], "otl_ott_id"))
  expect_true(!is.null(names(ott_id(tax_mrca_mono))))
})



### is_in_tree() ---------------------------------------------------------------

if (identical(Sys.getenv("NOT_CRAN"), "true")) {
  spp <- c("Tyrannosaurus rex", "Velociraptor", "Fabaceae", "Solanaceae")
  ot_names <- tnrs_match_names(spp)
  ot_ids <- ott_id(ot_names)
}

test_that("test is_in_tree", {
  skip_on_cran()
  in_tree <- is_in_tree(ot_ids)
  expect_equal(sum(in_tree), 4)
  expect_true(all(names(in_tree) %in% spp))
})