Added checks for column values if traits table supplied #139

traitecoevo · Jan 6, 2025 · b3d5d7d · b3d5d7d
1 parent e78e818
commit b3d5d7d
Show file tree

Hide file tree

Showing 3 changed files with 26 additions and 9 deletions.
diff --git a/R/checks.R b/R/checks.R
@@ -27,13 +27,24 @@ check_table_name_exists <- function(database, table){
 
 # Check if col exists in specified table when database is traits.build object
 check_col_exists_in_table <- function(database, table, col){
-  if(! names(database[[table]]) %in% col |> any()){ # Does any names in table contain `col`
-    cli::cli_abort(c(
-      "x" = "`{col}` is not a valid column name in the `{table}` table",
-      "i" = "Check `names(database${table})` and try again!"
-    )
-    )
-  }
+  # If traits table supplied and no table is specified
+  if(tibble::is_tibble(database)){
+    if(! names(database) %in% col |> any()){ # Does any names in table contain `col`
+      cli::cli_abort(c(
+        "x" = "`{col}` is not a valid column name in the `traits` table",
+        "i" = "Check `names(database$traits)` and try again!"
+      )
+      )
+    }
+  } else(
+    if(! names(database[[table]]) %in% col |> any()){ # Does any names in table contain `col`
+      cli::cli_abort(c(
+        "x" = "`{col}` is not a valid column name in the `{table}` table",
+        "i" = "Check `names(database${table})` and try again!"
+      )
+      )
+    }
+  )
 }
 
 # # Check if col_value exists in the col

diff --git a/R/extract_data.R b/R/extract_data.R
@@ -38,6 +38,8 @@ extract_data <- function(database, table = NA, col, col_value) {
   # If just the traits table is read in
   if (tibble::is_tibble(database)) {
 
+    check_col_exists_in_table(database, table, col)
+
     indicies_tmp <- purrr::map(col_value, ~{
       stringr::str_which(database[[col]], 
                          pattern = stringr::regex(.x, ignore_case = TRUE))

diff --git a/tests/testthat/test-extract_.R b/tests/testthat/test-extract_.R
@@ -20,6 +20,9 @@ test_that("Error message is triggered", {
                             table = "taxa",
                             col = "genusss", 
                             col_value = "Acacia"))
+  expect_error(extract_data(at_six$traits, 
+                            col = "basis_of record", 
+                            col_value = "field lab"))
 })
 
 test_extract_error <- function(austraits){
@@ -231,8 +234,9 @@ test_that("Extract function works when just traits table is read in", {
   expect_equal(length(extract_data(database = austraits_5.0.0_lite$traits, col = "dataset_id", col_value = dataset_id)), 26)
   expect_silent(extract_dataset(database = austraits_5.0.0_lite$traits, dataset_id = dataset_id))  
   expect_equal(length(extract_dataset(database = austraits_5.0.0_lite$traits, dataset_id = dataset_id)), 26)
-  expect_silent(extract_taxa(database = austraits_5.0.0_lite$traits, genus = "Banksia"))  
-  expect_equal(length(extract_taxa(database = austraits_5.0.0_lite$traits, genus = "Banksia")), 26)
+  expect_silent(jointaxa_then_extract <- (austraits_5.0.0_lite %>% join_taxa())$traits)
+  expect_silent(extract_data(database = jointaxa_then_extract, col = "genus", col_value = "Banksia"))
+  expect_equal(length(extract_data(database = jointaxa_then_extract, col = "genus", col_value = "Banksia")), 30)
   expect_silent(extract_trait(database = austraits_5.0.0_lite$traits, trait_name = "photosyn"))  
   expect_equal(length(extract_trait(database = austraits_5.0.0_lite$traits, trait_name = "photosyn")), 26)
   expect_silent(join_then_extract <- (austraits_5.0.0_lite %>% join_location_coordinates())$traits)