diff --git a/DESCRIPTION b/DESCRIPTION index 6c7465b7..14dfcf45 100644 --- 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 index 5169a76a..0c610087 100644 --- 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 index 18d59a64..686d9d7b 100644 --- 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 index c17a1c96..3aaa1ce7 100644 --- 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 deleted file mode 100644 index 9bcd1f15..00000000 --- a/man/check_file_size.Rd +++ /dev/null @@ -1,27 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/download_auxiliary.R -\name{check_file_size} -\alias{check_file_size} -\title{Compare file sizes} -\usage{ -check_file_size(url, file) -} -\arguments{ -\item{url}{character(1). URL of data file to be downloaded.} - -\item{file}{character(1). Destination path of the data file to be -downloaded.} -} -\value{ -logical object -} -\description{ -Compare the size of a locally stored data file to the size of the to-be -downloaded file, retrieved with \code{httr2}. This check helps to ensure that -incomplete or corrupted data files are re-downloaded if the file path -currently exists. -} -\author{ -Mitchell Manware -} -\keyword{auxiliary} diff --git a/tests/testthat/test-calculate_covariates.R b/tests/testthat/test-calculate_covariates.R index 7e60612a..e9c5274c 100644 --- a/tests/testthat/test-calculate_covariates.R +++ b/tests/testthat/test-calculate_covariates.R @@ -1084,7 +1084,7 @@ 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( @@ -1092,11 +1092,11 @@ testthat::test_that("calc_hms returns expected with missing polygons.", { ) # 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)) ) } }