Merge pull request #149 from NIEHS/1.2.1

1.2.1

.Rbuildignore

@@ -26,3 +26,4 @@ inst/extdata/air.2m
 inst/extdata/nasa/token.txt
 LICENSE.md
 ^CRAN-SUBMISSION$
+^tests/container/

.github/workflows/test-coverage.R

@@ -4,7 +4,7 @@ ghworkspace <- args[[2]]
 
 dir.create(file.path(runnertemp, "package"), showWarnings = FALSE, recursive = TRUE)
 sink(paste0(runnertemp, '/package/testthat.Rout.res'))
-cov <- covr::package_coverage()
+cov <- covr::package_coverage(quiet = FALSE)
 sink()
 covd <- covr::coverage_to_list(cov)$totalcoverage
 write.table(

.gitignore

@@ -58,4 +58,10 @@ inst/extdata/air.2m
 inst/extdata/nasa/token.txt
 
 # CRAN release
-CRAN-SUBMISSION
+CRAN-SUBMISSION
+
+# local pkgdown site
+/pkgdown/
+
+# containerized tests
+/tests/container/*sif

.lintr

@@ -3,5 +3,7 @@ linters: linters_with_defaults(
   )
 exclusions: list(
     "tests/testthat/test-download_functions.R",
-    "vignettes/workflow.Rmd"
+    "vignettes/terraclimate_workflow.Rmd",
+    "vignettes/gridmet_workflow.Rmd",
+    "vignettes/narr_workflow.Rmd"
   )

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: amadeus
 Title: Accessing and Analyzing Large-Scale Environmental Data
-Version: 1.2.0
+Version: 1.2.1
 Authors@R: c(
     person(given = "Mitchell", family = "Manware", role = c("aut", "ctb"), comment = c(ORCID = "0009-0003-6440-6106")),
     person(given = "Insang", family = "Song", role = c("aut", "ctb"), comment = c(ORCID = "0000-0001-8732-3256")),
@@ -13,7 +13,28 @@ Authors@R: c(
 Maintainer: Kyle Messier <kyle.messier@nih.gov>
 Description: Functions are designed to facilitate access to and utility with large scale, publicly available environmental data in R. The package contains functions for downloading raw data files from web URLs (download_data()), processing the raw data files into clean spatial objects (process_covariates()), and extracting values from the spatial data objects at point and polygon locations (calculate_covariates()). These functions call a series of source-specific functions which are tailored to each data sources/datasets particular URL structure, data format, and spatial/temporal resolution. The functions are tested, versioned, and open source and open access. For sum_edc() method details, see Messier, Akita, and Serre (2012) <doi:10.1021/es203152a>.
 Depends: R (>= 4.1.0)
-Imports: dplyr, sf, sftime, stats, terra, methods, data.table, httr, rvest, exactextractr, utils, stringi, testthat (>= 3.0.0), parallelly, stars, tidyr, rlang, nhdplusTools, archive, collapse, Rdpack
+Imports:
+    dplyr,
+    sf,
+    sftime,
+    stats,
+    terra,
+    methods,
+    data.table,
+    httr,
+    rvest,
+    exactextractr,
+    utils,
+    stringi,
+    testthat (>= 3.0.0),
+    parallelly,
+    stars,
+    tidyr,
+    rlang,
+    nhdplusTools,
+    archive,
+    collapse,
+    Rdpack
 Suggests: 
     covr,
     withr,

NAMESPACE

@@ -14,6 +14,7 @@ export(calculate_ecoregion)
 export(calculate_geos)
 export(calculate_gmted)
 export(calculate_gridmet)
+export(calculate_groads)
 export(calculate_hms)
 export(calculate_koppen_geiger)
 export(calculate_lagged)
@@ -23,8 +24,7 @@ export(calculate_modis_daily)
 export(calculate_narr)
 export(calculate_nei)
 export(calculate_nlcd)
-export(calculate_sedac_groads)
-export(calculate_sedac_population)
+export(calculate_population)
 export(calculate_temporal_dummies)
 export(calculate_terraclimate)
 export(calculate_tri)
@@ -43,6 +43,7 @@ export(download_epa_certificate)
 export(download_geos)
 export(download_gmted)
 export(download_gridmet)
+export(download_groads)
 export(download_hash)
 export(download_hms)
 export(download_huc)
@@ -53,13 +54,12 @@ export(download_narr)
 export(download_nei)
 export(download_nlcd)
 export(download_permit)
+export(download_population)
 export(download_prism)
 export(download_remove_command)
 export(download_remove_zips)
 export(download_run)
 export(download_sanitize_path)
-export(download_sedac_groads)
-export(download_sedac_population)
 export(download_setup_dir)
 export(download_sink)
 export(download_terraclimate)
@@ -85,6 +85,7 @@ export(process_gmted)
 export(process_gmted_codes)
 export(process_gridmet)
 export(process_gridmet_codes)
+export(process_groads)
 export(process_hms)
 export(process_huc)
 export(process_koppen_geiger)
@@ -99,10 +100,9 @@ export(process_modis_warp)
 export(process_narr)
 export(process_nei)
 export(process_nlcd)
+export(process_population)
 export(process_prism)
 export(process_sedac_codes)
-export(process_sedac_groads)
-export(process_sedac_population)
 export(process_terraclimate)
 export(process_terraclimate_codes)
 export(process_tri)

R/calculate_covariates.R

@@ -26,8 +26,8 @@
 #' * \code{\link{calculate_gmted}}: "gmted", "GMTED"
 #' * \code{\link{calculate_narr}}: "narr", "NARR"
 #' * \code{\link{calculate_geos}}: "geos", "geos_cf", "GEOS"
-#' * \code{\link{calculate_sedac_population}}: "population", "sedac_population"
-#' * \code{\link{calculate_sedac_groads}}: "roads", "groads", "sedac_groads"
+#' * \code{\link{calculate_population}}: "population", "sedac_population"
+#' * \code{\link{calculate_groads}}: "roads", "groads", "sedac_groads"
 #' * \code{\link{calculate_nlcd}}: "nlcd", "NLCD"
 #' * \code{\link{calculate_tri}}: "tri", "TRI"
 #' * \code{\link{calculate_nei}}: "nei", "NEI"
@@ -83,11 +83,11 @@ calculate_covariates <-
       nlcd = calculate_nlcd,
       smoke = calculate_hms,
       hms = calculate_hms,
-      sedac_groads = calculate_sedac_groads,
-      roads = calculate_sedac_groads,
-      groads = calculate_sedac_groads,
-      sedac_population = calculate_sedac_population,
-      population = calculate_sedac_population,
+      sedac_groads = calculate_groads,
+      roads = calculate_groads,
+      groads = calculate_groads,
+      sedac_population = calculate_population,
+      population = calculate_population,
       nei = calculate_nei,
       tri = calculate_tri,
       geos = calculate_geos,
@@ -1310,9 +1310,9 @@ calculate_hms <- function(
     skip_df <- data.frame(as.POSIXlt(from), 0, 0, 0)
     colnames(skip_df) <- c(
       "time",
-      paste0("light_", radius),
-      paste0("medium_", radius),
-      paste0("heavy_", radius)
+      paste0("light_", sprintf("%05d", radius)),
+      paste0("medium_", sprintf("%05d", radius)),
+      paste0("heavy_", sprintf("%05d", radius))
     )
     # fixed: locs is replicated per the length of from
     skip_merge <-
@@ -1801,7 +1801,7 @@ calculate_geos <- function(
 #' \code{data.frame} object containing \code{locs_id}, year, and population
 #' density variable. Population density variable column name reflects
 #' spatial resolution of \code{from} and circular buffer radius.
-#' @param from SpatRaster(1). Output of \code{process_sedac_population()}.
+#' @param from SpatRaster(1). Output of \code{process_population()}.
 #' @param locs data.frame, characater to file path, SpatVector, or sf object.
 #' @param locs_id character(1). Column within `locations` CSV file
 #' containing identifier for each unique coordinate location.
@@ -1814,16 +1814,16 @@ calculate_geos <- function(
 #' coordinate reference system of the `sf` or `SpatVector` is that of `from.`
 #' @param ... Placeholders
 #' @author Mitchell Manware
-#' @seealso [process_sedac_population()]
+#' @seealso [process_population()]
 #' @return a data.frame or SpatVector object
 #' @importFrom methods is
 #' @examples
 #' ## NOTE: Example is wrapped in `\dontrun{}` as function requires a large
 #' ##       amount of data which is not included in the package.
 #' \dontrun{
 #' loc <- data.frame(id = "001", lon = -78.90, lat = 35.97)
-#' calculate_sedac_population(
-#'   from = pop, # derived from process_sedac_population() example
+#' calculate_population(
+#'   from = pop, # derived from process_population() example
 #'   locs = loc,
 #'   locs_id = "id",
 #'   radius = 0,
@@ -1832,7 +1832,7 @@ calculate_geos <- function(
 #' )
 #' }
 #' @export
-calculate_sedac_population <- function(
+calculate_population <- function(
     from,
     locs,
     locs_id = NULL,
@@ -1903,7 +1903,7 @@ calculate_sedac_population <- function(
 #' Then the density of the roads is calculated by dividing
 #' the total length from the area of the buffer. `terra::linearUnits()`
 #' is used to convert the unit of length to meters.
-#' @param from SpatVector(1). Output of `process_sedac_groads`.
+#' @param from SpatVector(1). Output of `process_groads`.
 #' @param locs data.frame, characater to file path, SpatVector, or sf object.
 #' @param locs_id character(1). Column within `locations` CSV file
 #' containing identifier for each unique coordinate location.
@@ -1921,7 +1921,7 @@ calculate_sedac_population <- function(
 #' dataset. For more information, see <https://earthdata.nasa.gov/data/catalog/sedac-ciesin-sedac-groads-v1-1.00>.
 # nolint end
 #' @author Insang Song
-#' @seealso [`process_sedac_groads`]
+#' @seealso [`process_groads`]
 #' @return a data.frame or SpatVector object
 #' @importFrom terra vect
 #' @importFrom stats aggregate
@@ -1939,8 +1939,8 @@ calculate_sedac_population <- function(
 #' ##       amount of data which is not included in the package.
 #' \dontrun{
 #' loc <- data.frame(id = "001", lon = -78.90, lat = 35.97)
-#' calculate_sedac_groads(
-#'   from = groads, # derived from process_sedac_groads() example
+#' calculate_groads(
+#'   from = groads, # derived from process_groads() example
 #'   locs = loc,
 #'   locs_id = "id",
 #'   radius = 1000,
@@ -1949,7 +1949,7 @@ calculate_sedac_population <- function(
 #' )
 #' }
 #' @export
-calculate_sedac_groads <- function(
+calculate_groads <- function(
     from = NULL,
     locs = NULL,
     locs_id = NULL,

R/download.R

@@ -29,8 +29,8 @@
 #' * \code{\link{download_narr}}: `"narr"`
 #' * \code{\link{download_nlcd}}: `"nlcd"`, `"NLCD"`
 #' * \code{\link{download_hms}}: `"noaa"`, `"smoke"`, `"hms"`
-#' * \code{\link{download_sedac_groads}}: `"sedac_groads"`, `"groads"`
-#' * \code{\link{download_sedac_population}}: `"sedac_population"`,
+#' * \code{\link{download_groads}}: `"sedac_groads"`, `"groads"`
+#' * \code{\link{download_population}}: `"sedac_population"`,
 #'   `"population"`
 #' * \code{\link{download_modis}}: `"modis"`, `"MODIS"`
 #' * \code{\link{download_tri}}: `"tri"`, `"TRI"`
@@ -94,10 +94,10 @@ download_data <-
       noaa = download_hms,
       smoke = download_hms,
       hms = download_hms,
-      sedac_groads = download_sedac_groads,
-      groads = download_sedac_groads,
-      sedac_population = download_sedac_population,
-      population = download_sedac_population,
+      sedac_groads = download_groads,
+      groads = download_groads,
+      sedac_population = download_population,
+      population = download_population,
       modis = download_modis,
       tri = download_tri,
       nei = download_nei,
@@ -1586,7 +1586,7 @@ download_nlcd <- function(
 # nolint start
 #' Download roads data
 #' @description
-#' The \code{download_sedac_groads()} function accesses and downloads
+#' The \code{download_groads()} function accesses and downloads
 #' roads data from [NASA's Global Roads Open Access Data Set (gROADS), v1 (1980-2010)](https://earthdata.nasa.gov/data/catalog/sedac-ciesin-sedac-groads-v1-1.00).
 #' @param data_region character(1). Data can be downloaded for `"Global"`,
 #' `"Africa"`, `"Asia"`, `"Europe"`, `"Americas"`, `"Oceania East"`, and `"Oceania West"`.
@@ -1621,7 +1621,7 @@ download_nlcd <- function(
 #' \insertRef{data_ciesin2013groads}{amadeus}
 #' @examples
 #' \dontrun{
-#' download_sedac_groads(
+#' download_groads(
 #'   data_region = "Americas",
 #'   data_format = "Shapefile",
 #'   directory_to_save = tempdir(),
@@ -1632,7 +1632,7 @@ download_nlcd <- function(
 #' )
 #' }
 #' @export
-download_sedac_groads <- function(
+download_groads <- function(
     data_region = c("Americas", "Global", "Africa", "Asia", "Europe", "Oceania East", "Oceania West"),
     data_format = c("Shapefile", "Geodatabase"),
     directory_to_save = NULL,
@@ -1739,7 +1739,7 @@ download_sedac_groads <- function(
 # nolint start
 #' Download population density data
 #' @description
-#' The \code{download_sedac_population()} function accesses and downloads
+#' The \code{download_population()} function accesses and downloads
 #' population density data from [NASA's UN WPP-Adjusted Population Density, v4.11](https://earthdata.nasa.gov/data/catalog/sedac-ciesin-sedac-gpwv4-apdens-wpp-2015-r11-4.11).
 #' @param data_resolution character(1). Available resolutions are 30 second
 #' (approx. 1 km), 2.5 minute (approx. 5 km), 15 minute (approx. 30 km),
@@ -1778,7 +1778,7 @@ download_sedac_groads <- function(
 #' \insertRef{data_ciesin2017gpwv4}{amadeus}
 #' @examples
 #' \dontrun{
-#' download_sedac_population(
+#' download_population(
 #'   data_resolution = "30 second",
 #'   data_format = "GeoTIFF",
 #'   year = "2020",
@@ -1790,7 +1790,7 @@ download_sedac_groads <- function(
 #' )
 #' }
 #' @export
-download_sedac_population <- function(
+download_population <- function(
   data_resolution = "60 minute",
   data_format = c("GeoTIFF", "ASCII", "netCDF"),
   year = "2020",
@@ -2365,7 +2365,7 @@ download_koppen_geiger <- function(
 #'   date = "2024-01-01",
 #'   nasa_earth_data_token = "./pathtotoken/token.txt",
 #'   directory_to_save = tempdir(),
-#'   acknowledgement = TRUE,
+#'   acknowledgement = TRUE,MOD09GA
 #'   download = FALSE, # NOTE: download skipped for examples,
 #'   remove_command = TRUE
 #' )
@@ -2374,8 +2374,10 @@ download_koppen_geiger <- function(
 #' @export
 download_modis <- function(
     product = c(
-      "MOD09GA", "MOD11A1", "MOD06_L2",
-      "MCD19A2", "MOD13A2", "VNP46A2"
+      "MOD09GA", "MYD09GA", "MOD09GQ", "MYD09GQ", "MOD09A1", "MYD09A1",
+      "MOD09Q1", "MYD09Q1", "MOD11A1", "MYD11A1", "MOD11A2", "MYD11A2",
+      "MOD11B1", "MYD11B1", "MOD13A1", "MYD13A1", "MOD13A2", "MYD13A2",
+      "MOD13A3", "MYD13A3", "MOD06_L2", "MCD19A2", "VNP46A2"
     ),
     version = "61",
     horizontal_tiles = c(7, 13),
@@ -2488,7 +2490,7 @@ download_modis <- function(
     file_url <- unlist(file_url[, 2])
     download_url <-
       paste0(
-        # substr(ladsurl, 1, nchar(ladsurl) - 1),
+        substr(ladsurl, 1, nchar(ladsurl) - 1),
         file_url
       )
 
@@ -2507,7 +2509,7 @@ download_modis <- function(
     # date_end <- as.Date(as.character(max(file_dates)), format = "%Y%j")
 
     # Extract download names from file_url using splitter
-    download_name <- sapply(strsplit(download_url, "archives/"), `[`, 2)
+    download_name <- sapply(strsplit(download_url, "/"), `[`, 10)
 
     # Create directory structure with julian dates
     dir_substr <- paste0(
@@ -2649,7 +2651,9 @@ download_modis <- function(
     )
 
     dir_str_julian <-
-      lapply(download_name, function(x) strsplit(x, ".A")[[1]][3])
+      lapply(
+        download_name, function(x) strsplit(x, paste0(product, ".A"))[[1]][2]
+      )
 
     dir_substr <- paste0(
       substr(dir_str_julian, 1, 4), "/",

R/download_auxiliary.R

@@ -505,7 +505,7 @@ narr_variable <- function(variable) {
   )
   pressure <- c("air", "hgt", "omega", "shum", "tke", "uwnd", "vwnd")
   soil <- c("soill", "soilw", "tsoil")
-  base <- "https://psl.noaa.gov/thredds/fileServer/Datasets/NARR/Dailies/"
+  base <- "https://downloads.psl.noaa.gov//Datasets/NARR/Dailies/"
   if (variable %in% mono) {
     base <- paste0(base, "monolevel/")
     months <- ""