merge upstream changes in origin/main

NAMESPACE

@@ -8,6 +8,7 @@ export(calc_gmted)
 export(calc_gridmet)
 export(calc_hms)
 export(calc_koppen_geiger)
+export(calc_lagged)
 export(calc_merra2)
 export(calc_message)
 export(calc_modis_daily)
@@ -134,6 +135,7 @@ importFrom(dplyr,bind_rows)
 importFrom(dplyr,ends_with)
 importFrom(dplyr,filter)
 importFrom(dplyr,group_by)
+importFrom(dplyr,lag)
 importFrom(dplyr,left_join)
 importFrom(dplyr,mutate)
 importFrom(dplyr,summarize)

R/calculate_covariates.R

@@ -1035,8 +1035,6 @@ calc_tri <- function(
 }
 
 
-
-
 #' Calculate road emissions covariates
 #' @param from SpatVector(1). Output of \code{process_nei()}.
 #' @param locs sf/SpatVector. Locations at NEI values are joined.
@@ -1508,50 +1506,38 @@ calc_sedac_population <- function(
     locs,
     locs_id = NULL,
     radius = 0,
-    fun = "mean",
-    ...) {
-  #### check for null parameters
-  check_for_null_parameters(mget(ls()))
-  #### prepare sites
-  if (methods::is(locs, "sf")) {
-    sites_e <- terra::vect(locs)
-  } else if (methods::is(locs, "data.frame")) {
-    sites_e <- calc_prepare_locs(
-      from = from,
-      locs_id = locs_id,
-      radius = radius
-    )
-  }
-  #### site identifiers
+    fun = "mean") {
+  #### prepare locations list
+  sites_list <- calc_prepare_locs(
+    from = from,
+    locs = locs,
+    locs_id = locs_id,
+    radius = radius
+  )
   sites_e <- sites_list[[1]]
   sites_id <- sites_list[[2]]
-  #### empty location data.frame
-  sites_extracted <- NULL
-  for (l in seq_len(terra::nlyr(from))) {
-    data_layer <- from[[l]]
-    name_split <- strsplit(
-      names(data_layer),
-      "_"
-    )[[1]]
-    year <- name_split[4]
-    resolution <- name_split[5:6]
-    cat(
-      paste0(
-        "Calculating annual population density covariates for ",
-        year,
-        " at ",
-        process_sedac_codes(
-          paste0(
-            name_split[5],
-            "_",
-            name_split[6]
-          ),
-          invert = TRUE
+  #### message information
+  name_split <- strsplit(
+    names(from),
+    "_"
+  )[[1]]
+  cat(
+    paste0(
+      "Calculating population covariates for ",
+      name_split[4],
+      " at ",
+      process_sedac_codes(
+        paste0(
+          name_split[5],
+          "_",
+          name_split[6]
         ),
-        " resolution...\n"
-      )
+        invert = TRUE
+      ),
+      " resolution...\n"
     )
-#### perform extraction
+  )
+  #### perform extraction
   sites_extracted <- calc_worker(
     dataset = "skip",
     from = from,
@@ -1562,12 +1548,14 @@ calc_sedac_population <- function(
     variable = 3,
     time = 4,
     time_type = "year"
+  )
   #### return data.frame
   return(data.frame(sites_extracted))
 }
 
 
 
+
 #' Calculate roads covariates
 #' @description Prepared groads data is clipped with the buffer polygons
 #' of `radius`. The total length of the roads are calculated.
@@ -1907,4 +1895,4 @@ calc_lagged <- function(
   #### filter to dates of interest
   variables_return_date <- variables_return[time %in% date_sequence, ]
   return(variables_return_date)
-}
+  }

R/download.R

@@ -43,7 +43,8 @@ download_data <-
                      "modis", "narr_p_levels", "nlcd", "noaa", "sedac_groads",
                      "sedac_population", "groads", "population", "plevels",
                      "p_levels", "monolevel", "hms", "smoke", "tri", "nei",
-                     "gridmet", "terraclimate"),
+                     "gridmet", "terraclimate", "huc", "cropscape", "cdl",
+                     "prism", "olm", "openlandmap"),
     directory_to_save = NULL,
     acknowledgement = FALSE,
     ...
@@ -79,7 +80,13 @@ download_data <-
       tri = download_tri_data,
       nei = download_nei_data,
       gridmet = download_gridmet_data,
-      terraclimate = download_terraclimate_data
+      terraclimate = download_terraclimate_data,
+      huc = download_huc_data,
+      cropscape = download_cropscape_data,
+      cdl = download_cropscape_data,
+      prism = download_prism_data,
+      olm = download_olm_data,
+      openlandmap = download_olm_data
     )
 
     tryCatch(
@@ -3439,7 +3446,7 @@ download_olm_data <- function(
 
 }
 
-i
+
 # nolint start
 #' Download National Hydrography Dataset (NHD) data
 #' @description

R/download_auxiliary.R

@@ -425,3 +425,70 @@ test_download_functions <- function(
     testthat::expect_true(all(url_status))
   }
 }
+
+#' Retrieve file links from SpatioTemporal Assets Catalog (STAC)
+#' @description
+#' Read file links from SpatioTemporal Assets Catalog (STAC) JSON file.
+#' @note
+#' Retrieving URLs may take a while depending on the spatial tiling,
+#' temporal resolution, and other assets. Users are encouraged to use
+#' `which` parameter to select a specific collection.
+#' @param stac_json character(1). Full path of STAC JSON file.
+#' @param format character(1). Format of target files. Default is "tif".
+#' @param which numeric/character. Index or name of collection to retrieve.
+#' @param id_only logical(1). Return collection IDs only.
+#' @returns character vector of file links.
+#' @examples
+#' \dontrun{
+#' read_stac_json()
+#' }
+#' @export
+#' @keywords auxiliary
+#' @author Insang Song
+#' @importFrom rstac read_collections
+#' @importFrom rstac read_items
+#' @importFrom rstac assets_url
+#' @importFrom rstac read_stac
+#' @importFrom rstac links
+list_stac_files <-
+  function(
+    stac_json =
+    "https://s3.eu-central-1.wasabisys.com/stac/openlandmap/catalog.json",
+    format = "tif",
+    which = NULL,
+    id_only = FALSE
+  ) {
+    allcollections <-
+      rstac::read_stac(
+        stac_json
+      ) |>
+      rstac:::read_collections.catalog()
+    collection <- allcollections$collections
+    collection_ids <- sapply(collection, \(x) x$id)
+    if (id_only) {
+      return(collection_ids)
+    }
+
+    message(
+      sprintf(
+        "Names of collections include: %s",
+        paste(
+          collection_ids, collapse = "\n"
+        )
+      )
+    )
+
+    which <- if (!is.numeric(which)) grep(which, collection_ids) else which
+    collection <- if (is.null(which)) collection else collection[which]
+
+    collection_assets <-
+      lapply(
+        collection,
+        \(x) rstac::assets_url(rstac:::read_items.doc_collection(x))
+      )
+    collection_assets <- unlist(collection_assets)
+    list_assets <- grep(sprintf("%s$", format), collection_assets, value = TRUE)
+
+    return(list_assets)
+  }
+

R/process.R

@@ -16,19 +16,23 @@
 #' - [`process_bluemarble`]: `"bluemarble"`
 #' - [`process_koppen_geiger`]: `"koppen-geiger"`, `"koeppen-geiger"`, `"koppen"`,
 #' - [`process_ecoregion`]: `"ecoregion"`, `"ecoregions"`
-#' - [`process_nlcd`]: `"nlcd"`, `"NLCD"`
-#' - [`process_tri`]: `"tri"`, `"TRI"`
-#' - [`process_nei`]: `"nei"`, `"NEI`
+#' - [`process_nlcd`]: `"nlcd"`
+#' - [`process_tri`]: `"tri"`
+#' - [`process_nei`]: `"nei"`
 #' - [`process_geos`]: `"geos"`
-#' - [`process_gmted`]: `"gmted"`, `"GMTED"`
-#' - [`process_aqs`]: `"aqs"`, `"AQS"`
-#' - [`process_hms`]: `"hms"`, `"HMS"`, `"smoke"`
-#' - [`process_narr`]: `"narr"`, `"NARR"`
+#' - [`process_gmted`]: `"gmted"`
+#' - [`process_aqs`]: `"aqs"`
+#' - [`process_hms`]: `"hms"`, `"smoke"`
+#' - [`process_narr`]: `"narr"`
 #' - [`process_sedac_groads`]: `"sedac_groads"`, `"roads"`, `"groads"`
 #' - [`process_sedac_population`]: `"sedac_population"`, `"population"`
-#' - [`process_merra2`]: `"merra"`, `"MERRA"`, `"merra2"`, `"MERRA2"`
+#' - [`process_merra2`]: `"merra"`, `"merra2"`
 #' - [`process_gridmet`]: `"gridmet"`, `"gridMET`"
 #' - [`process_terraclimate`]: `"terraclimate"`, `"TerraClimate"`
+#' - [`process_huc`]: `"huc"`
+#' - [`process_cropscape`]: `"cropscape"`, `"cdl"`
+#' - [`process_prism`]: `"prism"`
+#' - [`process_olm`]: `"olm"`, `"openlandmap`
 #' @returns `SpatVector`, `SpatRaster`, `sf`, or `character` depending on
 #' covariate type and selections.
 #' @author Insang Song
@@ -46,7 +50,8 @@ process_covariates <-
                   "sedac_groads", "groads", "roads",
                   "nlcd", "tri", "narr", "nei",
                   "ecoregions", "ecoregion",
-                  "merra", "merra2", "gridmet", "terraclimate"),
+                  "merra", "merra2", "gridmet", "terraclimate",
+                  "huc", "cropscape", "cdl", "prism", "olm", "openlandmap"),
     path = NULL,
     ...
   ) {
@@ -80,7 +85,13 @@ process_covariates <-
       merra = process_merra2,
       merra2 = process_merra2,
       gridmet = process_gridmet,
-      terraclimate = process_terraclimate
+      terraclimate = process_terraclimate,
+      huc = process_huc,
+      cropscape = process_cropscape,
+      cdl = process_cropscape,
+      prism = process_prism,
+      olm = process_olm,
+      openlandmap = process_olm
     )
 
     res_covariate <-