tests/testthat/test--taxonomy.R

context("taxonomy")
library(taxa)


# Creating taxonomy objects

test_that("taxonomy objects can be created from character input", {
  x <- taxonomy(c('Carnivora', 'Felidae', 'Panthera', 'Panthera leo',
                  'Panthera tigris', 'Ursidae', 'Ursus', 'Ursus arctos'),
                supertaxa = c(NA, 1, 2, 3, 3, 1, 6, 7))
  expect_equal(length(x), 8)
  expect_equal(class(x)[1], 'taxa_taxonomy')
})

test_that("taxonomy objects can be created from factor input", {
  x <- taxonomy(as.factor(c('Carnivora', 'Felidae', 'Panthera', 'Panthera leo',
                            'Panthera tigris', 'Ursidae', 'Ursus', 'Ursus arctos')),
                supertaxa = c(NA, 1, 2, 3, 3, 1, 6, 7))
  expect_equal(length(x), 8)
  expect_equal(class(x)[1], 'taxa_taxonomy')
})

test_that("taxonomy objects can be created with names", {
  x <- taxonomy(c('Carnivora', 'Felidae', 'Panthera', 'Panthera leo',
                  'Panthera tigris', 'Ursidae', 'Ursus', 'Ursus arctos'),
                supertaxa = c(NA, 1, 2, 3, 3, 1, 6, 7),
                .names = letters[1:8])
  expect_equal(length(x), 8)
  expect_equal(class(x)[1], 'taxa_taxonomy')
  expect_equal(names(x), letters[1:8])
})


# Printing

test_that("taxonomy objects can be printed", {
  x <- taxonomy(taxon(name = c('Carnivora', 'Felidae', 'Panthera', 'Panthera leo',
                               'Panthera tigris', 'Ursidae', 'Ursus', 'Ursus arctos'),
                      rank = c('order', 'family', 'genus', 'species',
                               'species', 'family', 'genus', 'species'),
                      id = taxon_id(c('33554', '9681', '9688', '9689',
                                      '9694', '9632', '9639', '9644'),
                                    db = 'ncbi'),
                      auth = c('Bowdich, 1821', 'Fischer de Waldheim, 1817', 'Oken, 1816', 'L., 1758',
                               'L., 1758', 'Fischer de Waldheim, 1817', 'L., 1758', 'L., 1758')),
                supertaxa = c(NA, 1, 2, 3, 3, 1, 6, 7))
  names(x) <- letters[1:8]
  verify_output(path = test_path('print_outputs', 'taxonomy.txt'),
                code = {print(x)},
                crayon = TRUE)
})


# Subsetting taxonomy objects with `[`

test_that("taxonomy objects can be `[` subset by index", {
  x <- taxonomy(c('Carnivora', 'Felidae', 'Panthera', 'Panthera leo',
                  'Panthera tigris', 'Ursidae', 'Ursus', 'Ursus arctos'),
                supertaxa = c(NA, 1, 2, 3, 3, 1, 6, 7),
                .names = letters[1:8])

  # By default, all subtaxa are included
  expect_equal(names(x[1]), letters[1:8])
  expect_equal(names(x['c']), c('c', 'd', 'e'))
  expect_equal(names(x[c(FALSE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE)]), 'e')

  ## Can turn off inclusion of subtaxa
  expect_equal(names(x[1, subtaxa = FALSE]), 'a')
  expect_equal(names(x['c', subtaxa = FALSE]), 'c')
  expect_equal(names(x[c(FALSE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE), subtaxa = FALSE]), 'e')

  ## Can include supertaxa
  expect_equal(names(x[1, supertaxa = TRUE]), letters[1:8])
  expect_equal(names(x['c', supertaxa = TRUE]), c("a", "b", "c", "d", "e"))
  expect_equal(names(x[c(FALSE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE), supertaxa = TRUE]), c("a", "b", "c", "e"))

  ## Can include only supertaxa
  expect_equal(names(x[1, subtaxa = FALSE, supertaxa = TRUE]), 'a')
  expect_equal(names(x['c', subtaxa = FALSE, supertaxa = TRUE]), c("a", "b", "c"))
  expect_equal(names(x[c(FALSE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE), subtaxa = FALSE, supertaxa = TRUE]), c("a", "b", "c", "e"))

  ## Can invert the selection
  expect_equal(length(x[1, invert = TRUE]), 0)
  expect_equal(names(x['c', invert = TRUE]), c("a", "b", "f", "g", "h"))
  expect_equal(names(x['c', supertaxa = TRUE, invert = TRUE]), c("f", "g", "h"))
  expect_equal(names(x['c', subtaxa = FALSE, invert = TRUE]), c("a", "b", "d", "e", "f", "g", "h"))
  expect_equal(names(x['c', subtaxa = FALSE, supertaxa = TRUE, invert = TRUE]), c("d", "e", "f", "g", "h"))
})


# Subsetting taxonomy objects with `[[`

test_that("taxonomy objects can be subset with `[[`", {
  x <- taxonomy(c('Carnivora', 'Felidae', 'Panthera', 'Panthera leo',
                  'Panthera tigris', 'Ursidae', 'Ursus', 'Ursus arctos'),
                supertaxa = c(NA, 1, 2, 3, 3, 1, 6, 7),
                .names = letters[1:8])
  expect_equal(x[3], x[[3]])
  expect_equal(x['c'], x[['c']])
  expect_equal(x[5], x[[c(FALSE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE)]])
})

test_that("subsetting taxonomy objects with `[[` only allows for a single selection", {
  x <- taxonomy(c('Carnivora', 'Felidae', 'Panthera', 'Panthera leo',
                  'Panthera tigris', 'Ursidae', 'Ursus', 'Ursus arctos'),
                supertaxa = c(NA, 1, 2, 3, 3, 1, 6, 7),
                .names = letters[1:8])
  expect_error(x[[1:2]], "attempt to select more than one element")
  expect_error(x[[c('e', 'f')]], "attempt to select more than one element")
  expect_error(x[[c(FALSE, TRUE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE)]], "attempt to select more than one element")
  expect_error(x[[numeric(0)]], "attempt to select less than one element")
  expect_error(x[[character(0)]], "attempt to select less than one element")
  expect_error(x[[c(FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE)]], "attempt to select less than one element")
})



# Setting names of taxonomy objects

test_that("taxonomy objects can be named", {
  x <- taxonomy(as.factor(c('Carnivora', 'Felidae', 'Panthera', 'Panthera leo',
                            'Panthera tigris', 'Ursidae', 'Ursus', 'Ursus arctos')),
                supertaxa = c(NA, 1, 2, 3, 3, 1, 6, 7))
  names(x) <- letters[1:8]
  expect_equal(x, taxonomy(as.factor(c('Carnivora', 'Felidae', 'Panthera', 'Panthera leo',
                                       'Panthera tigris', 'Ursidae', 'Ursus', 'Ursus arctos')),
                           supertaxa = c(NA, 1, 2, 3, 3, 1, 6, 7),
                           .names = letters[1:8]))
  expect_equal(names(x),  letters[1:8])
  names(x)[2] <- 'x'
  expect_equal(names(x), c("a", "x", "c", "d", "e", "f", "g", "h"))
  names(x)[2:3] <- 'x'
  expect_equal(names(x), c("a", "x", "x", "d", "e", "f", "g", "h"))
})


# Assigning values to taxonomy objects

test_that("Replacing a value with no taxonomic context does not change its place in the tree", {
  x <- taxonomy(c('Carnivora', 'Felidae', 'Panthera', 'Panthera leo',
                  'Panthera tigris', 'Ursidae', 'Ursus', 'Ursus arctos'),
                supertaxa = c(NA, 1, 2, 3, 3, 1, 6, 7),
                .names = letters[1:8])

  x[3] <- 'XXX'
  expect_equal(length(x), 8)
  expect_equal(supertaxa(x, subset = 3, max_depth = 1)[[1]], c(b = 2))
  expect_equal(vctrs::field(x, 'supertaxa')[4:5], c(3, 3))
})

# Assign values to components

test_that("components of taxonomy objects can be assigned", {
  x <- taxonomy(c('A', 'B', 'C'))
  tax_auth(x) <- c('a', 'b', 'c')
  expect_equal(tax_auth(x), taxon_authority(c('a', 'b', 'c')))
  tax_name(x) <- c('d', 'e', 'f')
  expect_equal(tax_name(x), c('d', 'e', 'f'))
  tax_rank(x) <- c('a', 'b', 'c')
  expect_equal(tax_rank(x), taxon_rank(c('a', 'b', 'c')))
  tax_id(x) <- c('1', '2', '3')
  expect_equal(tax_id(x), taxon_id(c('1', '2', '3')))
  tax_db(x) <- c('ncbi', 'ncbi', 'ncbi')
  expect_equal(tax_db(x), taxon_db(c('ncbi', 'ncbi', 'ncbi')))
  tax_author(x) <- c('g', 'h', 'i')
  expect_equal(tax_author(x), c('g', 'h', 'i'))
  tax_date(x) <- c('4', '5', '6')
  expect_equal(tax_date(x), c('4', '5', '6'))
  tax_cite(x) <- c('x', 'y', 'z')
  expect_equal(tax_cite(x), c('x', 'y', 'z'))
})

# NOTE: It seems vctrs does not allow defining new values by index. Not sure if we will try to make this work anyway
#
# test_that("New values with no taxonomic context are added at the root of the tree", {
#   x <- taxonomy(c('Carnivora', 'Felidae', 'Panthera', 'Panthera leo',
#                   'Panthera tigris', 'Ursidae', 'Ursus', 'Ursus arctos'),
#                 supertaxa = c(NA, 1, 2, 3, 3, 1, 6, 7),
#                 .names = letters[1:8])
#
#   x[9] <- 'XXX'
#   expect_equal(length(x), 9)
#   expect_true(is_root(x)[9])
#
#   x[11] <- 'YYY'
#   expect_equal(length(x), 11)
#   expect_true(all(is_root(x)[9:11]))
# })

test_that("Replacing a value with specified supertaxon preserves its subtaxa", {
  x <- taxonomy(c('Carnivora', 'Felidae', 'Panthera', 'Panthera leo',
                  'Panthera tigris', 'Ursidae', 'Ursus', 'Ursus arctos'),
                supertaxa = c(NA, 1, 2, 3, 3, 1, 6, 7),
                .names = letters[1:8])
  x[3, supertaxa = 6] <- 'XXX'
  expect_equal(length(x), 8)
  expect_equal(vctrs::field(x, 'supertaxa')[3], 6)
  expect_equal(vctrs::field(x, 'supertaxa')[4:5], c(3, 3))
})

test_that("Replacing a value with specified supertaxon cant make cyclical trees", {
  x <- taxonomy(c('Carnivora', 'Felidae', 'Panthera', 'Panthera leo',
                  'Panthera tigris', 'Ursidae', 'Ursus', 'Ursus arctos'),
                supertaxa = c(NA, 1, 2, 3, 3, 1, 6, 7),
                .names = letters[1:8])
  x[3, supertaxa = 4] <- 'XXX'
  expect_equal(length(x), 8)
  expect_equal(vctrs::field(x, 'supertaxa')[3], 4)
  expect_equal(vctrs::field(x, 'supertaxa')[5], 3)
})

# NOTE: It seems vctrs does not allow defining new values by index. Not sure if we will try to make this work anyway
#
# test_that("Adding a value with specified supertaxon", {
#   x <- taxonomy(c('Carnivora', 'Felidae', 'Panthera', 'Panthera leo',
#                   'Panthera tigris', 'Ursidae', 'Ursus', 'Ursus arctos'),
#                 supertaxa = c(NA, 1, 2, 3, 3, 1, 6, 7),
#                 .names = letters[1:8])
#   x[9, supertaxa = 6] <- 'XXX'
#   expect_equal(length(x), 9)
#   expect_equal(vctrs::field(x, 'supertaxa')[9], 6)
# })

test_that("Replacing a value with specified subtaxa sets its supertaxon to the common grouping of the subtaxa", {
  x <- taxonomy(c('Carnivora', 'Felidae', 'Panthera', 'Panthera leo',
                  'Panthera tigris', 'Ursidae', 'Ursus', 'Ursus arctos'),
                supertaxa = c(NA, 1, 2, 3, 3, 1, 6, 7),
                .names = letters[1:8])
  x[2, subtaxa = 7:8] <- 'XXX'
  expect_equal(length(x), 8)
  expect_equal(vctrs::field(x, 'supertaxa')[2], 6)
  expect_equal(vctrs::field(x, 'supertaxa')[7], 2)
})

# NOTE: It seems vctrs does not allow defining new values by index. Not sure if we will try to make this work anyway
#
# test_that("Adding a value with specified subtaxa sets its supertaxon to the common grouping of the subtaxa", {
#   x <- taxonomy(c('Carnivora', 'Felidae', 'Panthera', 'Panthera leo',
#                   'Panthera tigris', 'Ursidae', 'Ursus', 'Ursus arctos'),
#                 supertaxa = c(NA, 1, 2, 3, 3, 1, 6, 7),
#                 .names = letters[1:8])
#   x[9, subtaxa = 7:8] <- 'XXX'
#   expect_equal(length(x), 9)
#   expect_equal(vctrs::field(x, 'supertaxa')[9], 6)
#   expect_equal(vctrs::field(x, 'supertaxa')[7], 9)
# })

test_that("Replacing a value with specified subtaxa cant make cyclical trees", {
  x <- taxonomy(c('Carnivora', 'Felidae', 'Panthera', 'Panthera leo',
                  'Panthera tigris', 'Ursidae', 'Ursus', 'Ursus arctos'),
                supertaxa = c(NA, 1, 2, 3, 3, 1, 6, 7),
                .names = letters[1:8])
  x[3, subtaxa = 2] <- 'XXX'
  expect_equal(length(x), 8)
  expect_equal(vctrs::field(x, 'supertaxa')[3], 1)
  expect_equal(vctrs::field(x, 'supertaxa')[2], 3)
})

test_that("Cannot make values supertaxa/subtaxa of themselves", {
  x <- taxonomy(c('Carnivora', 'Felidae', 'Panthera', 'Panthera leo',
                  'Panthera tigris', 'Ursidae', 'Ursus', 'Ursus arctos'),
                supertaxa = c(NA, 1, 2, 3, 3, 1, 6, 7),
                .names = letters[1:8])
  expect_error(x[2, supertaxa = 2] <- 'XXX', 'Cannot set a taxon to be a supertaxon of itself')
  expect_error(x[1:2, supertaxa = 2] <- 'XXX', 'Cannot set a taxon to be a supertaxon of itself')
  expect_error(x[2, subtaxa = 2] <- 'XXX', 'Cannot set a taxon to be a subtaxon of itself')
  expect_error(x[2, subtaxa = 2:3] <- 'XXX', 'Cannot set a taxon to be a subtaxon of itself')
})






# Can be concatenated

test_that("taxonomy objects can be combined", {
  x <- taxonomy(taxon(c('Carnivora', 'Felidae', 'Panthera', 'Panthera leo',
                        'Panthera tigris', 'Ursidae', 'Ursus', 'Ursus arctos'),
                      rank = c('order', 'family', 'genus', 'species',
                               'species', 'family', 'genus', 'species')),
                supertaxa = c(NA, 1, 2, 3, 3, 1, 6, 7),
                .names = letters[1:8])
  y <- taxonomy(taxon(c('Carnivora', 'Felidae', 'Panthera', 'Panthera leo'),
                      rank = c('order', 'family', 'genus', 'species')),
                supertaxa = c(NA, 1, 2, 3),
                .names = letters[1:4])
  z <- taxonomy(taxon(c('Carnivora', 'Felidae'), rank = c('order', 'family')),
                supertaxa = c(NA, 1),
                .names = letters[1:2])
  expect_equal(
    c(x, y),
    taxonomy(taxon(c('Carnivora', 'Felidae', 'Panthera', 'Panthera leo',
                     'Panthera tigris', 'Ursidae', 'Ursus', 'Ursus arctos',
                     'Carnivora', 'Felidae', 'Panthera', 'Panthera leo'),
                   rank = c('order', 'family', 'genus', 'species',
                            'species', 'family', 'genus', 'species',
                            'order', 'family', 'genus', 'species')),
             supertaxa = c(c(NA, 1, 2, 3, 3, 1, 6, 7),  c(NA, 1, 2, 3) + 8),
             .names = c(letters[1:8], letters[1:4]))
  )
  expect_equal(
    c(x, y, z),
    taxonomy(taxon(c('Carnivora', 'Felidae', 'Panthera', 'Panthera leo',
                     'Panthera tigris', 'Ursidae', 'Ursus', 'Ursus arctos',
                     'Carnivora', 'Felidae', 'Panthera', 'Panthera leo',
                     'Carnivora', 'Felidae'),
                   rank = c('order', 'family', 'genus', 'species',
                            'species', 'family', 'genus', 'species',
                            'order', 'family', 'genus', 'species',
                            'order', 'family')),
             supertaxa = c(c(NA, 1, 2, 3, 3, 1, 6, 7),  c(NA, 1, 2, 3) + 8, c(NA, 1) + 12),
             .names = c(letters[1:8], letters[1:4], letters[1:2]))
  )
  expect_equal(c(x, y, x, y), c(c(x, y), c(x, y)))
  expect_equal(c(x), x)
})




# Works with `seq_along`

test_that("taxonomy objects work with `seq_along`", {
  x <- taxonomy(c('Carnivora', 'Felidae', 'Panthera', 'Panthera leo',
                  'Panthera tigris', 'Ursidae', 'Ursus', 'Ursus arctos'),
                supertaxa = c(NA, 1, 2, 3, 3, 1, 6, 7),
                .names = letters[1:8])
  expect_equal(seq_along(x), 1:8)
})


# Can be converted to character

test_that("taxonomy objects can be converted to characters", {
  x <- taxonomy(c('Carnivora', 'Felidae', 'Panthera', 'Panthera leo',
                  'Panthera tigris', 'Ursidae', 'Ursus', 'Ursus arctos'),
                supertaxa = c(NA, 1, 2, 3, 3, 1, 6, 7))
  expect_equal(as.character(x),
               c('Carnivora', 'Felidae', 'Panthera', 'Panthera leo',
                 'Panthera tigris', 'Ursidae', 'Ursus', 'Ursus arctos'))
})

test_that("named taxonomy objects can be converted to characters", {
  x <- taxonomy(c('Carnivora', 'Felidae', 'Panthera', 'Panthera leo',
                  'Panthera tigris', 'Ursidae', 'Ursus', 'Ursus arctos'),
                supertaxa = c(NA, 1, 2, 3, 3, 1, 6, 7),
                .names = letters[1:8])
  expect_equal(as.character(x),
               stats::setNames(
                 c('Carnivora', 'Felidae', 'Panthera', 'Panthera leo',
                   'Panthera tigris', 'Ursidae', 'Ursus', 'Ursus arctos'),
                 letters[1:8]
               ))
})


# Can be converted to factor

test_that("taxonomy objects can be converted to factor", {
  x <- taxonomy(c('Carnivora', 'Felidae', 'Panthera', 'Panthera leo',
                  'Panthera tigris', 'Ursidae', 'Ursus', 'Ursus arctos'),
                supertaxa = c(NA, 1, 2, 3, 3, 1, 6, 7))
  expect_equivalent(as.factor(x), as.factor(as.character(x)))
})

test_that("named taxonomy objects can be converted to factor", {
  x <- taxonomy(c('Carnivora', 'Felidae', 'Panthera', 'Panthera leo',
                  'Panthera tigris', 'Ursidae', 'Ursus', 'Ursus arctos'),
                supertaxa = c(NA, 1, 2, 3, 3, 1, 6, 7),
                .names = letters[1:8])
  expect_equivalent(as.factor(x), as.factor(as.character(x)))
})


# Can be converted to a data.frame

test_that("taxonomy objects can be converted to a data.frame", {
  x <- taxonomy(taxon(name = c('Carnivora', 'Felidae', 'Panthera', 'Panthera leo',
                               'Panthera tigris', 'Ursidae', 'Ursus', 'Ursus arctos'),
                      rank = c('order', 'family', 'genus', 'species',
                               'species', 'family', 'genus', 'species'),
                      id = taxon_id(c('33554', '9681', '9688', '9689',
                                      '9694', '9632', '9639', '9644'),
                                    db = 'ncbi'),
                      auth = c('Bowdich, 1821', 'Fischer de Waldheim, 1817', 'Oken, 1816', 'L., 1758',
                               'L., 1758', 'Fischer de Waldheim, 1817', 'L., 1758', 'L., 1758')),
                supertaxa = c(NA, 1, 2, 3, 3, 1, 6, 7))

  expect_equal(
    as_data_frame(x),
    data.frame(
      supertaxon = c(NA, 1, 2, 3, 3, 1, 6, 7),
      tax_name = c('Carnivora', 'Felidae', 'Panthera', 'Panthera leo',
                   'Panthera tigris', 'Ursidae', 'Ursus', 'Ursus arctos'),
      tax_rank = c('order', 'family', 'genus', 'species',
                   'species', 'family', 'genus', 'species'),
      tax_id = c('33554', '9681', '9688', '9689',
                 '9694', '9632', '9639', '9644'),
      tax_db = 'ncbi',
      tax_author = c('Bowdich', 'Fischer de Waldheim', 'Oken', 'L.',
                     'L.', 'Fischer de Waldheim', 'L.', 'L.'),
      tax_date = c('1821', '1817', '1816', '1758',
                   '1758', '1817', '1758', '1758'),
      tax_cite = ''
      )
  )
})

test_that("named taxonomy objects can be converted to data.frame", {
  x <- taxonomy(taxon(name = c('Carnivora', 'Felidae', 'Panthera', 'Panthera leo',
                               'Panthera tigris', 'Ursidae', 'Ursus', 'Ursus arctos'),
                      rank = c('order', 'family', 'genus', 'species',
                               'species', 'family', 'genus', 'species'),
                      id = taxon_id(c('33554', '9681', '9688', '9689',
                                      '9694', '9632', '9639', '9644'),
                                    db = 'ncbi'),
                      auth = c('Bowdich, 1821', 'Fischer de Waldheim, 1817', 'Oken, 1816', 'L., 1758',
                               'L., 1758', 'Fischer de Waldheim, 1817', 'L., 1758', 'L., 1758')),
                supertaxa = c(NA, 1, 2, 3, 3, 1, 6, 7))
  names(x) <- letters[1:8]

  expect_equal(
    as_data_frame(x),
    data.frame(
      supertaxon = c(NA, 1, 2, 3, 3, 1, 6, 7),
      tax_name = c('Carnivora', 'Felidae', 'Panthera', 'Panthera leo',
                   'Panthera tigris', 'Ursidae', 'Ursus', 'Ursus arctos'),
      tax_rank = c('order', 'family', 'genus', 'species',
                   'species', 'family', 'genus', 'species'),
      tax_id = c('33554', '9681', '9688', '9689',
                 '9694', '9632', '9639', '9644'),
      tax_db = 'ncbi',
      tax_author = c('Bowdich', 'Fischer de Waldheim', 'Oken', 'L.',
                     'L.', 'Fischer de Waldheim', 'L.', 'L.'),
      tax_date = c('1821', '1817', '1816', '1758',
                   '1758', '1817', '1758', '1758'),
      tax_cite = ''
    )
  )
})


# Can be converted to a tibble

test_that("taxonomy objects can be converted to a tibble", {
  x <- taxonomy(taxon(name = c('Carnivora', 'Felidae', 'Panthera', 'Panthera leo',
                               'Panthera tigris', 'Ursidae', 'Ursus', 'Ursus arctos'),
                      rank = c('order', 'family', 'genus', 'species',
                               'species', 'family', 'genus', 'species'),
                      id = taxon_id(c('33554', '9681', '9688', '9689',
                                      '9694', '9632', '9639', '9644'),
                                    db = 'ncbi'),
                      auth = c('Bowdich, 1821', 'Fischer de Waldheim, 1817', 'Oken, 1816', 'L., 1758',
                               'L., 1758', 'Fischer de Waldheim, 1817', 'L., 1758', 'L., 1758')),
                supertaxa = c(NA, 1, 2, 3, 3, 1, 6, 7))

  expect_equal(
    tibble::as_tibble(x),
    tibble::tibble(
      supertaxon = c(NA, 1, 2, 3, 3, 1, 6, 7),
      tax_name = c('Carnivora', 'Felidae', 'Panthera', 'Panthera leo',
                   'Panthera tigris', 'Ursidae', 'Ursus', 'Ursus arctos'),
      tax_rank = c('order', 'family', 'genus', 'species',
                   'species', 'family', 'genus', 'species'),
      tax_id = c('33554', '9681', '9688', '9689',
                 '9694', '9632', '9639', '9644'),
      tax_db = 'ncbi',
      tax_author = c('Bowdich', 'Fischer de Waldheim', 'Oken', 'L.',
                     'L.', 'Fischer de Waldheim', 'L.', 'L.'),
      tax_date = c('1821', '1817', '1816', '1758',
                   '1758', '1817', '1758', '1758'),
      tax_cite = ''
    )
  )
})

test_that("named taxonomy objects can be converted to a tibble", {
  x <- taxonomy(taxon(name = c('Carnivora', 'Felidae', 'Panthera', 'Panthera leo',
                               'Panthera tigris', 'Ursidae', 'Ursus', 'Ursus arctos'),
                      rank = c('order', 'family', 'genus', 'species',
                               'species', 'family', 'genus', 'species'),
                      id = taxon_id(c('33554', '9681', '9688', '9689',
                                      '9694', '9632', '9639', '9644'),
                                    db = 'ncbi'),
                      auth = c('Bowdich, 1821', 'Fischer de Waldheim, 1817', 'Oken, 1816', 'L., 1758',
                               'L., 1758', 'Fischer de Waldheim, 1817', 'L., 1758', 'L., 1758')),
                supertaxa = c(NA, 1, 2, 3, 3, 1, 6, 7))
  names(x) <- letters[1:8]

  expect_equal(
    tibble::as_tibble(x),
    tibble::tibble(
      supertaxon = c(NA, 1, 2, 3, 3, 1, 6, 7),
      tax_name = c('Carnivora', 'Felidae', 'Panthera', 'Panthera leo',
                   'Panthera tigris', 'Ursidae', 'Ursus', 'Ursus arctos'),
      tax_rank = c('order', 'family', 'genus', 'species',
                   'species', 'family', 'genus', 'species'),
      tax_id = c('33554', '9681', '9688', '9689',
                 '9694', '9632', '9639', '9644'),
      tax_db = 'ncbi',
      tax_author = c('Bowdich', 'Fischer de Waldheim', 'Oken', 'L.',
                     'L.', 'Fischer de Waldheim', 'L.', 'L.'),
      tax_date = c('1821', '1817', '1816', '1758',
                   '1758', '1817', '1758', '1758'),
      tax_cite = ''
    )
  )
})


# Can be made unique

test_that("taxa in taxonomy objects can be made unique", {
  x <- taxonomy(c('Carnivora', 'Felidae', 'Panthera', 'Panthera leo',
                  'Panthera tigris', 'Ursidae', 'Ursus', 'Ursus arctos'),
                supertaxa = c(NA, 1, 2, 3, 3, 1, 6, 7))
  y <- taxonomy(c('Carnivora', 'Felidae', 'Panthera', 'Panthera leo',
                  'Panthera tigris', 'Kitty'),
                supertaxa = c(NA, 1, 2, 3, 3, 3))
  x <- c(x, y)

  expect_equal(
    unique(x),
    taxonomy(c('Carnivora', 'Felidae', 'Panthera', 'Panthera leo',
               'Panthera tigris', 'Ursidae', 'Ursus', 'Ursus arctos', 'Kitty'),
             supertaxa = c(NA, 1, 2, 3, 3, 1, 6, 7, 3))
  )
})


# works with %in%

test_that("taxonomy objects work with %in%", {
  x <- taxonomy(c('Carnivora', 'Felidae', 'Panthera', 'Panthera leo',
                  'Panthera tigris', 'Ursidae', 'Ursus', 'Ursus arctos'),
                supertaxa = c(NA, 1, 2, 3, 3, 1, 6, 7))
  expect_true('Carnivora' %in% x)
  expect_equal(x %in% 'Carnivora', tax_name(x) %in% 'Carnivora')
  expect_true(x[1, subtaxa = FALSE] %in% x)
  expect_equal(x %in% x[1, subtaxa = FALSE], tax_name(x) %in% 'Carnivora')
  expect_false('sapiens' %in% x)
  expect_true(factor('Carnivora') %in% x)
  expect_equal(which(x %in% factor('Carnivora')), 1)
})

Try the taxa package in your browser

Any scripts or data that you put into this service are public.

taxa documentation built on April 12, 2022, 9:06 a.m.