diff --git a/DESCRIPTION b/DESCRIPTION index 1e53ca49627114e1a2ceb788948b858640ca656b..bd659ea65849f9c922a10de3a1a1ce9f5c4b606d 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: inldata Title: Collection of Datasets for the USGS-INL Monitoring Networks -Version: 1.2.3.9000 +Version: 1.2.6.9000 Authors@R: c( person(given = c("Jason", "C."), family = "Fisher", role = c("aut", "cre"), diff --git a/NEWS.md b/NEWS.md index b3618b162eca1cfe870e5d17ca07af18c51f8c33..9e3ef128d8094b3b23647903c609af823ffec012 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,19 @@ # inldata (development version) +- ... + +# inldata 1.2.6 + +- Remove `full_names` argument from `write_datasets` function. +- Fix invalid file paths in the downloads vignette. + +# inldata 1.2.5 + +- Ensure functions `assert_url` and `download_file` fail gracefully with an informative message + if the internet resource is not available (and not give a check warning nor error). + +# inldata 1.2.4 + - Ensure that unit tests do not fail when the internet connection is unavailable. - Add `mountains` dataset based on the slope threshold of the digital elevation model. diff --git a/R/assert_url.R b/R/assert_url.R index a7ee0de147b60583813f901846c24dad2760a1e5..8a480d1efdfc2635138093f60c173071f296786f 100644 --- a/R/assert_url.R +++ b/R/assert_url.R @@ -9,6 +9,7 @@ #' Other arguments passed to the [`httr::HEAD`] and [`httr::GET`] functions. #' #' @return Returns `url` invisibly. +#' A `NULL` value is returned if the assertion fails for any reason. #' #' @source Code adapted from #' [Stack Overflow](https://stackoverflow.com/questions/52911812/check-if-url-exists-in-r), @@ -31,6 +32,12 @@ assert_url <- function(url, ...) { # check packages check_package(pkg = "httr", msg = "URL assertions") + # check internet connection + if (!curl::has_internet()) { + message("No internet connection.") + return(invisible(NULL)) + } + f <- safely(httr::HEAD) res <- f(url, ...) @@ -39,12 +46,14 @@ assert_url <- function(url, ...) { res <- f(url, ...) if (is.null(res$result)) { sprintf("Assertion on '%s' failed: hard error with no response.", url) |> - stop(call. = FALSE) + message() + return(invisible(NULL)) } if (((httr::status_code(res$result) %/% 200) != 1)) { sprintf("Assertion on '%s' failed: responded but without an HTTP status code in the 200-299 range.", url) |> - stop(call. = FALSE) + message() + return(invisible(NULL)) } } diff --git a/R/download_file.R b/R/download_file.R index 5c007df4475808b28f4fe6b9844b96f8cfd29649..cc31f1cfe54da1b6af875fcee0e3f1dd399552a3 100644 --- a/R/download_file.R +++ b/R/download_file.R @@ -39,7 +39,11 @@ download_file <- function(url, file <- file.path(cachedir, basename(url)) is <- checkmate::test_file_exists(file, access = "r") if (!is) { - assert_url(url) + url <- assert_url(url) + if (is.null(url)) { + message("Download failed.") + return(invisible(NULL)) + } utils::download.file( url = url, destfile = file, diff --git a/R/make_datasets.R b/R/make_datasets.R index 8e837bfceb7c8da66cb06dfb0515744480f69591..77698214979ea4c5c5a85b0f515b3c2be35b30f5 100644 --- a/R/make_datasets.R +++ b/R/make_datasets.R @@ -97,11 +97,6 @@ make_datasets <- function(path = getwd(), dt <- Sys.time() message("TIMESTAMP: ", format(dt, usetz = TRUE), "\n") - # check internet connection - if (!curl::has_internet()) { - stop("No internet connection", call. = FALSE) - } - # check arguments path <- path.expand(path) |> normalizePath(winslash = "/", mustWork = FALSE) diff --git a/R/write_datasets.R b/R/write_datasets.R index 4e2b96e4b8656960c9418d616a5339823932fb54..440b7f2ddfe275191a81c7c1113ffcb847d97038 100644 --- a/R/write_datasets.R +++ b/R/write_datasets.R @@ -36,8 +36,6 @@ #' Whether to add indentation, whitespace, and newlines to JSON output (default is `TRUE`). #' See [`prettify`][jsonlite::prettify] function for details. #' The tradeoff for human-readable output is a much larger file size. -#' @param full_names 'logical' flag. -#' Whether the full paths of the files are returned (default). #' @param quiet 'logical' flag. #' Whether to suppress printing of debugging information. #' @@ -78,7 +76,6 @@ write_datasets <- function(package, include = NULL, exclude = NULL, pretty = TRUE, - full_names = TRUE, quiet = FALSE) { # check arguments @@ -119,7 +116,6 @@ write_datasets <- function(package, null.ok = TRUE ) checkmate::assert_flag(pretty) - checkmate::assert_flag(full_names) checkmate::assert_flag(quiet) # check packages @@ -332,12 +328,6 @@ write_datasets <- function(package, } } - # express as relative path - if (!full_names) { - paths <- sprintf("^%s/", destdir) |> - sub(replacement = "", x = paths) - } - # return output paths invisible(paths) } diff --git a/inst/tinytest/test_functions.R b/inst/tinytest/test_functions.R index b78a2004f5799ed245b8e754da58fa2529794415..f7810997df804f814b7da766d8cdfd860ada312f 100644 --- a/inst/tinytest/test_functions.R +++ b/inst/tinytest/test_functions.R @@ -60,18 +60,7 @@ unlink(destdir, recursive = TRUE) x <- clean_sf(inl, cols = "geometry", crs = sf::st_crs(3857)) expect_multi_class(x, classes = c("sf", "data.frame")) -# require internet connection -if (curl::has_internet()) { - - # test URL assertion - expect_silent(assert_url("https://www.usa.gov/")) - expect_error(assert_url("https://fail/on/bad/url/")) - expect_error(assert_url("https://anyapi.io/api/v1/exchange/rates?base=NAN&apiKey=123")) - - # test downloading file - url <- "https://code.usgs.gov/inl/inldata/-/raw/main/CODE_OF_CONDUCT.md" - file <- download_file(url, cachedir = tempdir(), quiet = TRUE) - expect_file_exists(file, access = "rw") - unlink(file) - -} +# test URL assertion +expect_silent(assert_url("https://www.usa.gov/")) +expect_null(assert_url("https://fail/on/bad/url/")) +expect_null(assert_url("https://anyapi.io/api/v1/exchange/rates?base=NAN&apiKey=123")) diff --git a/inst/tinytest/test_make_datasets.R b/inst/tinytest/test_make_datasets.R index ffce152ca0332ef383c873462ad70d83d422ca13..bc73c763eedc19ef9a30db91fec1c5eff6741f28 100644 --- a/inst/tinytest/test_make_datasets.R +++ b/inst/tinytest/test_make_datasets.R @@ -3,118 +3,113 @@ library("tinytest") library("checkmate") using("checkmate") -# require internet connection -if (curl::has_internet()) { +# test existence of data-raw folder +destdir <- tempfile("") +expect_error( + current = make_datasets(path = tempdir(), destdir = destdir), + pattern = "does not exist" +) +unlink(destdir) - # test existence of data-raw folder - destdir <- tempfile("") - expect_error( - current = make_datasets(path = tempdir(), destdir = destdir), - pattern = "does not exist" - ) - unlink(destdir) +# test making parameters +pcodes <- "07000" +n <- length(pcodes) +x <- inldata:::mds_parameters(pcodes) +expect_data_frame(x, nrows = n, col.names = "named") +x <- inldata:::tabulate_parm_data(x, samples) +expect_data_frame(x, nrows = n, col.names = "named") - # test making parameters - pcodes <- "07000" - n <- length(pcodes) - x <- inldata:::mds_parameters(pcodes) - expect_data_frame(x, nrows = n, col.names = "named") - x <- inldata:::tabulate_parm_data(x, samples) - expect_data_frame(x, nrows = n, col.names = "named") +# test making detection limits +data <- data.frame( + "srsname" = c("Tritium", "Tritium"), + "pcode" = c("07000", "07000"), + "unit_cd" = c("pCi/L", "pCi/L"), + "lab_det_lim_va" = c("500", "200"), + "min_dt" = c("1949-01-16", "2003-04-01"), + "reference" = c("Bartholomay", "Bartholomay") +) +x <- inldata:::mds_dl(data, parameters) +expect_data_frame(x, nrows = nrow(data), col.names = "named") - # test making detection limits - data <- data.frame( - "srsname" = c("Tritium", "Tritium"), - "pcode" = c("07000", "07000"), - "unit_cd" = c("pCi/L", "pCi/L"), - "lab_det_lim_va" = c("500", "200"), - "min_dt" = c("1949-01-16", "2003-04-01"), - "reference" = c("Bartholomay", "Bartholomay") - ) - x <- inldata:::mds_dl(data, parameters) - expect_data_frame(x, nrows = nrow(data), col.names = "named") +# test making benchmarks +bm <- data.frame( + "Chemical Name" = "trans-1,3-Dichloropropene", + "CAS Registry Number" = "10061-02-6", + "USGS Parameter Code" = "34699", + "Chemical Class" = "VOC", + "MCL (micrograms/L)" = NA_character_, + "Chronic Noncancer HHBP (micrograms/L)" = NA_character_, + "Carcinogenic HHBP (micrograms/L)" = NA_character_, + "Noncancer HBSL (micrograms/L)" = "200", + "Cancer HBSL (micrograms/L)" = "0.3-30", + "Benchmark Remarks" = NA_character_, + check.names = FALSE +) +mcl_extras <- data.frame( + "srsname" = "Tritium", + "pcode" = "07000", + "mcl" = "20000", + "unit_cd" = "pCi/L" +) +n <- nrow(bm) + nrow(mcl_extras) +x <- inldata:::mds_benchmarks(bm, mcl_extras, parameters) +expect_data_frame(x, nrows = n, col.names = "named") - # test making benchmarks - bm <- data.frame( - "Chemical Name" = "trans-1,3-Dichloropropene", - "CAS Registry Number" = "10061-02-6", - "USGS Parameter Code" = "34699", - "Chemical Class" = "VOC", - "MCL (micrograms/L)" = NA_character_, - "Chronic Noncancer HHBP (micrograms/L)" = NA_character_, - "Carcinogenic HHBP (micrograms/L)" = NA_character_, - "Noncancer HBSL (micrograms/L)" = "200", - "Cancer HBSL (micrograms/L)" = "0.3-30", - "Benchmark Remarks" = NA_character_, - check.names = FALSE - ) - mcl_extras <- data.frame( - "srsname" = "Tritium", - "pcode" = "07000", - "mcl" = "20000", - "unit_cd" = "pCi/L" - ) - n <- nrow(bm) + nrow(mcl_extras) - x <- inldata:::mds_benchmarks(bm, mcl_extras, parameters) - expect_data_frame(x, nrows = n, col.names = "named") +# test making sites +data <- data.frame( + "agency_cd" = "USGS", + "site_no" = "432700112470801", + "station_nm" = "02N 31E 35DCC1 USGS 1", + "network_cd" = "A", + "pos" = "3" +) +x <- inldata:::mds_sites(data, crs) +expect_multi_class(x, classes = c("sf", "data.frame")) +expect_set_equal(nrow(x), nrow(data)) +y <- inldata:::tabulate_site_data(x, samples, gwl, swm) +expect_data_frame(y, nrows = nrow(x), col.names = "named") - # test making sites - data <- data.frame( - "agency_cd" = "USGS", - "site_no" = "432700112470801", - "station_nm" = "02N 31E 35DCC1 USGS 1", - "network_cd" = "A", - "pos" = "3" - ) - x <- inldata:::mds_sites(data, crs) - expect_multi_class(x, classes = c("sf", "data.frame")) - expect_set_equal(nrow(x), nrow(data)) - y <- inldata:::tabulate_site_data(x, samples, gwl, swm) - expect_data_frame(y, nrows = nrow(x), col.names = "named") +# test making surface-water measurements +site_no <- "13131000" +is <- sites$site_no == site_no +x <- inldata:::mds_swm(sites = sites[is, ], tz = "America/Denver") +expect_data_frame(x, min.rows = 1, col.names = "named") - # test making surface-water measurements - site_no <- "13131000" - is <- sites$site_no == site_no - x <- inldata:::mds_swm(sites = sites[is, ], tz = "America/Denver") - expect_data_frame(x, min.rows = 1, col.names = "named") +# test making groundwater levels +site_no <- "433500112572501" +is <- sites$site_no == site_no +x <- inldata:::mds_gwl(sites = sites[is, ], tz = "America/Denver") +expect_data_frame(x, min.rows = 1, col.names = "named") - # test making groundwater levels - site_no <- "433500112572501" - is <- sites$site_no == site_no - x <- inldata:::mds_gwl(sites = sites[is, ], tz = "America/Denver") - expect_data_frame(x, min.rows = 1, col.names = "named") +# test making units +data <- data.frame( + "unit_cd" = "deg C", + "unit_ds" = "degrees Celsius" +) +x <- inldata:::mds_units(data) +expect_data_frame(x, nrows = nrow(data), col.names = "named") - # test making units - data <- data.frame( - "unit_cd" = "deg C", - "unit_ds" = "degrees Celsius" - ) - x <- inldata:::mds_units(data) - expect_data_frame(x, nrows = nrow(data), col.names = "named") +# test making background concentrations +data <- data.frame( + "srsname" = "Sodium", + "pcode" = "00930", + "unit_cd" = "mg/L", + "bkgrd_min" = "8.3", + "bkgrd_max" = "14.8", + "reference" = "Bartholomay" +) +x <- inldata:::mds_background(data, parameters) +expect_data_frame(x, nrows = nrow(data), col.names = "named") - # test making background concentrations - data <- data.frame( - "srsname" = "Sodium", - "pcode" = "00930", - "unit_cd" = "mg/L", - "bkgrd_min" = "8.3", - "bkgrd_max" = "14.8", - "reference" = "Bartholomay" - ) - x <- inldata:::mds_background(data, parameters) - expect_data_frame(x, nrows = nrow(data), col.names = "named") - - # test unit conversion - data <- data.frame( - "pcode" = c("01065", "00631"), - "unit_cd" = c("ug/L", "ug/L") - ) - x <- inldata:::convert_units(data, parameters) - expect_data_frame(x, - types = c("character", "character", "character", "numeric"), - nrows = nrow(data), - col.names = "named" - ) - expect_set_equal(colnames(x), c("pcode", "from", "to", "mult")) - -} +# test unit conversion +data <- data.frame( + "pcode" = c("01065", "00631"), + "unit_cd" = c("ug/L", "ug/L") +) +x <- inldata:::convert_units(data, parameters) +expect_data_frame(x, + types = c("character", "character", "character", "numeric"), + nrows = nrow(data), + col.names = "named" +) +expect_set_equal(colnames(x), c("pcode", "from", "to", "mult")) diff --git a/man/assert_url.Rd b/man/assert_url.Rd index bfeadc1aec54a01896f6e30e5330c700278e6578..24d8e1c159b3f82ace9a0291a3af03bdef24b71d 100644 --- a/man/assert_url.Rd +++ b/man/assert_url.Rd @@ -19,6 +19,7 @@ URL} } \value{ Returns \code{url} invisibly. +A \code{NULL} value is returned if the assertion fails for any reason. } \description{ Assert that a Uniform Resource Locator (URL) is complete and valid. diff --git a/man/write_datasets.Rd b/man/write_datasets.Rd index cc29bbf9ee6de5e71ac6277342521817c44f4a1c..2d51c019ec99c87f0fef7bf12e0a70c257b1b12e 100644 --- a/man/write_datasets.Rd +++ b/man/write_datasets.Rd @@ -13,7 +13,6 @@ write_datasets( include = NULL, exclude = NULL, pretty = TRUE, - full_names = TRUE, quiet = FALSE ) } @@ -51,9 +50,6 @@ Whether to add indentation, whitespace, and newlines to JSON output (default is See \code{\link[jsonlite:prettify]{prettify}} function for details. The tradeoff for human-readable output is a much larger file size.} -\item{full_names}{'logical' flag. -Whether the full paths of the files are returned (default).} - \item{quiet}{'logical' flag. Whether to suppress printing of debugging information.} } diff --git a/vignettes/download.Rmd b/vignettes/download.Rmd index 34df8f24abf59b95602a05943ebe017fc9320672..dcf04242edd103f35b203bde8a247122962bfe21 100644 --- a/vignettes/download.Rmd +++ b/vignettes/download.Rmd @@ -15,12 +15,15 @@ files <- inldata::write_datasets( package = "inldata", destdir = destdir, gzip = c("json", "geojson"), - pretty = FALSE, - full_names = FALSE -) + pretty = FALSE +) |> basename() exts <- inldata::get_file_ext(files) fmts <- exts |> unique() |> sort() -paths <- lapply(fmts, FUN = function(x) files[exts %in% x]) +paths <- lapply(fmts, + FUN = function(x) { + paste(destdir, files[exts %in% x], sep = "/") + } +) names(paths) <- fmts cols <- rbind( diff --git a/vignettes/erd.Rmd b/vignettes/erd.Rmd index 00d3bedf24ea6188697cfc4c5174487442818ffc..f45b3e1df46d605907fe058365ff24870d555e73 100644 --- a/vignettes/erd.Rmd +++ b/vignettes/erd.Rmd @@ -4,4 +4,4 @@ title: "Entity Relationship Diagram" Entity Relationship Diagram (ERD) for the **inldata** package datasets: This diagram represents the various entities (datasets) within the package and their interrelationships. Each entity is a specific dataset in the package, and the relationships depict how these datasets are interconnected based on shared attributes. This ERD provides a overview of the structure of the data within the **inldata** package, enabling efficient data organization and extraction of meaningful insights. - +<p><img src="../man/figures/erd.svg" alt="ERD" /></p> diff --git a/vignettes/parameters.Rmd b/vignettes/parameters.Rmd index fab3dfccf2144840989001b3bf2680ac421ac2a1..c9841ebe0f8ff4e368522499102200fc240c5896 100644 --- a/vignettes/parameters.Rmd +++ b/vignettes/parameters.Rmd @@ -26,7 +26,7 @@ columns <- list( header = htmltools::tags$div("Parameter name", title = "A long parameter name assigned by the USGS." ), - minWidth = 200, + minWidth = 300, sticky = "left" ),