Skip to content

Commit

Permalink
Fill some gaps in testing
Browse files Browse the repository at this point in the history
  • Loading branch information
@dfalster
dfalster committed Nov 18, 2024
1 parent 32b5177 commit 29d0d82
Show file tree
Hide file tree
Showing 5 changed files with 51 additions and 25 deletions.
4 changes: 4 additions & 0 deletions R/join_.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -284,6 +284,8 @@ join_contributors <- function(database,
dplyr::mutate(data_contributors = purrr::map_chr(data, jsonlite::toJSON)) %>%
dplyr::select(-dplyr::any_of("data")) %>%
dplyr::ungroup()
} else {
stop("format not supported: ", format)
}

database$traits <- database$traits %>%
Expand Down Expand Up @@ -392,6 +394,8 @@ join_location_properties <- function(database,
database$traits <- database$traits %>%
dplyr::left_join(by = join_vars, compacted_locations_column)

} else {
stop("format not supported: ", format)
}

database
Expand Down
4 changes: 2 additions & 2 deletions R/utils.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -71,7 +71,7 @@ convert_list_to_df2 <- function(my_list, as_character = TRUE, on_empty = NA) {
function_not_supported <- function(database, ...){

# Extract function name
function_name <- as.character(sys.calls()[[1]])[1]
function_name <- as.character(sys.calls()[[1]]) %>% dplyr::last()

# Determine if traits table or traits.build object
if( is.null(dim(database))){
Expand All @@ -82,7 +82,7 @@ function_not_supported <- function(database, ...){

# Formulate message
cli::cli_abort(c(
"x" = "{function_name} no longer supports AusTraits version {AusTraits_version}",
"x" = "{function_name} no longer supports this version of AusTraits, {AusTraits_version}",
"i" = "You can either update to a newer version of the data using `load_austraits()` OR",
"i" = "Install an older version of the package",
"i" = "See https://github.com/traitecoevo/austraits for details."
Expand Down
8 changes: 8 additions & 0 deletions tests/testthat/test-check_compatibiity.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -7,5 +7,13 @@ test_check_compatibility <- function(austraits){
expect_true(check_compatibility(austraits_5.0.0_lite))
expect_message(check_compatibility(austraits_3.0.2_lite))
expect_false(check_compatibility(austraits_3.0.2_lite))

expect_error(austraits_3.0.2_lite %>% join_location_coordinates())
expect_error(austraits_3.0.2_lite %>% join_location_properties())
expect_error(austraits_3.0.2_lite %>% join_contributors())
expect_error(austraits_3.0.2_lite %>% join_methods())
expect_error(austraits_3.0.2_lite %>% join_taxa())
expect_error(austraits_3.0.2_lite %>% join_context_properties())
expect_error(austraits_3.0.2_lite %>% extract_data("traits", "wood_density"))
})
}
51 changes: 28 additions & 23 deletions tests/testthat/test-extract_.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -43,8 +43,8 @@ test_that("Function runs", {


test_that("extracted dataset has some structure as austraits build", {
subset <- extract_dataset(austraits_5.0.0_lite, dataset_id = dataset_id)
trait_subset <- extract_trait(austraits_5.0.0_lite, trait_names = trait_name)
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))

expect_s3_class(austraits_5.0.0_lite, "austraits")
expect_equal(length(subset), length(austraits_5.0.0_lite))
Expand All @@ -57,31 +57,31 @@ test_that("extracted dataset has some structure as austraits build", {
expect_type(austraits_5.0.0_lite %>% extract_taxa(family = family), "list")
expect_type(austraits_5.0.0_lite %>% extract_taxa(genus = genus), "list")

test_genus <- austraits_5.0.0_lite %>% extract_taxa(genus = genus)
expect_no_error(test_genus <- austraits_5.0.0_lite %>% extract_taxa(genus = genus))
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_fam <- austraits_5.0.0_lite %>% extract_taxa(family = family)
expect_no_error(test_fam <- austraits_5.0.0_lite %>% extract_taxa(family = family))
expect_equal(test_fam$taxa$family %>% unique(), family)
})

test_that("extracts using generalised extract function behaves as expected - extracting by dataset_id", {

subset_by_dataset_id <- extract_data(database = austraits_5.0.0_lite, table = "traits", col = "dataset_id", col_value = dataset_id)
expect_no_error(subset_by_dataset_id <- extract_data(database = austraits_5.0.0_lite, table = "traits", col = "dataset_id", col_value = dataset_id))
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")))

subset_by_dataset_id2 <- extract_data(database = austraits_5.0.0_lite, table = "traits", col = "dataset_id", col_value = dataset_id2)
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))
expect_equal(nrow(subset_by_dataset_id2$locations), nrow(austraits_5.0.0_lite$locations %>% dplyr::filter(dataset_id == "Cernusak_2006")))
expect_equal(nrow(subset_by_dataset_id2$contexts), nrow(austraits_5.0.0_lite$contexts %>% dplyr::filter(dataset_id == "Cernusak_2006")))
expect_equal(nrow(subset_by_dataset_id2$methods), nrow(austraits_5.0.0_lite$methods %>% dplyr::filter(dataset_id == "Cernusak_2006")))
expect_equal(nrow(subset_by_dataset_id2$contributors), nrow(austraits_5.0.0_lite$contributors %>% dplyr::filter(dataset_id == "Cernusak_2006")))
expect_equal(names(subset_by_dataset_id2), names(austraits_5.0.0_lite))

subset_by_dataset_id3 <- extract_data(database = austraits_5.0.0_lite, table = "traits", col = "dataset_id", col_value = dataset_id3)
expect_no_error(subset_by_dataset_id3 <- extract_data(database = austraits_5.0.0_lite, table = "traits", col = "dataset_id", col_value = dataset_id3))
expect_equal(length(austraits_5.0.0_lite), length(subset_by_dataset_id3))
expect_equal(nrow(subset_by_dataset_id3$locations), nrow(austraits_5.0.0_lite$locations %>% dplyr::filter(dataset_id == "Wright_2019")))
expect_equal(nrow(subset_by_dataset_id3$contexts), nrow(austraits_5.0.0_lite$contexts %>% dplyr::filter(dataset_id == "Wright_2019")))
Expand All @@ -92,21 +92,21 @@ test_that("extracts using generalised extract function behaves as expected - ext


test_that("that you can link two calls of `extract_data` together", {
subset_by_dataset_id2 <- extract_data(database = austraits_5.0.0_lite, table = "traits", col = "dataset_id", col_value = dataset_id2)
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"))

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(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"))
subset_by_dataset_id_and_context <- extract_data(database = subset_by_dataset_id3, table = "contexts", col = "context_property", col_value = "age")
expect_no_error(subset_by_dataset_id_and_context <- extract_data(database = subset_by_dataset_id3, table = "contexts", col = "context_property", col_value = "age"))
expect_gt(nrow(subset_by_dataset_id3$contexts), nrow(subset_by_dataset_id_and_context$contexts))
})

test_that("extracts using generalised extract function behaves as expected - extracting by `life_stage", {

life_stage_test <- "sapling"

subset_by_age_class <- extract_data(database = austraits_5.0.0_lite, table = "traits", col = "life_stage", col_value = life_stage_test)
datasets_in_subset <- subset_by_age_class$traits %>% dplyr::distinct(dataset_id)
expect_no_error(subset_by_age_class <- extract_data(database = austraits_5.0.0_lite, table = "traits", col = "life_stage", col_value = life_stage_test))
expect_no_error(datasets_in_subset <- subset_by_age_class$traits %>% dplyr::distinct(dataset_id))

expect_lt(nrow(subset_by_age_class$locations), nrow(austraits_5.0.0_lite$locations))
expect_lt(nrow(subset_by_age_class$contexts), nrow(austraits_5.0.0_lite$contexts))
Expand All @@ -119,8 +119,8 @@ test_that("extracts using generalised extract function behaves as expected - ext

location_property_test <- "temperature"

subset_by_location_property <- extract_data(database = austraits_5.0.0_lite, table = "locations", col = "location_property", col_value = location_property_test)
datasets_in_subset <- subset_by_location_property$locations %>% dplyr::distinct(dataset_id)
expect_no_error(subset_by_location_property <- extract_data(database = austraits_5.0.0_lite, table = "locations", col = "location_property", col_value = location_property_test))
expect_no_error(datasets_in_subset <- subset_by_location_property$locations %>% dplyr::distinct(dataset_id))

expect_lt(nrow(subset_by_location_property$traits), nrow(austraits_5.0.0_lite$traits))
expect_lt(nrow(subset_by_location_property$locations), nrow(austraits_5.0.0_lite$locations))
Expand Down Expand Up @@ -151,10 +151,10 @@ test_that("extracts using generalised extract function behaves as expected - ext

context_property_test <- "fire"

subset_by_context_property <- extract_data(database = austraits_5.0.0_lite, table = "contexts", col = "context_property", col_value = context_property_test)
expect_no_error(subset_by_context_property <- extract_data(database = austraits_5.0.0_lite, table = "contexts", col = "context_property", col_value = context_property_test))

datasets_in_subset <- subset_by_context_property$contexts %>% dplyr::distinct(dataset_id)
subset_using_filter <- austraits_5.0.0_lite$contexts %>% dplyr::filter(stringr::str_detect(context_property, context_property_test))
expect_no_error(datasets_in_subset <- subset_by_context_property$contexts %>% dplyr::distinct(dataset_id))
expect_no_error(subset_using_filter <- austraits_5.0.0_lite$contexts %>% dplyr::filter(stringr::str_detect(context_property, context_property_test)))

expect_lt(nrow(subset_by_context_property$traits), nrow(austraits_5.0.0_lite$traits))
expect_lt(nrow(subset_by_context_property$locations), nrow(austraits_5.0.0_lite$locations))
Expand All @@ -181,24 +181,29 @@ test_that("extracts using generalised extract function behaves as expected - ext
})

test_that("Extraction of dataset was successful", {
subset <- extract_dataset(austraits_5.0.0_lite, dataset_id = dataset_id)
trait_subset <- extract_trait(austraits_5.0.0_lite, trait_names = trait_name)
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))
expect_match(dataset_id, unique(subset$traits$dataset_id))
expect_equal(1, dplyr::n_distinct(subset$traits$dataset_id))
# this isn't an exact match, because the matches use partial string matches and for this example, both `leaf_area` and `leaf_area_ratio` being matched
expect_match(trait_name, unique(trait_subset$traits$trait_name))
expect_equal(1, dplyr::n_distinct(trait_subset$traits$trait_name))
# Works when taxon names also supplied
taxa <- c("Acacia floribunda", "Acacia myrtifolia", "Acacia suaveolens")
expect_no_error(subset2 <- extract_trait(subset, trait_names = "leaf_area", taxon_name = taxa))
expect_equal(subset2$traits$taxon_name |> unique() |> sort(), taxa)
expect_equal(subset2$traits$trait_name |> unique(), "leaf_area")
})

test_that("Expect error if taxon_name column missing", {
traits_without_taxon_name <- extract_dataset(austraits_5.0.0_lite, dataset_id = dataset_id)
expect_no_error(traits_without_taxon_name <- extract_dataset(austraits_5.0.0_lite, dataset_id = dataset_id))
traits_without_taxon_name$traits <- traits_without_taxon_name$traits %>% dplyr::select(-taxon_name)
expect_error((traits_without_taxon_name %>% extract_trait("leaf_area"))$traits)
})

test_that("Extraction of dataset was successful using `extract_data`", {
subset <- extract_data(database = austraits_5.0.0_lite, table = "traits", col = "dataset_id", col_value = dataset_id)
trait_subset <- extract_data(database = austraits_5.0.0_lite, table = "traits", col = "trait_name", col_value = trait_name)
expect_no_error(subset <- extract_data(database = austraits_5.0.0_lite, table = "traits", col = "dataset_id", col_value = dataset_id))
expect_no_error(trait_subset <- extract_data(database = austraits_5.0.0_lite, table = "traits", col = "trait_name", col_value = trait_name))
expect_match(dataset_id, unique(subset$traits$dataset_id))
expect_equal(dplyr::n_distinct(subset$traits$dataset_id), 1)
expect_contains(unique(trait_subset$traits$trait_name), trait_name)
Expand All @@ -215,7 +220,7 @@ test_that("Extract function works when just traits table is read in", {
expect_equal(length(extract_taxa(database = austraits_5.0.0_lite$traits, genus = "Banksia")), 26)
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)
join_then_extract <- (austraits_5.0.0_lite %>% join_location_coordinates())$traits
expect_silent(join_then_extract <- (austraits_5.0.0_lite %>% join_location_coordinates())$traits)
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"))
})
9 changes: 9 additions & 0 deletions tests/testthat/test-join_.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -41,3 +41,12 @@ test_that("variables are added", {
expect_true(any(names(join_taxa(austraits_5.0.0_lite)$traits) %in%c("family", "genus")))
expect_true(any(names(join_methods(austraits_5.0.0_lite)$traits) %in%c("methods")))
})

test_that("fails appropriately", {
expect_error(join_context_properties(austraits_5.0.0_lite, format = "bad"))
expect_error(join_location_coordinates(austraits_5.0.0_lite, format = "bad"))
expect_error(join_location_properties(austraits_5.0.0_lite, format = "bad"))
expect_error(join_taxa(austraits_5.0.0_lite, format = "bad"))
expect_error(join_contributors(austraits_5.0.0_lite, format = "bad"))

})

0 comments on commit 29d0d82

Please sign in to comment.