Mm download function enhancements 1117

R/check_url_file_exist.R

@@ -0,0 +1,16 @@
+# Function to test status of download function URLs
+# Date created: 2023-11-30
+# Insang Song (based on comment #164 Location of download functions)
+# Mitchell Manware
+
+#' Check if sample of download URLs exist
+#'
+#' @param url Download URL to be checked.
+#' @author Insang Song; Mitchell Manware
+#' @export
+check_url_file_exist <- function(url) {
+  http_status_ok <- 200
+  hd <- httr::HEAD(url)
+  status <- hd$all_headers[[1]]$status
+  return(status == http_status_ok)
+}

R/download_geos_cf_data.R

@@ -0,0 +1,135 @@
+################################################################################
+# Date created: 2023-10-16
+# Packages required: stringr
+################################################################################
+
+################################################################################
+#' download_geos_cf_data: download atmospheric composition data from the NASA
+#' Global Earth Observing System (GEOS) model.
+#' @description
+#' The `download_goes_cf_data()` function accesses and downloads various
+#' atmospheric composition collections from the [NASA Global Earth Observing]
+#' [System (GEOS) model](https://gmao.gsfc.nasa.gov/GEOS_systems/).
+#' @param date_start character(1). length of 10. Start date for downloading
+#' data. Format YYYY-MM-DD (ex. September 1, 2023 = "2023-09-01").
+#' @param date_end character(1). length of 10. End date for downloading data.
+#' Format YYYY-MM-DD (ex. September 1, 2023 = "2023-09-01").
+#' @param collection character(1). GEOS-CF data collection file name.
+#' @param directory_to_save character(1). Directory to save data.
+#' @param data_download_acknowledgement logical(1). By setting `= TRUE` the
+#' user acknowledge that the data downloaded using this function may be very
+#' large and use lots of machine storage and memory.
+#' @param download logical(1). `= FALSE` will generate a `.txt` file containing
+#' all download commands. By setting `= TRUE` the function will download all of
+#' the requested data files.
+#' @author Mitchell Manware
+#' @return NULL;
+#' @importFrom stringr str_sub
+#' @importFrom stringr str_pad
+#' @export
+download_geos_cf_data <- function(
+  date_start = "2023-09-01",
+  date_end = "2023-09-01",
+  collection = NULL,
+  directory_to_save = "../../data/covariates/geos_cf/",
+  data_download_acknowledgement = FALSE,
+  download = FALSE
+) {
+  #### 1. directory setup
+  chars_dir_save <- nchar(directory_to_save)
+  if (substr(directory_to_save, chars_dir_save, chars_dir_save) != "/") {
+    directory_to_save <- paste0(directory_to_save, "/", sep = "")
+  }
+  if (dir.exists(directory_to_save) == FALSE) {
+    dir.create(directory_to_save)
+  }
+  #### 2. check for data download acknowledgement
+  if (data_download_acknowledgement == FALSE) {
+    stop(paste0("Data download acknowledgement is set to FALSE. ",
+                "Please acknowledge that the data downloaded using this ",
+                "function may be very large and use lots of machine storage ",
+                "and memory.\n"))
+  }
+  #### 2. check for collection
+  if (is.null(collection) == TRUE) {
+    stop(paste0("Please select a GEOS-CF collection.\n"))
+  }
+  #### 3. check if collection is valid
+  collections <- c("htf_inst_15mn_g1440x721_x1", "aqc_tavg_1hr_g1440x721_v1",
+                   "chm_tavg_1hr_g1440x721_v1", "met_tavg_1hr_g1440x721_x1",
+                   "xgc_tavg_1hr_g1440x721_x1", "chm_inst_1hr_g1440x721_p23",
+                   "met_inst_1hr_g1440x721_p23")
+  if (!(collection %in% collections)) {
+    stop(paste0("Requested collection is not recognized.\n"))
+  }
+  #### 4. define date sequence
+  date_start_date_format <- as.Date(date_start, format = "%Y-%m-%d")
+  date_end_date_format <- as.Date(date_end, format = "%Y-%m-%d")
+  date_sequence <- seq(date_start_date_format, date_end_date_format, "day")
+  date_sequence <- gsub("-", "", as.character(date_sequence))
+  #### 5. define time sequence
+  if (stringr::str_sub(collection, -1, -1) == "1") {
+    time_sequence <- as.character(seq(from = 30, to = 2330, by = 100))
+    time_sequence <- stringr::str_pad(time_sequence,
+                                      pad = "0",
+                                      width = 4,
+                                      side = "left")
+  } else if (stringr::str_sub(collection, -1, -1) == "3") {
+    time_sequence <- as.character(seq(from = 100, to = 2400, by = 100))
+    time_sequence <- stringr::str_pad(time_sequence,
+                                      pad = "0",
+                                      width = 4,
+                                      side = "left")
+  }
+  #### 6. define URL base
+  base <- "https://portal.nccs.nasa.gov/datashare/gmao/geos-cf/v1/ana/"
+  #### 7. initiate "..._wget_commands.txt" file
+  commands_txt <- paste0(directory_to_save,
+                         collection,
+                         "_wget_commands.txt")
+  sink(commands_txt)
+  #### 8. concatenate and print download commands to "..._wget_commands.txt"
+  for (d in seq_along(date_sequence)){
+    date <- date_sequence[d]
+    year <- stringr::str_sub(date, 1, 4)
+    month <- stringr::str_sub(date, 5, 6)
+    day <- stringr::str_sub(date, 7, 8)
+    for (t in seq_along(time_sequence)){
+      download_url <- paste0(base,
+                             "Y",
+                             year,
+                             "/M",
+                             month,
+                             "/D",
+                             day,
+                             "/GEOS-CF.v01.rpl.",
+                             collection,
+                             ".",
+                             date,
+                             "_",
+                             time_sequence[t],
+                             "z.nc4")
+      download_folder <- paste0(directory_to_save,
+                                collection)
+      download_command <- paste0("wget ",
+                                 download_url,
+                                 " -P ",
+                                 download_folder,
+                                 "\n")
+      cat(download_command)
+    }
+  }
+  #### 9. finish "..._wget_commands.txt" file
+  sink()
+  #### 10. build system command
+  system_command <- paste0(". ",
+                           commands_txt,
+                           "\n")
+  #### 11. download data
+  if (download == TRUE) {
+    system(command = system_command)
+    file.remove(commands_txt)
+  } else if (download == FALSE) {
+    return(cat(paste0("Skipping data download.\n")))
+  }
+}

R/download_gmted_data.R

@@ -0,0 +1,166 @@
+################################################################################
+# Date created: 2023-10-24
+# Packages required: none
+################################################################################
+
+################################################################################
+#' download_gmted_data: download global elevation data from the Global Multi-
+#' resolution Terrain Elevation Data (GMTED2010).
+#' @description
+#' The `download_gmted_data()` function acesses and downloads Global
+#' Multi-resolution Terrain Elevation Data (GMTED2010) from
+#' [U.S. Geological Survey and National Geospatial-Intelligence Agency]
+#' (https://www.usgs.gov/coastal-changes-and-impacts/gmted2010).
+#' @param statistic character(1). Available statistics include "Breakline
+#' Emphasis", "Systematic Subsample", "Median Statistic", "Minimum Statistic",
+#' "Mean Statistic", "Maximum Statistic", and "Standard Deviation Statistic".
+#' @param resolution character(1). Available resolutions include "7.5 arc-
+#' seconds", "15 arc-seconds", and "30 arc-seconds".
+#' @param directory_to_download character(1). Directory to download zip files
+#' from Global Multi-resolution Terrain Elevation Data (GMTED2010).
+#' @param directory_to_save character(1). Directory to decompress zip files.
+#' @param data_download_acknowledgement logical(1). By setting `= TRUE` the
+#' user acknowledge that the data downloaded using this function may be very
+#' large and use lots of machine storage and memory.
+#' @param unzip logical(1). Unzip zip files. Default = `TRUE`.
+#' @param remove_zip logical(1). Remove zip file from directory_to_download.
+#' Default = `FALSE`.
+#' @param download logical(1). `= FALSE` will generate a `.txt` file containing
+#' all download commands. By setting `= TRUE` the function will download all of
+#' the requested data files.
+#' @author Mitchell Manware
+#' @return NULL;
+#' @export
+download_gmted_data <- function(
+  statistic = NULL,
+  resolution = NULL,
+  directory_to_download = "../../data/covariates/gmted/",
+  directory_to_save = "../../data/covariates/gmted/",
+  data_download_acknowledgement = FALSE,
+  unzip = TRUE,
+  remove_zip = FALSE,
+  download = FALSE
+) {
+  #### 1. directory setup
+  chars_dir_download <- nchar(directory_to_download)
+  chars_dir_save <- nchar(directory_to_save)
+  if (substr(directory_to_download,
+             chars_dir_download,
+             chars_dir_download) != "/") {
+    directory_to_download <- paste(directory_to_download,
+                                   "/",
+                                   sep = "")
+  }
+  if (substr(directory_to_save, chars_dir_save, chars_dir_save) != "/") {
+    directory_to_save <- paste(directory_to_save, "/", sep = "")
+  }
+  if (dir.exists(directory_to_download) == FALSE) {
+    dir.create(directory_to_download)
+  }
+  if (dir.exists(directory_to_save) == FALSE) {
+    dir.create(directory_to_save)
+  }
+  #### 2. check for data download acknowledgement
+  if (data_download_acknowledgement == FALSE) {
+    stop(paste0("Data download acknowledgement is set to FALSE.",
+                "Please acknowledge that the data downloaded using this",
+                "function may be very large and use lots of machine storage",
+                "and memory."))
+  }
+  #### 3. check for statistic
+  if (is.null(statistic) == TRUE) {
+    stop(paste0("Please select a GMTED2010 statistic.\n"))
+  }
+  #### 4. check for valid statistic
+  valid_statistics <- c("Breakline Emphasis", "Systematic Subsample",
+                        "Median Statistic", "Minimum Statistic",
+                        "Mean Statistic", "Maximum Statistic",
+                        "Standard Deviation Statistic")
+  if (!(statistic %in% valid_statistics)) {
+    stop(paste0("Requested statistic is not recognized.\n"))
+  }
+  #### 5. check for resolution
+  if (is.null(resolution) == TRUE) {
+    stop(paste0("Please select a data resolution.\n"))
+  }
+  #### 6. check for valid resolution
+  valid_resolutions <- c("7.5 arc-seconds", "15 arc-seconds", "30 arc-seconds")
+  if (!(resolution %in% valid_resolutions)) {
+    stop(paste0("Requested resolution is not recognized.\n"))
+  }
+  #### 7. define URL base
+  base <- paste0("https://edcintl.cr.usgs.gov/downloads/sciweb1/shared/topo",
+                 "/downloads/GMTED/Grid_ZipFiles/")
+  #### 8. define URL statistic code
+  statistics <- c("Breakline Emphasis", "Systematic Subsample",
+                  "Median Statistic", "Minimum Statistic",
+                  "Mean Statistic", "Maximum Statistic",
+                  "Standard Deviation Statistic")
+  statistic_codes <- c("be", "ds", "md", "mi", "mn", "mx", "sd")
+  statistic_codes <- cbind(statistics, statistic_codes)
+  statistic_code <- subset(statistic_codes, statistics == statistic)[2]
+  #### 9. define URL resolution code
+  resolutions <- c("7.5 arc-seconds", "15 arc-seconds", "30 arc-seconds")
+  resolution_codes <- c("75", "15", "30")
+  resolution_codes <- cbind(resolutions, resolution_codes)
+  resolution_code <- subset(resolution_codes, resolutions == resolution)[2]
+  #### 10. build url
+  download_url <- paste0(base,
+                         statistic_code,
+                         resolution_code,
+                         "_grd.zip")
+  #### 11. build download file name
+  download_name <- paste0(directory_to_download,
+                          "gmted2010_",
+                          statistic_code,
+                          resolution_code,
+                          "_grd.zip")
+  #### 12. build download command
+  download_command <- paste0("curl -s -o ",
+                             download_name,
+                             " --url ",
+                             download_url,
+                             "\n")
+  #### 13. initiate "..._curl_commands.txt"
+  commands_txt <- paste0(directory_to_download,
+                         "gmted_",
+                         gsub(" ", "", statistic),
+                         "_",
+                         gsub(" ", "", resolution),
+                         "_curl_command.txt")
+  sink(commands_txt)
+  #### 14. concatenate and print download command to "..._curl_commands.txt"
+  cat(download_command)
+  #### 15. finish "..._curl_commands.txt" file
+  sink()
+  #### 16. build system command
+  system_command <- paste0(". ",
+                           commands_txt,
+                           "\n")
+  #### 17 download data
+  if (download == TRUE) {
+    cat(paste0("Downloading requested file...\n"))
+    system(command = system_command)
+    Sys.sleep(5L)
+    cat(paste0("Requested file downloaded.\n"))
+  } else if (download == FALSE) {
+    return(cat(paste0("Skipping data download.\n")))
+  }
+  #### 18. end if unzip == FALSE
+  if (unzip == FALSE) {
+    return(cat(paste0("Downloaded files will not be unzipped.\n")))
+  }
+  #### 19 unzip downloaded data
+  cat(paste0("Unzipping files...\n"))
+  unzip(download_name,
+        exdir = directory_to_save)
+  cat(paste0("Files unzipped and saved in ",
+             directory_to_save,
+             ".\n"))
+  #### 20. remove zip files
+  if (remove_zip == TRUE) {
+    cat(paste0("Removing download files...\n"))
+    file.remove(download_name)
+    cat(paste0("Download files removed.\n"))
+  }
+}