library(testthat)
context("hierarchy")
## Creating test data
plantae <- taxon(
name = taxon_name("Plantae")
)
solanaceae <- taxon(
name = taxon_name("Solanaceae")
)
solanum <- taxon(
name = taxon_name("Solanum")
)
sl <- taxon(
name = taxon_name("Solanum lycopersicum")
)
test_that("Characters as inputs", {
aa <- hierarchy(plantae, solanaceae, solanum, sl)
expect_is(aa, "Hierarchy")
expect_is(aa$taxa, "list")
expect_is(aa$taxa[[1]], "Taxon")
expect_is(aa$print, "function")
expect_equal(
aa,
hierarchy("Plantae", "Solanaceae", "Solanum", "Solanum lycopersicum")
)
})
test_that("hierarchy - empty", {
aa <- hierarchy()
expect_is(aa, "Hierarchy")
expect_equal(length(aa$taxa), 0)
expect_null(aa$ranklist)
# prints 'Empty hierarchy'
expect_output(
print(hierarchy()),
"Empty hierarchy"
)
expect_output(
print(hierarchy()),
"<Hierarchy>"
)
})
plantae <- taxon(
name = taxon_name("Plantae"),
rank = "kingdom"
)
solanaceae <- taxon(
name = taxon_name("Solanaceae"),
rank = "family"
)
solanum <- taxon(
name = taxon_name("Solanum"),
rank = "genus"
)
sl <- taxon(
name = taxon_name("Solanum lycopersicum"),
rank = "species"
)
test_that("hierarchy - print when not empty", {
expect_output(
print(hierarchy(plantae, solanaceae, solanum, sl)),
"Plantae / kingdom /"
)
expect_output(
print(hierarchy(plantae, solanaceae, solanum, sl)),
"Solanaceae / family /"
)
expect_output(
print(hierarchy(plantae, solanaceae, solanum, sl)),
"Solanum / genus /"
)
expect_output(
print(hierarchy(plantae, solanaceae, solanum, sl)),
"Solanum lycopersicum / species /"
)
})
test_that("hierarchy fails well", {
expect_error(
hierarchy(mtcars),
"taxon name must be a class that is or inherits one of the following classes")
expect_error(
hierarchy(c, 5),
"taxon name must be a class that is or inherits one of the following classes")
})
test_that("dots and .list return the same output", {
expect_equal(hierarchy(plantae, solanaceae, solanum, sl),
hierarchy(.list = list(plantae, solanaceae, solanum, sl)))
})
test_that("hierarchy can do null data", {
# empty hierarchy()
x <- hierarchy()
expect_is(x, "Hierarchy")
expect_equal(length(x$taxa), 0)
expect_null(x$ranklist)
# specifying NULL
x <- hierarchy(NULL, NULL)
expect_is(x, "Hierarchy")
expect_equal(length(x$taxa), 2)
expect_null(x$ranklist)
})
test_that("hierarchy pop", {
x <- taxon(
name = taxon_name("Poaceae"),
rank = taxon_rank("family"),
id = taxon_id(4479)
)
y <- taxon(
name = taxon_name("Poa"),
rank = taxon_rank("genus"),
id = taxon_id(4544)
)
z <- taxon(
name = taxon_name("Poa annua"),
rank = taxon_rank("species"),
id = taxon_id(93036)
)
obj <- hierarchy(z, y, x)
res <- pop(obj, ranks("species"))
expect_equal(length(res$taxa), 2)
expect_equal(res, pop(obj, nms("Poa annua")))
expect_equal(res, pop(obj, ids("93036")))
expect_error(pop(hierarchy(), nms("Poa annua")),
"no taxa found")
})
test_that("hierarchy pick", {
x <- taxon(
name = taxon_name("Poaceae"),
rank = taxon_rank("family"),
id = taxon_id(4479)
)
y <- taxon(
name = taxon_name("Poa"),
rank = taxon_rank("genus"),
id = taxon_id(4544)
)
z <- taxon(
name = taxon_name("Poa annua"),
rank = taxon_rank("species"),
id = taxon_id(93036)
)
obj <- hierarchy(z, y, x)
res <- pick(obj, ranks("species"))
expect_equal(length(res$taxa), 1)
expect_equal(res, pick(obj, nms("Poa annua")))
expect_equal(res, pick(obj, ids("93036")))
expect_error(pick(hierarchy(), nms("Poa annua")),
"no taxa found")
})
test_that("hierarchy span", {
x <- taxon(
name = taxon_name("Poaceae"),
rank = taxon_rank("family"),
id = taxon_id(4479)
)
y <- taxon(
name = taxon_name("Poa"),
rank = taxon_rank("genus"),
id = taxon_id(4544)
)
z <- taxon(
name = taxon_name("Poa annua"),
rank = taxon_rank("species"),
id = taxon_id(93036)
)
obj <- hierarchy(z, y, x)
res <- span(obj, ranks("family", "genus"))
expect_equal(length(res$taxa), 2)
expect_equal(res, span(obj, nms("Poaceae", "Poa")))
expect_equal(res, span(obj, ids("4544", "4479")))
expect_error(span(hierarchy(), nms("Poa annua")),
"no taxa found")
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.