incomplete/corrupt file detection; temporary remove problematic calc_…

…lag tests
NIEHS · Jul 22, 2024 · 5b5be70 · 5b5be70
1 parent 72cc9e4
commit 5b5be70
Show file tree

Hide file tree

Showing 10 changed files with 164 additions and 135 deletions.
diff --git a/NAMESPACE b/NAMESPACE
@@ -28,6 +28,7 @@ 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)
@@ -155,9 +156,12 @@ 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/calculate_covariates.R b/R/calculate_covariates.R
@@ -1481,7 +1481,7 @@ calc_hms <- function(
   #### from == character indicates no wildfire smoke plumes are present
   #### return 0 for all locs and dates
   if (is.character(from)) {
-    cat(paste0(
+    message(paste0(
       "Inherited list of dates due to absent smoke plume polygons.\n"
     ))
     skip_extraction <- NULL
@@ -1511,7 +1511,7 @@ calc_hms <- function(
         skip_extraction_date
       )
     }
-    cat(paste0(
+    message(paste0(
       "Returning ",
       tolower(skip_variable),
       " smoke plume covariates.\n"
@@ -2035,7 +2035,7 @@ calc_sedac_population <- function(
     names(from),
     "_"
   )[[1]]
-  cat(
+  message(
     paste0(
       "Calculating population covariates for ",
       name_split[4],
@@ -2532,7 +2532,7 @@ calc_lagged <- function(
   stopifnot(!is.null(time_id))
   #### return from if lag == 0
   if (lag == 0) {
-    cat("`lag` set to 0. Returning `from`.\n")
+    message("`lag` set to 0. Returning `from`.\n")
     return(from)
   }
   #### extract times

diff --git a/R/calculate_covariates_auxiliary.R b/R/calculate_covariates_auxiliary.R
@@ -189,7 +189,7 @@ calc_message <- function(
       )
     }
   }
-  cat(return_message)
+  message(return_message)
 }
 
 #' Prepare extraction locations
@@ -483,7 +483,7 @@ calc_worker <- function(
     )
   }
   #### finish message
-  cat(
+  message(
     paste0(
       "Returning extracted covariates.\n"
     )

diff --git a/R/download.R b/R/download.R
@@ -208,7 +208,8 @@ download_aqs <-
     }
     #### 5. build download file name
     download_names <- sprintf(
-      paste(directory_to_download,
+      paste(
+        directory_to_download,
         "aqs_",
         resolution_temporal,
         "_",
@@ -229,7 +230,7 @@ download_aqs <-
     #### filter commands to non-existing files
     download_commands <- download_commands[
       which(
-        !file.exists(download_names)
+        !check_file_size(download_urls, download_names)
       )
     ]
     #### 7. initiate "..._curl_commands.txt"
@@ -385,11 +386,13 @@ 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 if file does not already exist
+    #### cat command only file does not already exist or
+    #### if size does not match URL size
     cat(download_command)
   }
   #### 11. finish "...curl_commands.txt" file
@@ -563,7 +566,7 @@ download_geos <- function(
           download_folder_name,
           "\n"
         )
-        if (!file.exists(download_folder_name)) {
+        if (!check_file_size(download_url, download_folder_name)) {
           #### cat command only if file does not already exist
           cat(download_command)
         }
@@ -715,7 +718,7 @@ download_gmted <- function(
   )
   download_sink(commands_txt)
   #### 13. concatenate and print download command to "..._curl_commands.txt"
-  if (!file.exists(download_name)) {
+  if (!check_file_size(download_url, download_name)) {
     #### cat command only if file does not already exist
     cat(download_command)
   }
@@ -1097,7 +1100,7 @@ download_merra2 <- function(
         download_name,
         "\n"
       )
-      if (!file.exists(download_name)) {
+      if (!check_file_size(download_url, download_name)) {
         #### cat command only if file does not already exist
         cat(download_command)
       }
@@ -1130,7 +1133,7 @@ download_merra2 <- function(
         download_name_metadata,
         "\n"
       )
-      if (!file.exists(download_name)) {
+      if (!file.exists(download_name_metadata)) {
         #### cat command only if file does not already exist
         cat(download_command_metadata)
       }
@@ -1269,8 +1272,9 @@ download_narr <- function(
           url,
           "\n"
         )
-        if (!file.exists(destfile)) {
-          #### cat command only if file does not already exist
+        if (!check_file_size(url = url, file = 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)
         }
       }
@@ -1424,7 +1428,7 @@ download_nlcd <- function(
   )
   download_sink(commands_txt)
   #### 12. concatenate and print download command to "..._curl_commands.txt"
-  if (!file.exists(download_name)) {
+  if (!check_file_size(download_url, download_name)) {
     #### cat command only if file does not already exist
     cat(download_command)
   }
@@ -1577,9 +1581,9 @@ download_sedac_groads <- function(
     "_curl_command.txt"
   )
   download_sink(commands_txt)
-  if (!file.exists(download_name)) {
+  if (!check_file_size(download_url, download_name)) {
     #### 12. concatenate and print download command to "..._curl_commands.txt"
-    #### cat command only if file does not already exist
+    #### cat command if file does not already exist or is incomplete
     cat(download_command)
   }
   #### 13. finish "..._curl_commands.txt" file
@@ -1689,7 +1693,7 @@ download_sedac_population <- function(
   #### 7. 30 second resolution not available for all years
   if (year == "totpop" && resolution == "30_sec") {
     resolution <- "2pt5_min"
-    cat(paste0(
+    message(paste0(
       "30 second resolution not available for all years. Returning",
       " highest (2.5 minute) resolution.\n"
     ))
@@ -1702,7 +1706,7 @@ download_sedac_population <- function(
       format <- "tif"
     } else {
       format <- "nc"
-      cat(paste0(
+      message(paste0(
         "Data for all years is only available in netCDF format. ",
         "Data will be downloaded as netCDF.\n"
       ))
@@ -1713,7 +1717,7 @@ download_sedac_population <- function(
       format <- "asc"
     } else {
       format <- "nc"
-      cat(paste0(
+      message(paste0(
         "Data for all years is only available in netCDF format. ",
         "Data will be downloaded as netCDF.\n"
       ))
@@ -1769,9 +1773,9 @@ download_sedac_population <- function(
     "_curl_commands.txt"
   )
   download_sink(commands_txt)
-  if (!file.exists(download_name)) {
+  if (!check_file_size(download_url, download_name)) {
     #### 13. concatenate and print download command to "..._curl_commands.txt"
-    #### cat command only if file does not already exist
+    #### cat command if file does not already exist or is incomplete
     cat(download_command)
   }
   #### 14. finish "..._curl_commands.txt" file
@@ -1948,7 +1952,7 @@ download_hms <- function(
       url,
       "\n"
     )
-    if (!file.exists(destfile)) {
+    if (!check_file_size(url, destfile)) {
       #### cat command only if file does not already exist
       cat(command)
     }
@@ -1974,7 +1978,7 @@ download_hms <- function(
   #### 13. end if data_format == "KML"
   if (data_format == "KML") {
     unlink(directory_to_download, recursive = TRUE)
-    cat(paste0("KML files cannot be unzipped.\n"))
+    message(paste0("KML files cannot be unzipped.\n"))
     return(TRUE)
   }
   #### 14. unzip downloaded zip files
@@ -2101,9 +2105,9 @@ download_koppen_geiger <- function(
     "_wget_command.txt"
   )
   download_sink(commands_txt)
-  if (!file.exists(download_name)) {
+  if (!check_file_size(download_url, download_name)) {
     #### 12. concatenate and print download command to "..._wget_commands.txt"
-    #### cat command only if file does not already exist
+    #### cat command if file does not already exist or is incomplete
     cat(download_command)
   }
   sink()
@@ -2379,7 +2383,10 @@ download_modis <- function(
     #### filter commands to non-existing files
     download_command <- download_command[
       which(
-        !file.exists(download_name)
+        !check_file_size(
+          download_url,
+          paste0(directory_to_save, download_name)
+        )
       )
     ]
 
@@ -2507,7 +2514,10 @@ download_modis <- function(
     #### filter commands to non-existing files
     download_command <- download_command[
       which(
-        !file.exists(download_name)
+        !check_file_size(
+          download_url,
+          paste0(directory_to_save, download_name)
+        )
       )
     ]
 
@@ -2605,7 +2615,7 @@ download_tri <- function(
   #### filter commands to non-existing files
   download_commands <- download_commands[
     which(
-      !file.exists(download_names)
+      !check_file_size(download_urls, download_names)
     )
   ]
   #### 5. initiate "..._curl_commands.txt"
@@ -2732,12 +2742,6 @@ download_nei <- function(
     c("2017neiApr_onroad_byregions.zip",
       "2020nei_onroad_byregion.zip")
   download_names <- paste0(directory_to_download, download_names_file)
-  #### filter commands to non-existing files
-  download_urls <- download_urls[
-    which(
-      !file.exists(download_names)
-    )
-  ]
   #### 4. build download command
   download_commands <-
     paste0("wget --ca-certificate=",
@@ -2747,7 +2751,12 @@ download_nei <- function(
            " -O ",
            download_names,
            "\n")
-
+  #### filter commands to non-existing files
+  download_commands <- download_commands[
+    which(
+      !check_file_size(download_urls, download_names)
+    )
+  ]
   #### 5. initiate "..._curl_commands.txt"
   commands_txt <- paste0(
     directory_original,
@@ -3527,7 +3536,7 @@ download_gridmet <- function(
         url,
         "\n"
       )
-      if (!file.exists(destfile)) {
+      if (!check_file_size(url, destfile)) {
         #### cat command only if file does not already exist
         cat(command)
       }
@@ -3667,7 +3676,7 @@ download_terraclimate <- function(
         url,
         "\n"
       )
-      if (!file.exists(destfile)) {
+      if (!check_file_size(url, destfile)) {
         #### cat command only if file does not already exist
         cat(command)
       }