From 34c2b65bc015848cf4df87e6c7172ee6e0892010 Mon Sep 17 00:00:00 2001 From: equitable-equations Date: Sat, 4 Nov 2023 13:43:58 -0500 Subject: [PATCH] improved offline behavior --- R/assessment_cooccurrences_summary.R | 3 +- R/assessment_glance.R | 4 +- R/assessment_inventory.R | 5 ++ R/database_inventory.R | 6 +- R/download_assessment.R | 25 +------- R/download_assessment_internal.R | 13 +++- R/download_assessment_list.R | 4 +- R/download_database.R | 20 ++---- R/download_database_internal.R | 38 ++++++++--- R/download_transect.R | 17 +---- R/download_transect_internal.R | 38 +++++++++-- R/download_transect_list.R | 8 ++- R/index_fqa_assessments.R | 21 ++---- R/index_fqa_assessments_internal.R | 33 ++++++---- R/index_fqa_databases.R | 18 ++---- R/index_fqa_databases_internal.R | 16 +++-- R/index_fqa_transects.R | 18 ++---- R/index_fqa_transects_internal.R | 28 +++++--- R/is_transect.R | 38 +++++++---- R/is_transect_list.R | 10 +-- R/species_acronym.R | 64 +++++++++---------- R/transect_inventory.R | 40 +++++++++--- R/transect_list_inventory.R | 6 +- R/transect_phys.R | 28 ++++---- R/transect_subplot_inventories.R | 36 ++++++----- tests/testthat/test-assessment_glance.R | 5 +- tests/testthat/test-assessment_inventory.R | 4 +- tests/testthat/test-assessment_list_glance.R | 7 +- .../test-download_assessment_internal.R | 8 ++- .../testthat/test-download_assessment_list.R | 8 +-- tests/testthat/test-download_database.R | 11 +++- .../test-download_database_internal.R | 15 +++-- tests/testthat/test-download_transect.R | 4 +- .../test-download_transect_internal.R | 12 ++-- tests/testthat/test-download_transect_list.R | 8 ++- tests/testthat/test-index_fqa_assessments.R | 6 ++ .../test-index_fqa_assessments_internal.R | 10 ++- .../test-index_fqa_databases_internal.R | 3 + tests/testthat/test-index_fqa_transects.R | 5 ++ .../test-index_fqa_transects_internal.R | 10 ++- tests/testthat/test-is_transect.R | 1 + tests/testthat/test-is_transect_list.R | 2 +- tests/testthat/test-transect_inventory.R | 8 ++- tests/testthat/test-transect_list_inventory.R | 9 +-- tests/testthat/test-transect_phys.R | 4 +- .../test-transect_subplot_inventories.R | 6 +- 46 files changed, 393 insertions(+), 290 deletions(-) diff --git a/R/assessment_cooccurrences_summary.R b/R/assessment_cooccurrences_summary.R index f31bb8f..7f29338 100644 --- a/R/assessment_cooccurrences_summary.R +++ b/R/assessment_cooccurrences_summary.R @@ -47,6 +47,7 @@ #' #' @export + assessment_cooccurrences_summary <- function(inventory_list) { bad_df <- data.frame( @@ -70,7 +71,7 @@ assessment_cooccurrences_summary <- function(inventory_list) { if (!is_inventory_list(inventory_list)) { message( - "assessment_list must be a list of dataframes obtained from universalFQA.org. Type ?download_assessment_list for help." + "assessment_list must be a list of inventories obtained from universalFQA.org. Type ?assessment_inventory_list for help." ) return(invisible(bad_df)) } diff --git a/R/assessment_glance.R b/R/assessment_glance.R index 7406fce..4a4e045 100644 --- a/R/assessment_glance.R +++ b/R/assessment_glance.R @@ -146,9 +146,9 @@ assessment_glance <- function(data_set) { return(invisible(df_bad)) } - if (ncol(data_set) == 0) { + if (nrow(data_set) == 0) { message( - "data_set must be a dataframe obtained from the universalFQA.org website. Type ?download_assessment for help." + "Input data_set is empty." ) return(invisible(df_bad)) } diff --git a/R/assessment_inventory.R b/R/assessment_inventory.R index 9c4bf81..c85ad67 100644 --- a/R/assessment_inventory.R +++ b/R/assessment_inventory.R @@ -54,6 +54,11 @@ assessment_inventory <- function(data_set) { return(invisible(df_bad)) } + if (nrow(data_set) == 0) { + message("Input data_set is empty.") + return(invisible(df_bad)) + } + if (ncol(data_set) == 0) { message( "data_set must be a dataframe obtained from the universalFQA.org website. Type ?download_assessment for help." diff --git a/R/database_inventory.R b/R/database_inventory.R index 10cc0a8..55beeda 100644 --- a/R/database_inventory.R +++ b/R/database_inventory.R @@ -49,12 +49,12 @@ database_inventory <- function(database) { ) if (!is.data.frame(database)) { - message("database must be a data frame obtained from the universalFQA.org website. Type ?download_assessment for help.") + message("database must be a data frame obtained from the universalFQA.org website. Type ?download_database for help.") return(invisible(bad_df)) } if (ncol(database) == 0){ - message("data_set must be a dataframe obtained from the universalFQA.org website. Type ?download_assessment for help.") + message("database must be a data frame obtained from the universalFQA.org website. Type ?download_database for help.") return(invisible(bad_df)) } @@ -72,7 +72,7 @@ database_inventory <- function(database) { } if (!("Scientific Name" %in% database[[1]])) { - message("database must be a data frame obtained from the universalFQA.org website. Type ?download_assessment for help.") + message("database must be a data frame obtained from the universalFQA.org website. Type ?download_database for help.") return(invisible(bad_df)) } diff --git a/R/download_assessment.R b/R/download_assessment.R index d7c2aa5..b1ce085 100644 --- a/R/download_assessment.R +++ b/R/download_assessment.R @@ -36,36 +36,13 @@ download_assessment <- function(assessment_id) { - # apply interval version - # if nrow = 0, remove cache - # output the data frame from the internal version - out <- download_assessment_internal(assessment_id) if (nrow(out) == 0){ memoise::drop_cache(download_assessment_internal)({{ assessment_id }}) + return(invisible(out)) } out -# -# out <- tryCatch(download_assessment_internal(assessment_id), -# warning = function(w) { -# warning(w) -# memoise::drop_cache(download_assessment_internal)({{ assessment_id }}) -# return(invisible(NULL)) -# }, -# message = function(m) { -# message(m) -# memoise::drop_cache(download_assessment_internal)({{ assessment_id }}) -# return(invisible(NULL)) -# } -# ) -# -# if (is.null(out)){ -# memoise::drop_cache(download_assessment_internal)({{ assessment_id }}) -# return(invisible(NULL)) -# } -# -# out } diff --git a/R/download_assessment_internal.R b/R/download_assessment_internal.R index 7ec8da7..22d3ea7 100644 --- a/R/download_assessment_internal.R +++ b/R/download_assessment_internal.R @@ -11,7 +11,9 @@ #' #' @noRd + download_assessment_internal <- memoise::memoise(function(assessment_id) { + if (!is.numeric(assessment_id)) { stop("assessment_id must be an integer.", call. = FALSE) } @@ -69,7 +71,7 @@ download_assessment_internal <- memoise::memoise(function(assessment_id) { if ((list_data[[1]] == "The requested assessment is not public") & (!is.na(list_data[[1]]))) { - message("The requested assessment is not public. Returning empty data frame.") + message("The requested assessment is not public.") return(invisible(empty)) } @@ -81,5 +83,12 @@ download_assessment_internal <- memoise::memoise(function(assessment_id) { unlist(x) }) - as.data.frame(do.call(rbind, list_data)) + out <- as.data.frame(do.call(rbind, list_data)) + + class(out) <- c("tbl_df", + "tbl", + "data.frame") + + out + }) diff --git a/R/download_assessment_list.R b/R/download_assessment_list.R index 2a1df4d..3b4923e 100644 --- a/R/download_assessment_list.R +++ b/R/download_assessment_list.R @@ -44,8 +44,8 @@ download_assessment_list <- function(database_id, ...) { inventories_summary <- index_fqa_assessments(database_id) - if (is.null(inventories_summary)){ - return(invisible(NULL)) + if (nrow(inventories_summary) == 0){ + return(list()) } inventories_requested <- inventories_summary |> diff --git a/R/download_database.R b/R/download_database.R index 5244a28..24bb6cc 100644 --- a/R/download_database.R +++ b/R/download_database.R @@ -31,27 +31,17 @@ download_database <- function(database_id) { - out <- tryCatch(download_database_internal(database_id), - warning = function(w) { - warning(w) - memoise::drop_cache(download_database_internal)({{ database_id }}) - return(invisible(NULL)) - }, - message = function(m) { - message(m) - memoise::drop_cache(download_database_internal)({{ database_id }}) - return(invisible(NULL)) - } - ) - - if (is.null(out)){ + out <- download_database_internal(database_id) + + if (nrow(out) == 0 | out$V2[5] == 0){ memoise::drop_cache(download_database_internal)({{ database_id }}) + return(invisible(out)) } out - } + diff --git a/R/download_database_internal.R b/R/download_database_internal.R index e295bef..8d5302b 100644 --- a/R/download_database_internal.R +++ b/R/download_database_internal.R @@ -13,20 +13,34 @@ #' #' + download_database_internal <- memoise::memoise(function(database_id) { + if (!is.numeric(database_id)) { stop("database_id must be an integer.", call. = FALSE - ) + ) } + if (database_id %% 1 != 0) { stop("database_id must be an integer.", call. = FALSE - ) + ) } - if (database_id == -40000) { - return(invisible(NULL)) - } # for testing memoisation + + empty <- data.frame(V1 = character(0), + V2 = character(0), + V3 = character(0), + V4 = character(0), + V5 = character(0), + V6 = character(0), + V7 = character(0), + V8 = character(0), + V9 = character(0)) + + if (database_id == -40000){ + return(invisible(empty)) + } # for testing internet errors database_address <- paste0("http://universalfqa.org/get/database/", @@ -43,7 +57,7 @@ download_database_internal <- memoise::memoise(function(database_id) { cl <- class(database_get) if (cl != "response"){ - return(invisible(NULL)) + return(invisible(empty)) } if (httr::http_error(database_get)) { @@ -53,7 +67,7 @@ download_database_internal <- memoise::memoise(function(database_id) { httr::status_code(assessments_get) ) ) - return(invisible(NULL)) + return(invisible(empty)) } database_text <- httr::content(database_get, @@ -64,8 +78,8 @@ download_database_internal <- memoise::memoise(function(database_id) { if ((list_data[[1]] == "The requested assessment is not public") & (!is.na(list_data[[1]]))) { - message("The requested assessment is not public. Returning NULL.") - return(invisible(NULL)) + message("The requested assessment is not public.") + return(invisible(empty)) } max_length <- @@ -79,8 +93,12 @@ download_database_internal <- memoise::memoise(function(database_id) { db_out <- as.data.frame(do.call(rbind, list_data)) if (db_out[5, 2] == 0){ - warning("Specified database is empty.", call. = FALSE) + message("Specified database is empty.") } + class(db_out) <- c("tbl_df", + "tbl", + "data.frame") + db_out }) diff --git a/R/download_transect.R b/R/download_transect.R index b7ddb09..546b8c1 100644 --- a/R/download_transect.R +++ b/R/download_transect.R @@ -34,25 +34,14 @@ download_transect <- function(transect_id) { - out <- tryCatch(download_transect_internal(transect_id), - warning = function(w) { - warning(w) - memoise::drop_cache(download_transect_internal)({{ transect_id }}) - return(invisible(NULL)) - }, - message = function(m) { - message(m) - memoise::drop_cache(download_transect_internal)({{ transect_id }}) - return(invisible(NULL)) - } - ) + out <- download_transect_internal(transect_id) - if (is.null(out)){ + if (nrow(out) == 0){ memoise::drop_cache(download_transect_internal)({{ transect_id }}) + return(invisible(out)) } out - } diff --git a/R/download_transect_internal.R b/R/download_transect_internal.R index 8b7f00d..94fc92d 100644 --- a/R/download_transect_internal.R +++ b/R/download_transect_internal.R @@ -11,16 +11,35 @@ #' #' @noRd + download_transect_internal <- memoise::memoise(function(transect_id) { + if (!is.numeric(transect_id)) { stop("transect_id must be an integer.", call. = FALSE) } + if (transect_id %% 1 != 0) { stop("transect_id must be an integer.", call. = FALSE) } + + empty <- data.frame(V1 = character(0), + V2 = character(0), + V3 = character(0), + V4 = character(0), + V5 = character(0), + V6 = character(0), + V7 = character(0), + V8 = character(0), + V9 = character(0), + V10 = character(0), + V11 = character(0), + V12 = character(0), + V13 = character(0), + V14 = character(0)) + if (transect_id == -40000) { - return(invisible(NULL)) - } # for testing memoisation + return(invisible(empty)) + } # for testing internet errors trans_address <- paste0("http://universalfqa.org/get/transect/", transect_id) @@ -36,7 +55,7 @@ download_transect_internal <- memoise::memoise(function(transect_id) { cl <- class(trans_get) if (cl != "response"){ - return(invisible(NULL)) + return(invisible(empty)) } if (httr::http_error(trans_get)) { @@ -46,7 +65,7 @@ download_transect_internal <- memoise::memoise(function(transect_id) { httr::status_code(assessments_get) ) ) - return(invisible(NULL)) + return(invisible(empty)) } trans_text <- httr::content(trans_get, @@ -57,8 +76,8 @@ download_transect_internal <- memoise::memoise(function(transect_id) { if ((list_data[[1]] == "The requested assessment is not public") & (!is.na(list_data[[1]]))) { - message("The requested assessment is not public. Returning NULL.") - return(invisible(NULL)) + message("The requested assessment is not public.") + return(invisible(empty)) } max_length <- @@ -69,6 +88,11 @@ download_transect_internal <- memoise::memoise(function(transect_id) { unlist(x) }) - as.data.frame(do.call(rbind, list_data)) + out <- as.data.frame(do.call(rbind, list_data)) + + class(out) <- c("tbl_df", + "tbl", + "data.frame") + out }) diff --git a/R/download_transect_list.R b/R/download_transect_list.R index 5cea76b..1d0cddb 100644 --- a/R/download_transect_list.R +++ b/R/download_transect_list.R @@ -44,8 +44,8 @@ download_transect_list <- function(database_id, ...) { transects_summary <- index_fqa_transects(database_id) - if (is.null(transects_summary)){ - return(invisible(NULL)) + if (nrow(transects_summary) == 0){ + return(invisible(list())) } transects_requested <- transects_summary |> @@ -67,6 +67,7 @@ download_transect_list <- function(database_id, ...) { width = length(transects_requested$id), char = "=" ) + for (i in seq_along(transects_requested$id)) { results[[i]] <- download_transect(transects_requested$id[i]) utils::setTxtProgressBar(pb, i) @@ -78,7 +79,8 @@ download_transect_list <- function(database_id, ...) { } if (length(results) == 0){ - warning("No matches found. Empty list returned.", call. = FALSE) + message("No matches found.") + return(invisible(results)) } results diff --git a/R/index_fqa_assessments.R b/R/index_fqa_assessments.R index 3404f8d..a6ad9cf 100644 --- a/R/index_fqa_assessments.R +++ b/R/index_fqa_assessments.R @@ -31,27 +31,18 @@ index_fqa_assessments <- function(database_id) { - out <- tryCatch(index_fqa_assessments_internal(database_id), - warning = function(w) { - warning(w) - memoise::drop_cache(index_fqa_assessments_internal)({{ database_id }}) - return(invisible(NULL)) - }, - message = function(m) { - message(m) - memoise::drop_cache(index_fqa_assessments_internal)({{ database_id }}) - return(invisible(NULL)) - } - ) - - if (is.null(out)){ + + out <- index_fqa_assessments_internal(database_id) + + if (nrow(out) == 0){ memoise::drop_cache(index_fqa_assessments_internal)({{ database_id }}) + return(invisible(out)) } out - } + diff --git a/R/index_fqa_assessments_internal.R b/R/index_fqa_assessments_internal.R index 8c904f2..8353521 100644 --- a/R/index_fqa_assessments_internal.R +++ b/R/index_fqa_assessments_internal.R @@ -1,5 +1,4 @@ -#' List all available public floristic quality assessments with possible null -#' results cached +#' List all available public floristic quality assessments #' #' @param database_id A numeric identifier of the desired database #' @return A data frame with 5 columns @@ -11,21 +10,33 @@ index_fqa_assessments_internal <- memoise::memoise(function(database_id) { + if (!is.numeric(database_id)) { stop( "database_id must be an integer corresponding to an existing FQA database. Use index_fqa_databases() to obtain a data frame of valid options.", call. = FALSE ) } + if (database_id %% 1 != 0) { stop( "database_id must be an integer corresponding to an existing FQA database. Use index_fqa_databases() to obtain a data frame of valid options.", call. = FALSE ) } + + empty_df <- data.frame(id = numeric(0), + assessment = character(0), + date = numeric(0), + site = character(0), + practitioner = character(0) + ) + + empty_df$date <- as.Date(empty_df$Date) + if (database_id == -40000) { - return(invisible(NULL)) - } # for testing memoisation + return(invisible(empty_df)) + } # for testing offline behavior assessments_address <- paste0("http://universalfqa.org/get/database/", @@ -43,7 +54,7 @@ index_fqa_assessments_internal <- memoise::memoise(function(database_id) { cl <- class(assessments_get) if (cl != "response"){ - return(invisible(NULL)) + return(invisible(empty_df)) } if (httr::http_error(assessments_get)) { @@ -53,7 +64,7 @@ index_fqa_assessments_internal <- memoise::memoise(function(database_id) { httr::status_code(assessments_get) ) ) - return(invisible(NULL)) + return(invisible(empty_df)) } assessments_text <- httr::content(assessments_get, @@ -65,17 +76,17 @@ index_fqa_assessments_internal <- memoise::memoise(function(database_id) { inventories_summary <- as.data.frame(list_data) if (nrow(inventories_summary) == 0) { - message("No data associated with specified database_id. Returning NULL.") - return(invisible(NULL)) + message("No data associated with specified database_id") + return(invisible(empty_df)) } - colnames(inventories_summary) <- c("id", "assessment", + colnames(inventories_summary) <- c("id", + "assessment", "date", "site", "practitioner") inventories_summary$id <- as.double(inventories_summary$id) - inventories_summary$date[inventories_summary$date == "0000-00-00"] <- - NA + inventories_summary$date[inventories_summary$date == "0000-00-00"] <- NA inventories_summary$date <- as.Date(inventories_summary$date) class(inventories_summary) <- c("tbl_df", "tbl", diff --git a/R/index_fqa_databases.R b/R/index_fqa_databases.R index 3a7855c..391f730 100644 --- a/R/index_fqa_databases.R +++ b/R/index_fqa_databases.R @@ -22,21 +22,11 @@ index_fqa_databases <- function() { - out <- tryCatch(index_fqa_databases_internal(), - warning = function(w) { - warning(w) - memoise::forget(index_fqa_databases_internal) - return(invisible(NULL)) - }, - message = function(m) { - message(m) - memoise::forget(index_fqa_databases_internal) - return(invisible(NULL)) - } - ) - - if (is.null(out)){ + out <- index_fqa_databases_internal() + + if (nrow(out) == 0){ memoise::forget(index_fqa_databases_internal) + return(invisible(out)) } out diff --git a/R/index_fqa_databases_internal.R b/R/index_fqa_databases_internal.R index c089e6a..9a85f2b 100644 --- a/R/index_fqa_databases_internal.R +++ b/R/index_fqa_databases_internal.R @@ -1,4 +1,4 @@ -#' List all available floristic quality assessment databases with possible null results cached +#' List all available floristic quality assessment databases #' #' @return A data frame with 4 columns #' @@ -9,6 +9,13 @@ #' @noRd index_fqa_databases_internal <- memoise::memoise(function() { + + empty_df <- data.frame(database_id = numeric(0), + region = character(0), + year = numeric(0), + description = character(0) + ) + databases_address <- "http://universalfqa.org/get/database/" ua <- httr::user_agent("https://github.com/equitable-equations/fqar") @@ -22,7 +29,7 @@ index_fqa_databases_internal <- memoise::memoise(function() { cl <- class(databases_get) if (cl != "response"){ - return(invisible(NULL)) + return(invisible(empty_df)) } if (httr::http_error(databases_get)) { @@ -32,7 +39,7 @@ index_fqa_databases_internal <- memoise::memoise(function() { httr::status_code(assessments_get) ) ) - return(invisible(NULL)) + return(invisible(empty_df)) } databases_text <- httr::content(databases_get, @@ -44,7 +51,8 @@ index_fqa_databases_internal <- memoise::memoise(function() { databases[, c(1, 3)] <- lapply(databases[, c(1, 3)], as.double) colnames(databases) <- c("database_id", - "region", "year", + "region", + "year", "description") class(databases) <- c("tbl_df", "tbl", diff --git a/R/index_fqa_transects.R b/R/index_fqa_transects.R index 60fd66d..768b921 100644 --- a/R/index_fqa_transects.R +++ b/R/index_fqa_transects.R @@ -32,21 +32,11 @@ index_fqa_transects <- function(database_id) { - out <- tryCatch(index_fqa_transects_internal(database_id), - warning = function(w) { - warning(w) - memoise::drop_cache(index_fqa_transects_internal)({{ database_id }}) - return(invisible(NULL)) - }, - message = function(m) { - message(m) - memoise::drop_cache(index_fqa_transects_internal)({{ database_id }}) - return(invisible(NULL)) - } - ) - - if (is.null(out)){ + out <- index_fqa_transects_internal(database_id) + + if (nrow(out) == 0){ memoise::drop_cache(index_fqa_transects_internal)({{ database_id }}) + return(invisible(out)) } out diff --git a/R/index_fqa_transects_internal.R b/R/index_fqa_transects_internal.R index 20b0b1f..37c57ef 100644 --- a/R/index_fqa_transects_internal.R +++ b/R/index_fqa_transects_internal.R @@ -10,21 +10,33 @@ #' @noRd index_fqa_transects_internal <- memoise::memoise(function(database_id) { - if (!is.numeric(database_id)) { + + if (!is.numeric(database_id)) { stop( "database_id must be an integer corresponding to an existing FQA database. Use index_fqa_databases() to obtain a data frame of valid options.", call. = FALSE ) - } + } + if (database_id %% 1 != 0) { stop( "database_id must be an integer corresponding to an existing FQA database. Use index_fqa_databases() to obtain a data frame of valid options.", call. = FALSE ) } + + empty_df <- data.frame(id = numeric(0), + assessment = character(0), + date = numeric(0), + site = character(0), + practitioner = character(0) + ) + + empty_df$date <- as.Date(empty_df$date) + if (database_id == -40000) { - return(invisible(NULL)) - } # for testing memoisation + return(invisible(empty_df)) + } # for testing offline behavior trans_address <- paste0("http://universalfqa.org/get/database/", database_id, @@ -41,7 +53,7 @@ index_fqa_transects_internal <- memoise::memoise(function(database_id) { cl <- class(trans_get) if (cl != "response"){ - return(invisible(NULL)) + return(invisible(empty_df)) } if (httr::http_error(trans_get)) { @@ -51,7 +63,7 @@ index_fqa_transects_internal <- memoise::memoise(function(database_id) { httr::status_code(assessments_get) ) ) - return(invisible(NULL)) + return(invisible(empty_df)) } trans_text <- httr::content(trans_get, @@ -63,8 +75,8 @@ index_fqa_transects_internal <- memoise::memoise(function(database_id) { transect_summary <- as.data.frame(list_data) if (nrow(transect_summary) == 0) { - message("No data associated with specified database_id. Returning NULL.") - return(invisible(NULL)) + message("No data associated with specified database_id.") + return(invisible(empty_df)) } colnames(transect_summary) <- c("id", diff --git a/R/is_transect.R b/R/is_transect.R index c9122ba..72b19bb 100644 --- a/R/is_transect.R +++ b/R/is_transect.R @@ -7,15 +7,26 @@ #' #' @noRd + is_transect <- function(possible_transect) { - return <- TRUE + return <- FALSE tryCatch({ - if (!is.data.frame(possible_transect)) { + if (is.data.frame(eval(possible_transect))) { + return <- TRUE + }}, + + error = function(e) { return <- FALSE - } + }, + + warning = function(w) { + return <- FALSE + }) + + tryCatch({ if (ncol(possible_transect) == 1) { @@ -29,25 +40,30 @@ is_transect <- function(possible_transect) { fill = "right", extra = "merge" ) - } # for manually-downloaded sets + }, + error = function(e) { + return <- FALSE + }, + warning = function(w){ + return <- FALSE + }) - names <- c("V1", "V2", "V3", "V4", "V5", "V6", "V7", - "V8", "V9", "V10", "V11", "V12", "V13", "V14") + names <- c("V1", "V2", "V3", "V4", "V5", "V6", "V7", + "V8", "V9", "V10", "V11", "V12", "V13", "V14") - if (!identical(colnames(possible_transect), names)){ - return <- FALSE - } + tryCatch({ - if (!identical(colnames(possible_transect), names)) { + if (!identical(colnames(possible_transect), names)){ return <- FALSE } - }, + error = function(e) { return <- FALSE }, + warning = function(w){ return <- FALSE }) diff --git a/R/is_transect_list.R b/R/is_transect_list.R index 2e3ec87..e631783 100644 --- a/R/is_transect_list.R +++ b/R/is_transect_list.R @@ -10,23 +10,23 @@ is_transect_list <- function(possible_list) { - return <- TRUE + return <- FALSE tryCatch({ - if (!is.list(possible_list) | (length(possible_list) == 0)) { - return <- FALSE - } else { + if (is.list(eval(possible_list)) & (length(possible_list) != 0)) { outcomes <- lapply(possible_list, is_transect) |> as.logical() - return <- all(outcomes) + return <- all(outcomes) & (sum(outcomes) >= 1) } }, + error = function(e) { return <- FALSE }, + warning = function(w){ return <- FALSE }) diff --git a/R/species_acronym.R b/R/species_acronym.R index 6b8feed..c3556e6 100644 --- a/R/species_acronym.R +++ b/R/species_acronym.R @@ -36,42 +36,42 @@ #' @export -species_acronym <- - function(species, - database_id = NULL, - database_inventory = NULL) { - if (is.null(database_id) & is.null(database_inventory)) { - stop("Either database_id or database_inventory must be specified.", - call. = FALSE) - } +species_acronym <-function(species, + database_id = NULL, + database_inventory = NULL) { - if (!is.null(database_id) & !is.null(database_inventory)) { - stop("database_id and database_inventory cannot both be specified.", - call. = FALSE) - } + if (is.null(database_id) & is.null(database_inventory)) { + stop("Either database_id or database_inventory must be specified.", + call. = FALSE) + } - if (!is.null(database_id)) { - db <- download_database(database_id) - database_inventory <- database_inventory(db) - } + if (!is.null(database_id) & !is.null(database_inventory)) { + stop("database_id and database_inventory cannot both be specified.", + call. = FALSE) + } - inv_list <- - list(database_inventory) # To check if the specified inventory is valid. - if (!is_inventory_list(inv_list)) { - stop( - "database_inventory must be a species inventory in the format provided by database_inventory().", - call. = FALSE - ) - } + if (!is.null(database_id)) { + db <- download_database(database_id) + database_inventory <- database_inventory(db) + } - if (!(species %in% database_inventory$scientific_name)) { - stop("Species not found in specified database.", call. = FALSE) - } + inv_list <- + list(database_inventory) # To check if the specified inventory is valid. + if (!is_inventory_list(inv_list)) { + stop( + "database_inventory must be a species inventory in the format provided by database_inventory().", + call. = FALSE + ) + } - species_row <- database_inventory |> - dplyr::filter(.data$scientific_name == species) + if (!(species %in% database_inventory$scientific_name)) { + stop("Species not found in specified database.", call. = FALSE) + } - acronym <- species_row$acronym[1] + species_row <- database_inventory |> + dplyr::filter(.data$scientific_name == species) - acronym - } + acronym <- species_row$acronym[1] + + acronym +} diff --git a/R/transect_inventory.R b/R/transect_inventory.R index 9d16b91..8cf5df5 100644 --- a/R/transect_inventory.R +++ b/R/transect_inventory.R @@ -40,23 +40,41 @@ #' @export transect_inventory <- function(data_set) { + + empty_df <- data.frame(species = character(0), + family = character(0), + acronym = character(0), + nativity = character(0), + c = numeric(0), + w = numeric(0), + physiognomy = character(0), + duration = character(0), + frequency = numeric(0), + coverage = numeric(0), + relative_frequency_percent = numeric(0), + relative_coverage_percent = numeric(0), + relative_importance_value = numeric(0) + ) + if (!is.data.frame(data_set)) { - stop( - "data_set must be a dataframe obtained from the universalFQA.org website. Type ?download_assessment for help.", - call. = FALSE + message( + "data_set must be a dataframe obtained from the universalFQA.org website. Type ?download_assessment for help." ) + return(invisible(empty_df)) } + if (ncol(data_set) == 0) { - stop( - "data_set must be a dataframe obtained from the universalFQA.org website. Type ?download_assessment for help.", - call. = FALSE + message( + "data_set must be a dataframe obtained from the universalFQA.org website. Type ?download_assessment for help." ) + return(invisible(empty_df)) } + if (!("Species Richness:" %in% data_set[[1]])) { - stop( - "data_set must be a dataframe obtained from the universalFQA.org website. Type ?download_assessment for help.", - call. = FALSE + message( + "data_set must be a dataframe obtained from the universalFQA.org website. Type ?download_assessment for help." ) + return(invisible(empty_df)) } if (ncol(data_set) == 1) { @@ -84,7 +102,8 @@ transect_inventory <- function(data_set) { end_row <- -2 + which(data_set$V1 == "Quadrat/Subplot Level Metrics:") if (end_row < start_row) { - stop("No species listings found.") + message("No species listings found.") + return(invisible(empty(df))) } dropped <- data_set[start_row:end_row,] @@ -117,6 +136,7 @@ transect_inventory <- function(data_set) { "relative_coverage_percent", "relative_importance_value" ) + colnames(new) <- names new diff --git a/R/transect_list_inventory.R b/R/transect_list_inventory.R index 4a67585..1f9ff19 100644 --- a/R/transect_list_inventory.R +++ b/R/transect_list_inventory.R @@ -41,10 +41,10 @@ transect_list_inventory <- function(transect_list) { if (!is_transect_list(transect_list)) { - stop( - "transect_list must be a list of dataframes obtained from universalFQA.org. Type ?download_transect_list for help.", - call. = FALSE + message( + "transect_list must be a list of dataframes obtained from universalFQA.org. Type ?download_transect_list for help." ) + return(invisible(list())) } applied <- lapply(transect_list, diff --git a/R/transect_phys.R b/R/transect_phys.R index 0d59661..1dab454 100644 --- a/R/transect_phys.R +++ b/R/transect_phys.R @@ -35,23 +35,19 @@ transect_phys <- function(data_set) { - if (!is.data.frame(data_set)) { - stop( - "data_set must be a dataframe obtained from the universalFQA.org website. Type ?download_assessment for help.", - call. = FALSE - ) - } - if (ncol(data_set) == 0) { - stop( - "data_set must be a dataframe obtained from the universalFQA.org website. Type ?download_assessment for help.", - call. = FALSE - ) - } - if (!("Species Richness:" %in% data_set[[1]])) { - stop( - "data_set must be a dataframe obtained from the universalFQA.org website. Type ?download_assessment for help.", - call. = FALSE + + empty_df <- data.frame(physiognomy = character(0), + frequency = numeric(0), + coverage = numeric(0), + relative_frequency_percent = numeric(0), + relative_coverage_percent = numeric(0) + ) + + if (!is_transect(data_set)) { + message( + "data_set must be a dataframe obtained from the universalFQA.org website. Type ?download_assessment for help." ) + return(invisible(empty_df)) } if (ncol(data_set) == 1) { diff --git a/R/transect_subplot_inventories.R b/R/transect_subplot_inventories.R index 12a713b..a2ad051 100644 --- a/R/transect_subplot_inventories.R +++ b/R/transect_subplot_inventories.R @@ -34,28 +34,34 @@ #' @export transect_subplot_inventories <- function(transect) { - if (!is.data.frame(transect)) { - stop( - "data_set must be a dataframe obtained from the universalFQA.org website. Type ?download_transect for help.", - call. = FALSE - ) - } - if (ncol(transect) == 0) { - stop( - "data_set must be a dataframe obtained from the universalFQA.org website. Type ?download_assessment for help.", - call. = FALSE + + empty_df <- data.frame(scientific_name = character(0), + family = character(0), + acronym = character(0), + nativity = character(0), + c = numeric(0), + w = numeric(0), + physiognomy = character(0), + duration = character(0), + common_name = character(0) ) - } - if (!("Species Richness:" %in% transect[[1]])) { - stop( - "data_set must be a dataframe obtained from the universalFQA.org website. Type ?download_assessment for help.", - call. = FALSE + + if (!is_transect(transect)) { + message( + "data_set must be a dataframe obtained from the universalFQA.org website. Type ?download_transect for help." ) + return(invisible(empty_df)) } boundary_rows <- which(grepl("Quadrat", transect$V1) & grepl("Species:", transect$V1)) + + if (length(boundary_rows) == 0){ + message("No subplot-level inventory found.") + return(invisible(list())) + } + lengths <- diff(boundary_rows) - 3 lengths <- c(lengths, nrow(transect) - tail(boundary_rows, 1) - 2) diff --git a/tests/testthat/test-assessment_glance.R b/tests/testthat/test-assessment_glance.R index 3c4391f..0c5c908 100644 --- a/tests/testthat/test-assessment_glance.R +++ b/tests/testthat/test-assessment_glance.R @@ -17,11 +17,10 @@ test_that("assessment_glance works", { skip_on_cran() - test_auto <- download_assessment(25002) - test <- assessment_glance(test_auto) + test_auto <- suppressMessages(download_assessment(25002)) + test <- suppressMessages(assessment_glance(test_auto)) expect_equal(ncol(test), 52) - expect_equal(nrow(test), 1) expect_equal(names(test)[8], "fqa_db_region") expect_equal(names(test)[42], "grass") expect_equal(typeof(test$total_mean_c), "double") diff --git a/tests/testthat/test-assessment_inventory.R b/tests/testthat/test-assessment_inventory.R index c39f218..a30497b 100644 --- a/tests/testthat/test-assessment_inventory.R +++ b/tests/testthat/test-assessment_inventory.R @@ -14,8 +14,8 @@ test_that("assessment_inventory works", { skip_on_cran() - test_raw <- download_assessment(25002) - test_auto <- assessment_inventory(test_raw) + test_raw <- suppressMessages(download_assessment(25002)) + test_auto <- suppressMessages(assessment_inventory(test_raw)) expect_equal(ncol(test_auto), 9) expect_equal(names(test_auto)[5], "c") expect_equal(typeof(test_auto$c), "double") diff --git a/tests/testthat/test-assessment_list_glance.R b/tests/testthat/test-assessment_list_glance.R index e2c1394..53a4467 100644 --- a/tests/testthat/test-assessment_list_glance.R +++ b/tests/testthat/test-assessment_list_glance.R @@ -15,11 +15,10 @@ test_that("assessment_list_glance works", { skip_on_cran() test_vec <- c(25961, 25640) - test_list <- download_assessment_list(63, id %in% test_vec) - test_df <- assessment_list_glance(test_list) + test_list <- suppressMessages(download_assessment_list(63, id %in% test_vec)) + test_df <- suppressMessages(assessment_list_glance(test_list)) expect_equal(ncol(test_df), 52) - expect_equal(nrow(test_df), length(test_list)) + expect_lt(nrow(test_df)-1, length(test_list)) expect_equal(typeof(test_df$total_mean_c), "double") - expect_gt(nrow(test_df), 1) }) diff --git a/tests/testthat/test-download_assessment_internal.R b/tests/testthat/test-download_assessment_internal.R index 78c5fe8..a86ba31 100644 --- a/tests/testthat/test-download_assessment_internal.R +++ b/tests/testthat/test-download_assessment_internal.R @@ -9,5 +9,11 @@ test_that("download_assessment_internal works", { skip_on_cran() - expect_equal(nrow(suppressMessages(download_assessment_internal(25002))), 140) + test_a <- suppressMessages(download_assessment_internal(25002)) + expect_equal(nrow(test_a), 140) + expect_equal(class(test_a), c("tbl_df", + "tbl", + "data.frame")) + expect_equal(ncol(test_a), 9) + expect_equal(test_a$V1[1], "Edison dune and swale") }) diff --git a/tests/testthat/test-download_assessment_list.R b/tests/testthat/test-download_assessment_list.R index 3c476a3..b5b52a2 100644 --- a/tests/testthat/test-download_assessment_list.R +++ b/tests/testthat/test-download_assessment_list.R @@ -2,14 +2,14 @@ test_that("download_assessment_list works", { skip_on_cran() - expect_null(suppressMessages(download_assessment_list(-2))) + expect_equal(class(suppressMessages(download_assessment_list(-2))), "list") expect_warning(download_assessment_list(1, id == "hi"), "No matches found. Empty list returned.") two_assessments <- download_assessment_list(1, id == 8 | id == 12) expect_equal(class(two_assessments), "list") expect_equal(length(two_assessments), 2) - expect_equal(class(two_assessments[[1]]), "data.frame") + expect_equal(class(two_assessments[[1]]), c("tbl_df", + "tbl", + "data.frame")) expect_equal(ncol(two_assessments[[1]]), 9) }) - - diff --git a/tests/testthat/test-download_database.R b/tests/testthat/test-download_database.R index c6ba5ba..0ae2a9f 100644 --- a/tests/testthat/test-download_database.R +++ b/tests/testthat/test-download_database.R @@ -3,11 +3,18 @@ test_that("download_database works", { expect_error(download_database("hi"), "database_id must be an integer.") expect_error(download_database(2.5), "database_id must be an integer.") + null_output <- download_database(-40000) + expect_equal(nrow(null_output), 0) + expect_equal(memoise::has_cache(download_database_internal)(-40000), FALSE) + skip_on_cran() test_db <- download_database(1) - expect_equal(test_db[1, 1], "Chicago Region") + expect_equal(test_db$V1[1], "Chicago Region") expect_equal(ncol(test_db), 9) + expect_equal(class(test_db), c("tbl_df", + "tbl", + "data.frame")) - expect_warning(t <- download_database(3), "Specified database is empty.") + expect_message(download_database(3)) }) diff --git a/tests/testthat/test-download_database_internal.R b/tests/testthat/test-download_database_internal.R index d9a84c6..e697a1b 100644 --- a/tests/testthat/test-download_database_internal.R +++ b/tests/testthat/test-download_database_internal.R @@ -3,15 +3,16 @@ test_that("download_database_internal works", { expect_error(download_database("hi"), "database_id must be an integer.") expect_error(download_database(2.5), "database_id must be an integer.") - null_output <- download_database(-40000) - expect_null(null_output) - expect_equal(memoise::has_cache(download_database_internal)(-40000), FALSE) + null_output <- download_database_internal(-40000) + expect_equal(nrow(null_output), 0) + expect_equal(memoise::has_cache(download_database_internal)(-40000), TRUE) skip_on_cran() - test_db <- download_database(1) - expect_equal(test_db[1, 1], "Chicago Region") + test_db <- suppressMessages(download_database_internal(1)) expect_equal(ncol(test_db), 9) - - expect_warning(download_database(3)) + expect_equal(test_db$V1[1], "Chicago Region") + expect_equal(class(test_db), c("tbl_df", + "tbl", + "data.frame")) }) diff --git a/tests/testthat/test-download_transect.R b/tests/testthat/test-download_transect.R index 0a3abde..6b2c7aa 100644 --- a/tests/testthat/test-download_transect.R +++ b/tests/testthat/test-download_transect.R @@ -4,8 +4,8 @@ test_that("download_transect works", { expect_error(download_transect(2.5), "transect_id must be an integer.") null_output <- download_transect(-40000) - expect_null(null_output) - expect_equal(memoise::has_cache(download_transect_internal)(-40000), FALSE) + expect_equal(nrow(null_output), 0) + expect_false(memoise::has_cache(download_transect_internal)(-40000)) skip_on_cran() diff --git a/tests/testthat/test-download_transect_internal.R b/tests/testthat/test-download_transect_internal.R index df8ee4b..a26e627 100644 --- a/tests/testthat/test-download_transect_internal.R +++ b/tests/testthat/test-download_transect_internal.R @@ -3,11 +3,15 @@ test_that("download_transect_internal works", { expect_error(download_transect_internal("hi"), "transect_id must be an integer.") expect_error(download_transect_internal(2.5), "transect_id must be an integer.") - null_output <- download_transect(-40000) - expect_null(null_output) - expect_equal(memoise::has_cache(download_transect_internal)(-40000), FALSE) + null_output <- download_transect_internal(-40000) + expect_equal(nrow(null_output), 0) + expect_true(memoise::has_cache(download_transect_internal)(-40000)) skip_on_cran() - expect_equal(ncol(download_transect_internal(6322)), 14) + test_tr <- download_transect_internal(6322) + expect_equal(ncol(test_tr), 14) + expect_equal(class(test_tr), c("tbl_df", + "tbl", + "data.frame")) }) diff --git a/tests/testthat/test-download_transect_list.R b/tests/testthat/test-download_transect_list.R index f54ec42..2d0020d 100644 --- a/tests/testthat/test-download_transect_list.R +++ b/tests/testthat/test-download_transect_list.R @@ -2,13 +2,15 @@ test_that("download_transect_list works", { skip_on_cran() - expect_null(suppressMessages(download_transect_list(-2))) + expect_equal(length(suppressMessages(download_transect_list(-2))), 0) - expect_warning(download_transect_list(1, id == "hi"), "No matches found. Empty list returned.") + expect_message(download_transect_list(1, id == "hi"), "No matches found.") two_transects <- download_transect_list(1, id == 6570 | id == 6322) expect_equal(class(two_transects), "list") expect_equal(length(two_transects), 2) - expect_equal(class(two_transects[[1]]), "data.frame") + expect_equal(class(two_transects[[1]]), c("tbl_df", + "tbl", + "data.frame")) expect_equal(ncol(two_transects[[1]]), 14) }) diff --git a/tests/testthat/test-index_fqa_assessments.R b/tests/testthat/test-index_fqa_assessments.R index b18efea..8a4b202 100644 --- a/tests/testthat/test-index_fqa_assessments.R +++ b/tests/testthat/test-index_fqa_assessments.R @@ -3,6 +3,12 @@ test_that("index_fqa_assessments works", { expect_error(index_fqa_assessments(1.5)) expect_error(index_fqa_assessments("hi")) + empty_output <- index_fqa_assessments(-40000) + expect_equal(nrow(empty_output), 0) + expect_equal(ncol(empty_output), 5) + expect_equal(memoise::has_cache(index_fqa_assessments_internal)(-40000), FALSE) + + skip_on_cran() assessments <- index_fqa_assessments(2) diff --git a/tests/testthat/test-index_fqa_assessments_internal.R b/tests/testthat/test-index_fqa_assessments_internal.R index feb0212..0168e84 100644 --- a/tests/testthat/test-index_fqa_assessments_internal.R +++ b/tests/testthat/test-index_fqa_assessments_internal.R @@ -3,9 +3,10 @@ test_that("index_fqa_assessments_internal works", { expect_error(index_fqa_assessments_internal(1.5)) expect_error(index_fqa_assessments_internal("hi")) - null_output <- index_fqa_assessments(-40000) - expect_null(null_output) - expect_equal(memoise::has_cache(index_fqa_assessments_internal)(-40000), FALSE) + empty_output <- index_fqa_assessments_internal(-40000) + expect_equal(nrow(empty_output), 0) + expect_equal(ncol(empty_output), 5) + expect_equal(memoise::has_cache(index_fqa_assessments_internal)(-40000), TRUE) skip_on_cran() @@ -14,6 +15,9 @@ test_that("index_fqa_assessments_internal works", { expect_equal(ncol(assessments), 5) expect_equal(names(assessments), c("id", "assessment", "date", "site", "practitioner")) + expect_equal(class(assessments), c("tbl_df", + "tbl", + "data.frame")) expect_equal(class(assessments[[1]]), "numeric") expect_equal(class(assessments[[3]]), "Date") expect_equal(class(assessments[[5]]), "character") diff --git a/tests/testthat/test-index_fqa_databases_internal.R b/tests/testthat/test-index_fqa_databases_internal.R index 256cd9f..e378f75 100644 --- a/tests/testthat/test-index_fqa_databases_internal.R +++ b/tests/testthat/test-index_fqa_databases_internal.R @@ -7,6 +7,9 @@ test_that("index_fqa_databases_internal works", { databases <- index_fqa_databases_internal() expect_equal(ncol(databases), 4) expect_equal(names(databases), c("database_id", "region", "year", "description")) + expect_equal(class(databases), c("tbl_df", + "tbl", + "data.frame")) expect_equal(class(databases[[1]]), "numeric") expect_equal(class(databases[[4]]), "character") diff --git a/tests/testthat/test-index_fqa_transects.R b/tests/testthat/test-index_fqa_transects.R index 596cc50..7496cb4 100644 --- a/tests/testthat/test-index_fqa_transects.R +++ b/tests/testthat/test-index_fqa_transects.R @@ -3,6 +3,11 @@ test_that("index_fqa_transects works", { expect_error(index_fqa_transects(1.5)) expect_error(index_fqa_transects("hi")) + empty_output <- index_fqa_transects(-40000) + expect_equal(nrow(empty_output), 0) + expect_equal(ncol(empty_output), 5) + expect_false(memoise::has_cache(index_fqa_transects_internal)(-40000)) + skip_on_cran() transects <- index_fqa_transects(1) diff --git a/tests/testthat/test-index_fqa_transects_internal.R b/tests/testthat/test-index_fqa_transects_internal.R index 635dc62..ee926b5 100644 --- a/tests/testthat/test-index_fqa_transects_internal.R +++ b/tests/testthat/test-index_fqa_transects_internal.R @@ -3,9 +3,10 @@ test_that("index_fqa_transects_internal works", { expect_error(index_fqa_transects_internal(1.5)) expect_error(index_fqa_transects_internal("hi")) - null_output <- index_fqa_transects(-40000) - expect_null(null_output) - expect_equal(memoise::has_cache(index_fqa_transects_internal)(-40000), FALSE) + empty_output <- index_fqa_transects_internal(-40000) + expect_equal(nrow(empty_output), 0) + expect_equal(ncol(empty_output), 5) + expect_true(memoise::has_cache(index_fqa_transects_internal)(-40000)) skip_on_cran() @@ -14,6 +15,9 @@ test_that("index_fqa_transects_internal works", { expect_equal(ncol(transects), 5) expect_equal(names(transects), c("id", "assessment", "date", "site", "practitioner")) + expect_equal(class(transects), c("tbl_df", + "tbl", + "data.frame")) expect_equal(class(transects[[1]]), "numeric") expect_equal(class(transects[[3]]), "Date") expect_equal(class(transects[[5]]), "character") diff --git a/tests/testthat/test-is_transect.R b/tests/testthat/test-is_transect.R index 3e3f8f5..db8ce9d 100644 --- a/tests/testthat/test-is_transect.R +++ b/tests/testthat/test-is_transect.R @@ -1,6 +1,7 @@ test_that("is_transect works", { expect_true(is_transect(test_transect)) + expect_false(is_transect(random_unassigned_variables_40000)) expect_false(is_transect(faithful)) expect_false(is_transect("hi")) diff --git a/tests/testthat/test-is_transect_list.R b/tests/testthat/test-is_transect_list.R index 80faaad..58f8822 100644 --- a/tests/testthat/test-is_transect_list.R +++ b/tests/testthat/test-is_transect_list.R @@ -5,7 +5,7 @@ test_that("is_transect_list works", { test_inv_list <- transect_list_inventory(test_transect_list) bad_list <- list(faithful, faithful) - expect_error(random_unassigned_variable_5000) + expect_false(is_transect_list(random_unassigned_variable_5000)) expect_true(is_transect_list(test_transect_list)) expect_true(is_transect_list(list(test_raw))) expect_false(is_transect_list(test_raw)) diff --git a/tests/testthat/test-transect_inventory.R b/tests/testthat/test-transect_inventory.R index 6275bc7..12f1825 100644 --- a/tests/testthat/test-transect_inventory.R +++ b/tests/testthat/test-transect_inventory.R @@ -1,7 +1,11 @@ test_that("transect_inventory works", { - expect_error(transect_inventory("hi")) - expect_error(transect_inventory(faithful)) + expect_message(transect_inventory("hi")) + expect_message(transect_inventory(faithful)) + + blank <- suppressMessages(transect_inventory(faithful)) + expect_equal(nrow(blank), 0) + expect_equal(ncol(blank), 13) test_manual <- transect_inventory(test_transect) #manual download expect_equal(ncol(test_manual), 13) diff --git a/tests/testthat/test-transect_list_inventory.R b/tests/testthat/test-transect_list_inventory.R index a6cfe7b..cfa6c18 100644 --- a/tests/testthat/test-transect_list_inventory.R +++ b/tests/testthat/test-transect_list_inventory.R @@ -1,4 +1,5 @@ test_that("transect_list_inventory works", { + test_raw <- download_transect(4492) test_transect_list <- list(test_raw, test_raw, @@ -11,10 +12,10 @@ test_that("transect_list_inventory works", { bad_list <- list(faithful) - expect_error(transect_list_inventory(bad_list)) - expect_error(transect_list_inventory(faithful)) - expect_error(transect_list_inventory(17)) - expect_error(transect_list_inventory(NULL)) + expect_message(transect_list_inventory(bad_list)) + expect_message(transect_list_inventory(faithful)) + expect_true(is.list(suppressMessages(transect_list_inventory(faithful)))) + }) diff --git a/tests/testthat/test-transect_phys.R b/tests/testthat/test-transect_phys.R index 07f74bf..5a20c71 100644 --- a/tests/testthat/test-transect_phys.R +++ b/tests/testthat/test-transect_phys.R @@ -1,7 +1,7 @@ test_that("transect_phys works", { - expect_error(transect_phys("hi")) - expect_error(transect_phy(faithful)) + expect_message(transect_phys("hi")) + expect_message(transect_phys(faithful)) test <- transect_phys(test_transect) # manual download expect_equal(ncol(test), 6) diff --git a/tests/testthat/test-transect_subplot_inventories.R b/tests/testthat/test-transect_subplot_inventories.R index 0ffe81a..3f0f60d 100644 --- a/tests/testthat/test-transect_subplot_inventories.R +++ b/tests/testthat/test-transect_subplot_inventories.R @@ -3,8 +3,8 @@ test_that("transect_subplot_inventories works", { test_transect <- download_transect(5932) inv <- transect_subplot_inventories(test_transect) - expect_error(transect_subplot_inventories("hi")) - expect_error(transect_subplot_inventories(faithful)) + expect_message(transect_subplot_inventories("hi")) + expect_message(transect_subplot_inventories(faithful)) expect_equal(length(inv), 6) expect_equal(ncol(inv[[1]]), 9) @@ -12,3 +12,5 @@ test_that("transect_subplot_inventories works", { expect_equal(typeof(inv[[1]]$scientific_name), "character") expect_equal(typeof(inv[[1]]$c), "double") }) + +# need to add input for all downloading functions to allow testing offline behavior