revert to file.exists() check; update calc_hms test for new format

NIEHS · Jul 22, 2024 · ca87b25 · ca87b25
1 parent b4d9344
commit ca87b25
Show file tree

Hide file tree

Showing 6 changed files with 21 additions and 117 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -12,7 +12,7 @@ Authors@R: c(
     )
 Description: A Mechanism/Machine for Data, Environments, and User Setup package for health and climate research. It is fully tested, versioned, and open source and open access.
 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, future, future.apply, tidyr, rlang, rstac, nhdplusTools, archive, collapse, devtools, Rdpack, httr2, purrr
+Imports: dplyr, sf, sftime, stats, terra, methods, data.table, httr, rvest, exactextractr, utils, stringi, testthat (>= 3.0.0), parallelly, stars, future, future.apply, tidyr, rlang, rstac, nhdplusTools, archive, collapse, devtools, Rdpack
 Suggests: covr, withr, knitr, rmarkdown, lwgeom, FNN, doRNG
 RdMacros: Rdpack
 Encoding: UTF-8

diff --git a/NAMESPACE b/NAMESPACE
@@ -28,7 +28,6 @@ export(calc_terraclimate)
 export(calc_time)
 export(calc_tri)
 export(calc_worker)
-export(check_file_size)
 export(check_for_null_parameters)
 export(check_mysf)
 export(check_mysftime)
@@ -156,12 +155,9 @@ importFrom(future.apply,future_Map)
 importFrom(future.apply,future_lapply)
 importFrom(httr,GET)
 importFrom(httr,HEAD)
-importFrom(httr2,req_perform)
-importFrom(httr2,request)
 importFrom(methods,is)
 importFrom(nhdplusTools,get_huc)
 importFrom(parallelly,availableWorkers)
-importFrom(purrr,map_dbl)
 importFrom(rlang,inject)
 importFrom(rlang,sym)
 importFrom(rstac,assets_url)

diff --git a/R/download.R b/R/download.R
@@ -230,7 +230,7 @@ download_aqs <-
     #### filter commands to non-existing files
     download_commands <- download_commands[
       which(
-        !check_file_size(download_urls, download_names)
+        !file.exists(download_names)
       )
     ]
     #### 7. initiate "..._curl_commands.txt"
@@ -386,9 +386,8 @@ download_ecoregion <- function(
     Sys.Date(),
     "_wget_command.txt"
   )
-  #### 9. concatenateƒ
+  #### 9. concatenate
   download_sink(commands_txt)
-  # if (!check_file_size(download_url, download_name)) {
   if (!file.exists(download_name)) {
     #### 10. concatenate and print download commands to "..._wget_commands.txt"
     #### cat command only file does not already exist or
@@ -566,7 +565,7 @@ download_geos <- function(
           download_folder_name,
           "\n"
         )
-        if (!check_file_size(download_url, download_folder_name)) {
+        if (!file.exists(download_folder_name)) {
           #### cat command only if file does not already exist
           cat(download_command)
         }
@@ -718,7 +717,7 @@ download_gmted <- function(
   )
   download_sink(commands_txt)
   #### 13. concatenate and print download command to "..._curl_commands.txt"
-  if (!check_file_size(download_url, download_name)) {
+  if (!file.exists(download_name)) {
     #### cat command only if file does not already exist
     cat(download_command)
   }
@@ -1100,7 +1099,7 @@ download_merra2 <- function(
         download_name,
         "\n"
       )
-      if (!check_file_size(download_url, download_name)) {
+      if (!file.exists(download_name)) {
         #### cat command only if file does not already exist
         cat(download_command)
       }
@@ -1272,7 +1271,7 @@ download_narr <- function(
           url,
           "\n"
         )
-        if (!check_file_size(url = url, file = destfile)) {
+        if (!file.exists(destfile)) {
           #### cat command if file does not already exist or if local file size
           #### and the HTTP length (url file size) do not match
           cat(command)
@@ -1428,7 +1427,7 @@ download_nlcd <- function(
   )
   download_sink(commands_txt)
   #### 12. concatenate and print download command to "..._curl_commands.txt"
-  if (!check_file_size(download_url, download_name)) {
+  if (!file.exists(download_name)) {
     #### cat command only if file does not already exist
     cat(download_command)
   }
@@ -1581,7 +1580,7 @@ download_sedac_groads <- function(
     "_curl_command.txt"
   )
   download_sink(commands_txt)
-  if (!check_file_size(download_url, download_name)) {
+  if (!file.exists(download_name)) {
     #### 12. concatenate and print download command to "..._curl_commands.txt"
     #### cat command if file does not already exist or is incomplete
     cat(download_command)
@@ -1773,7 +1772,7 @@ download_sedac_population <- function(
     "_curl_commands.txt"
   )
   download_sink(commands_txt)
-  if (!check_file_size(download_url, download_name)) {
+  if (!file.exists(download_name)) {
     #### 13. concatenate and print download command to "..._curl_commands.txt"
     #### cat command if file does not already exist or is incomplete
     cat(download_command)
@@ -1952,7 +1951,7 @@ download_hms <- function(
       url,
       "\n"
     )
-    if (!check_file_size(url, destfile)) {
+    if (!file.exists(destfile)) {
       #### cat command only if file does not already exist
       cat(command)
     }
@@ -2105,7 +2104,7 @@ download_koppen_geiger <- function(
     "_wget_command.txt"
   )
   download_sink(commands_txt)
-  if (!check_file_size(download_url, download_name)) {
+  if (!file.exists(download_name)) {
     #### 12. concatenate and print download command to "..._wget_commands.txt"
     #### cat command if file does not already exist or is incomplete
     cat(download_command)
@@ -2383,10 +2382,7 @@ download_modis <- function(
     #### filter commands to non-existing files
     download_command <- download_command[
       which(
-        !check_file_size(
-          download_url,
-          paste0(directory_to_save, download_name)
-        )
+        !file.exists(paste0(directory_to_save, download_name))
       )
     ]
 
@@ -2514,8 +2510,7 @@ download_modis <- function(
     #### filter commands to non-existing files
     download_command <- download_command[
       which(
-        !check_file_size(
-          download_url,
+        !file.exists(
           paste0(directory_to_save, download_name)
         )
       )
@@ -2568,9 +2563,6 @@ download_modis <- function(
 #' @returns NULL; Comma-separated value (CSV) files will be stored in
 #' \code{directory_to_save}.
 #' @importFrom Rdpack reprompt
-#' @importFrom purrr map_dbl
-#' @importFrom httr2 request
-#' @importFrom httr2 req_perform
 #' @references
 #' \insertRef{web_usepa2024tri}{amadeus}
 #' @examples
@@ -2615,17 +2607,10 @@ download_tri <- function(
                               " --output ",
                               download_names,
                               "\n")
-  # compare file sizes
-  file_sizes <- unlist(purrr::map_dbl(download_names, file.size))
-  url_filesize <- function(u) {
-    u_r <- httr2::request(u) |> httr2::req_perform()
-    return(as.numeric(length(u_r$body)))
-  }
-  url_sizes <- unlist(purrr::map_dbl(download_urls, url_filesize))
   #### filter commands to non-existing files
   download_commands <- download_commands[
     which(
-      !(file_sizes == url_sizes)
+      !file.exists(download_names)
     )
   ]
   #### 5. initiate "..._curl_commands.txt"
@@ -2764,7 +2749,7 @@ download_nei <- function(
   #### filter commands to non-existing files
   download_commands <- download_commands[
     which(
-      !check_file_size(download_urls, download_names)
+      !file.exists(download_names)
     )
   ]
   #### 5. initiate "..._curl_commands.txt"
@@ -3546,7 +3531,7 @@ download_gridmet <- function(
         url,
         "\n"
       )
-      if (!check_file_size(url, destfile)) {
+      if (!file.exists(destfile)) {
         #### cat command only if file does not already exist
         cat(command)
       }
@@ -3686,7 +3671,7 @@ download_terraclimate <- function(
         url,
         "\n"
       )
-      if (!check_file_size(url, destfile)) {
+      if (!file.exists(destfile)) {
         #### cat command only if file does not already exist
         cat(command)
       }

diff --git a/R/download_auxiliary.R b/R/download_auxiliary.R
@@ -350,56 +350,6 @@ check_url_status <- function(
   return(status %in% http_status_ok)
 }
 
-#' Compare file sizes
-#' @description
-#' Compare the size of a locally stored data file to the size of the to-be
-#' downloaded file, retrieved with `httr2`. This check helps to ensure that
-#' incomplete or corrupted data files are re-downloaded if the file path
-#' currently exists.
-#' @param url character(1). URL of data file to be downloaded.
-#' @param file character(1). Destination path of the data file to be
-#' downloaded.
-#' @author Mitchell Manware
-#' @importFrom httr2 req_perform
-#' @importFrom httr2 request
-#' @importFrom purrr map_dbl
-#' @return logical object
-#' @keywords auxiliary
-#' @export
-check_file_size <- function(
-  url,
-  file
-) {
-  stopifnot(is.character(url))
-  stopifnot(is.character(file))
-  # Helper function to get file size
-  file_size <- function(f) {
-    if (file.exists(f)) {
-      return(file.size(f))
-    } else {
-      return(NA)
-    }
-  }
-  # Helper function to get URL file size
-  url_size <- function(u) {
-    tryCatch({
-      u_req <- httr2::request(u) |> httr2::req_perform()
-      as.numeric(u_req$headers$`Content-Length`)
-    }, error = function(e) {
-      NA  # Return NA if there is an error (e.g., URL not reachable)
-    })
-  }
-  # Check local file sizes
-  file_sizes <- purrr::map_dbl(file, file_size)
-  # Check URL file sizes
-  url_sizes <- purrr::map_dbl(url, url_size)
-  # Compare file size to URL size
-  compare <- file_sizes == url_sizes
-  # Replace NA with false
-  compare[is.na(compare)] <- FALSE
-  return(compare)
-}
-
 #' Import download commands
 #' @description
 #' Read download commands from .txt file and convert to character vector.

diff --git a/man/check_file_size.Rd b/man/check_file_size.Rd
diff --git a/tests/testthat/test-calculate_covariates.R b/tests/testthat/test-calculate_covariates.R
@@ -1084,19 +1084,19 @@ testthat::test_that("calc_hms returns expected with missing polygons.", {
       )
       # expect 3 columns
       expect_true(
-        ncol(hms_covariate) == 3
+        ncol(hms_covariate) == 5
       )
       # expect 4 rows
       expect_true(
         nrow(hms_covariate) == 4
       )
       # expect integer for binary value
       expect_true(
-        class(hms_covariate[, 3]) == "integer"
+        unlist(unique(lapply(hms_covariate[, 3:5], class))) == "integer"
       )
       # expect binary
       expect_true(
-        all(unique(hms_covariate[, 3]) %in% c(0, 1))
+        all(unlist(lapply(hms_covariate[, 3:5], unique)) %in% c(0, 1))
       )
     }
   }