diff --git a/R/bind_databases.R b/R/bind_databases.R index f17cd11..a8b1bb2 100644 --- a/R/bind_databases.R +++ b/R/bind_databases.R @@ -64,7 +64,7 @@ bind_databases <- function(..., databases = list(...)) { build_info = list(session_info = utils::sessionInfo()) ) - class(ret) <- c("list", "traits.build") + class(ret) <- c("traits.build") ret } diff --git a/R/helper.R b/R/helper.R new file mode 100644 index 0000000..3d3eefb --- /dev/null +++ b/R/helper.R @@ -0,0 +1,30 @@ + + +test_database_structure <- function(database, taxa = NA, dataset_id = NA, n_row = NA) { + + table_names <- c("traits", "locations", "contexts", "methods", "excluded_data", "taxonomic_updates", "taxa", "contributors", + "sources", "definitions", "schema", "metadata", "build_info") + + expect_type(database, "list") + # should this be "traits.build or austraits?? + #expect_equal(class(database), "austraits") + expect_equal(class(database), "traits.build") + + expect_equal(names(database), table_names) + + expect_contains(database$traits$taxon_name |> unique(), database$taxa$taxon_name |> unique()) + expect_contains(database$traits$dataset_id |> unique(), database$methods$dataset_id |> unique()) + expect_contains(paste(database$traits$dataset_id, database$traits$trait_name) |> unique(), paste(database$methods$dataset_id, database$methods$trait_name) |> unique()) + + if(!is.na(taxa)) { + expect_contains(database$traits$taxon_name |> unique(), taxa |> unique()) + } + + if(!is.na(dataset_id)) { + expect_contains(database$traits$dataset_id |> unique(), dataset_id |> unique()) + } + + if(!is.na(n_row)) { + expect_equal(database$traits |> nrow(), n_row) + } +} diff --git a/R/join_.R b/R/join_.R index 350cff0..5387f57 100644 --- a/R/join_.R +++ b/R/join_.R @@ -51,7 +51,7 @@ join_location_coordinates <- function(database) { `longitude (deg)` = NA_character_, ) } - + database } diff --git a/R/sysdata.rda b/R/sysdata.rda index ff99683..61a25a8 100644 Binary files a/R/sysdata.rda and b/R/sysdata.rda differ diff --git a/data-raw/create_data.R b/data-raw/create_data.R index 4421652..82ba0da 100644 --- a/data-raw/create_data.R +++ b/data-raw/create_data.R @@ -27,7 +27,7 @@ dataset_id <- c(unique(austraits_5.0.0$traits$dataset_id) %>% sample(5)) datasets <- c("Falster_2003", "Falster_2005_1", "Falster_2005_2", - "", "Crous_2019", "Buckton_2019", "Kooyman_2011", "Bloomfield_2018", + "Crous_2013", "Crous_2019", "Buckton_2019", "Kooyman_2011", "Bloomfield_2018", "Wright_2019", "Westoby_2014", "Vesk_2019", "Leigh_2003", "Prior_2003", "Prior_2016", "Choat_2006", "Choat_2012", "ABRS_1981", "Cernusak_2006", "Yang_2023") diff --git a/tests/testthat/test-bind_databases.R b/tests/testthat/test-bind_databases.R index a501274..0e7ae2c 100644 --- a/tests/testthat/test-bind_databases.R +++ b/tests/testthat/test-bind_databases.R @@ -4,9 +4,11 @@ fire <- austraits_5.0.0_lite %>% extract_data(table = "contexts", col = "context season <- austraits_5.0.0_lite %>% extract_data(table = "contexts", col = "context_property", col_value = "season") test_that("Function runs", { + expect_no_error(bound_Banksia <- bind_databases(Banksia_1, Banksia_2)) expect_silent(bind_databases(Banksia_1)) expect_silent(bind_databases(Banksia_1, Banksia_2)) expect_silent(bind_databases(fire, season)) + test_database_structure(database = bound_Banksia) } ) diff --git a/tests/testthat/test-extract_.R b/tests/testthat/test-extract_.R index c666875..c30ef77 100644 --- a/tests/testthat/test-extract_.R +++ b/tests/testthat/test-extract_.R @@ -45,8 +45,9 @@ test_that("Function runs", { test_that("extracted dataset has some structure as austraits build", { expect_no_error(subset <- extract_dataset(austraits_5.0.0_lite, dataset_id = dataset_id)) expect_no_error(trait_subset <- extract_trait(austraits_5.0.0_lite, trait_names = trait_name)) + test_database_structure(subset, dataset_id = dataset_id) - expect_s3_class(austraits_5.0.0_lite, "austraits") + expect_s3_class(austraits_5.0.0_lite, "traits.build") expect_equal(length(subset), length(austraits_5.0.0_lite)) expect_equal(sort(names(subset)), sort(names(austraits_5.0.0_lite))) @@ -61,6 +62,7 @@ test_that("extracted dataset has some structure as austraits build", { expect_equal(test_genus$taxa$genus %>% unique(), genus) expect_equal(stringr::word(test_genus$taxa$taxon_name, 1)[1], genus) expect_equal(stringr::word(test_genus$traits$taxon_name, 1)[1], genus) + test_database_structure(test_genus) expect_no_error(test_fam <- austraits_5.0.0_lite %>% extract_taxa(family = family)) expect_equal(test_fam$taxa$family %>% unique(), family) @@ -72,6 +74,7 @@ test_that("extracts using generalised extract function behaves as expected - ext expect_equal(length(austraits_5.0.0_lite), length(subset_by_dataset_id)) expect_equal(nrow(subset_by_dataset_id$locations), nrow(austraits_5.0.0_lite$locations %>% dplyr::filter(dataset_id == "Falster_2003"))) expect_equal(nrow(subset_by_dataset_id$contexts), nrow(austraits_5.0.0_lite$contexts %>% dplyr::filter(dataset_id == "Falster_2003"))) + test_database_structure(subset_by_dataset_id, dataset_id = dataset_id) expect_no_error(subset_by_dataset_id2 <- extract_data(database = austraits_5.0.0_lite, table = "traits", col = "dataset_id", col_value = dataset_id2)) expect_equal(length(austraits_5.0.0_lite), length(subset_by_dataset_id2)) @@ -88,12 +91,14 @@ test_that("extracts using generalised extract function behaves as expected - ext expect_equal(nrow(subset_by_dataset_id3$methods), nrow(austraits_5.0.0_lite$methods %>% dplyr::filter(dataset_id == "Wright_2019"))) expect_equal(nrow(subset_by_dataset_id3$contributors), nrow(austraits_5.0.0_lite$contributors %>% dplyr::filter(dataset_id == "Wright_2019"))) expect_equal(names(subset_by_dataset_id3), names(austraits_5.0.0_lite)) + test_database_structure(subset_by_dataset_id3, dataset_id = dataset_id3) }) test_that("that you can link two calls of `extract_data` together", { expect_no_error(subset_by_dataset_id2 <- extract_data(database = austraits_5.0.0_lite, table = "traits", col = "dataset_id", col_value = dataset_id2)) expect_no_error(extract_data(database = subset_by_dataset_id2, table = "traits", col = "trait_name", col_value = "leaf_mass_per_area")) + test_database_structure(subset_by_dataset_id2, dataset_id = dataset_id2) expect_no_error(subset_by_dataset_id3 <- extract_data(database = austraits_5.0.0_lite, table = "traits", col = "trait_name", col_value = "leaf_mass_per_area")) expect_no_error(extract_data(database = subset_by_dataset_id3, table = "contexts", col = "context_property", col_value = "age")) @@ -167,8 +172,7 @@ test_that("extracts using generalised extract function behaves as expected - ext expect_contains(subset_by_context_property$traits$dataset_id, datasets_in_subset$dataset_id) # however contexts will only be a subset of dataset_ids, so only 1 direction is true expect_contains(datasets_in_subset$dataset_id, subset_by_context_property$locations$dataset_id) - # can't work out a way to make this run, but for locations, not all datasets will be represented - # expect_error(subset_by_context_property$locations$dataset_id, datasets_in_subset$dataset_id) + expect_contains(datasets_in_subset$dataset_id, unique(subset_by_context_property$locations$dataset_id)) expect_equal(names(subset_by_context_property), names(austraits_5.0.0_lite)) # this should be true, because the proper extract function also retains other context property data linked to the same observation @@ -182,6 +186,7 @@ test_that("extracts using generalised extract function behaves as expected - ext test_that("Extraction of dataset was successful", { expect_no_error(subset <- extract_dataset(austraits_5.0.0_lite, dataset_id = dataset_id)) + test_database_structure(subset, dataset_id = dataset_id) expect_no_error(trait_subset <- extract_trait(austraits_5.0.0_lite, trait_names = trait_name)) expect_match(dataset_id, unique(subset$traits$dataset_id)) expect_equal(1, dplyr::n_distinct(subset$traits$dataset_id)) @@ -224,3 +229,4 @@ test_that("Extract function works when just traits table is read in", { expect_silent(extract_data(database = join_then_extract, col = "dataset_id", col_value = dataset_id)) expect_silent(extract_data(database = join_then_extract, col = "longitude (deg)", col_value = "145")) }) + diff --git a/tests/testthat/test-join_.R b/tests/testthat/test-join_.R index 9e049c5..c981da1 100644 --- a/tests/testthat/test-join_.R +++ b/tests/testthat/test-join_.R @@ -28,6 +28,12 @@ test_that("structure doesn't change", { expect_type(join_context_properties(austraits_5.0.0_lite), "list") expect_type(join_taxa(austraits_5.0.0_lite), "list") expect_type(join_taxonomic_updates(austraits_5.0.0_lite), "list") + expect_no_error(database_with_coordinates <- join_location_coordinates(austraits_5.0.0_lite)) + test_database_structure(database = database_with_coordinates) + expect_no_error(database_with_methods <- join_methods(austraits_5.0.0_lite)) + test_database_structure(database = database_with_methods) + expect_no_error(database_with_contexts <- join_context_properties(austraits_5.0.0_lite)) + test_database_structure(database = database_with_contexts) }) test_that("variables are added", {