Function to test database structure (#135)

* Function to test database structure * Adding new test function where appropriate * Rebuilt embedded lite data layers so that they have the proper class attached to them --------- Co-authored-by: Daniel Falster <[email protected]>
traitecoevo · Nov 19, 2024 · 1f5f4de · 1f5f4de
1 parent b8feb6d
commit 1f5f4de
Show file tree

Hide file tree

Showing 8 changed files with 50 additions and 6 deletions.
diff --git 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
@@ -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
@@ -51,7 +51,7 @@ join_location_coordinates <- function(database) {
         `longitude (deg)` = NA_character_,
       )
   }
-
+  
   database
 }
 

diff --git a/R/sysdata.rda b/R/sysdata.rda
diff --git 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
@@ -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
@@ -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
@@ -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", {
-Original file line number
+Diff line change
@@ Expand Up / @@ -51,7 +51,7 @@ join_location_coordinates <- function(database) { @@
             `longitude (deg)` = NA_character_,
           )
       }
       database
     }
@@ Expand Down @@