From b4c24366cebefe6cca434c5173448353aee42139 Mon Sep 17 00:00:00 2001 From: Rob Marty Date: Fri, 19 Apr 2024 09:01:00 -0400 Subject: [PATCH] h5 dir --- R/blackmarbler.R | 53 ++++++++++++++++++++--------- readme_figures/figures_for_readme.R | 1 + readme_figures/readme_test_1.R | 17 +++++++++ readme_figures/testing.R | 5 ++- 4 files changed, 58 insertions(+), 18 deletions(-) create mode 100644 readme_figures/readme_test_1.R diff --git a/R/blackmarbler.R b/R/blackmarbler.R index af2bb99..f2e7329 100644 --- a/R/blackmarbler.R +++ b/R/blackmarbler.R @@ -435,6 +435,7 @@ download_raster <- function(file_name, variable, bearer, quality_flag_rm, + h5_dir, quiet){ year <- file_name %>% substring(10,13) @@ -445,28 +446,36 @@ download_raster <- function(file_name, product_id, '/', year, '/', day, '/', file_name) headers <- c('Authorization' = paste('Bearer', bearer)) - download_path <- file.path(temp_dir, file_name) - if(quiet == FALSE) message(paste0("Processing: ", file_name)) - - if(quiet == TRUE){ - response <- httr::GET(url, - add_headers(headers), - write_disk(download_path, overwrite = TRUE)) + if(is.null(h5_dir)){ + download_path <- file.path(temp_dir, file_name) } else{ - response <- httr::GET(url, - add_headers(headers), - write_disk(download_path, overwrite = TRUE), - progress()) + download_path <- file.path(h5_dir, file_name) } - - if(response$status_code != 200){ - message("Error in downloading data") - message(response) + if(!file.exists(download_path)){ + + if(quiet == FALSE) message(paste0("Processing: ", file_name)) + + if(quiet == TRUE){ + response <- httr::GET(url, + add_headers(headers), + write_disk(download_path, overwrite = TRUE)) + } else{ + response <- httr::GET(url, + add_headers(headers), + write_disk(download_path, overwrite = TRUE), + progress()) + } + + if(response$status_code != 200){ + message("Error in downloading data") + message(response) + } + } - r <- file_to_raster(file.path(temp_dir, file_name), + r <- file_to_raster(download_path, variable, quality_flag_rm) @@ -555,6 +564,7 @@ count_n_obs <- function(values, coverage_fraction) { #' @param file_dir (If `output_location_type = file`). The directory where data should be exported (default: `NULL`, so the working directory will be used) #' @param file_prefix (If `output_location_type = file`). Prefix to add to the file to be saved. The file will be saved as the following: `[file_prefix][product_id]_t[date].csv` #' @param file_skip_if_exists (If `output_location_type = file`). Whether the function should first check wither the file already exists, and to skip downloading or extracting data if the data for that date if the file already exists (default: `TRUE`). +#' @param h5_dir Black Marble data are originally downloaded as `h5` files. If `h5_dir = NULL`, the function downloads to a temporary directory then deletes the directory. If `h5_dir` is set to a path, `h5` files are saved to that directory and not deleted. The function will then check if the needed `h5` file already exists in the directory; if it exists, the function will not re-download the `h5` file. #' @param quiet Suppress output that show downloading progress and other messages. (Default: `FALSE`). #' #' @param ... Additional arguments for `raster::approxNA`, if `interpol_na = TRUE` @@ -604,6 +614,7 @@ bm_extract <- function(roi_sf, file_dir = NULL, file_prefix = NULL, file_skip_if_exists = TRUE, + h5_dir = NULL, quiet = FALSE, ...){ @@ -661,6 +672,7 @@ bm_extract <- function(roi_sf, quality_flag_rm = quality_flag_rm, check_all_tiles_exist = check_all_tiles_exist, interpol_na = F, + h5_dir = h5_dir, quiet = quiet, temp_dir = temp_dir) @@ -726,6 +738,7 @@ bm_extract <- function(roi_sf, variable = variable, quality_flag_rm = quality_flag_rm, check_all_tiles_exist = check_all_tiles_exist, + h5_dir = h5_dir, quiet = quiet, temp_dir = temp_dir) names(r) <- date_name_i @@ -778,6 +791,7 @@ bm_extract <- function(roi_sf, variable = variable, quality_flag_rm = quality_flag_rm, check_all_tiles_exist = check_all_tiles_exist, + h5_dir = h5_dir, quiet = quiet, temp_dir = temp_dir) names(r_out) <- date_name_i @@ -887,6 +901,7 @@ bm_extract <- function(roi_sf, #' @param file_dir The directory where data should be exported (default: `NULL`, so the working directory will be used) #' @param file_prefix Prefix to add to the file to be saved. The file will be saved as the following: `[file_prefix][product_id]_t[date].tif` #' @param file_skip_if_exists Whether the function should first check wither the file already exists, and to skip downloading or extracting data if the data for that date if the file already exists (default: `TRUE`). +#' @param h5_dir Black Marble data are originally downloaded as `h5` files. If `h5_dir = NULL`, the function downloads to a temporary directory then deletes the directory. If `h5_dir` is set to a path, `h5` files are saved to that directory and not deleted. The function will then check if the needed `h5` file already exists in the directory; if it exists, the function will not re-download the `h5` file. #' @param quiet Suppress output that show downloading progress and other messages. (Default: `FALSE`). #' @param ... Additional arguments for `raster::approxNA`, if `interpol_na = TRUE` #' @@ -947,6 +962,7 @@ bm_raster <- function(roi_sf, file_dir = NULL, file_prefix = NULL, file_skip_if_exists = TRUE, + h5_dir = NULL, quiet = FALSE, ...){ @@ -1024,6 +1040,7 @@ bm_raster <- function(roi_sf, variable = variable, quality_flag_rm = quality_flag_rm, check_all_tiles_exist = check_all_tiles_exist, + h5_dir = h5_dir, quiet = quiet, temp_dir = temp_dir) names(r) <- date_name_i @@ -1044,6 +1061,7 @@ bm_raster <- function(roi_sf, variable = variable, quality_flag_rm = quality_flag_rm, check_all_tiles_exist = check_all_tiles_exist, + h5_dir = h5_dir, quiet = quiet, temp_dir = temp_dir) names(r_out) <- date_name_i @@ -1104,6 +1122,7 @@ bm_raster_i <- function(roi_sf, variable, quality_flag_rm, check_all_tiles_exist, + h5_dir, quiet, temp_dir){ @@ -1181,7 +1200,7 @@ bm_raster_i <- function(roi_sf, } r_list <- lapply(bm_files_df$name, function(name_i){ - download_raster(name_i, temp_dir, variable, bearer, quality_flag_rm, quiet) + download_raster(name_i, temp_dir, variable, bearer, quality_flag_rm, h5_dir, quiet) }) if(length(r_list) == 1){ diff --git a/readme_figures/figures_for_readme.R b/readme_figures/figures_for_readme.R index 4bc216e..c77a3b9 100644 --- a/readme_figures/figures_for_readme.R +++ b/readme_figures/figures_for_readme.R @@ -13,6 +13,7 @@ if(F){ bearer <- read_csv("~/Desktop/bearer_bm.csv") %>% pull(token) + roi_sf <- read_sf("https://www.geoboundaries.org/api/current/gbOpen/GHA/ADM1/") roi_sf <- gadm(country = "GHA", level=1, path = tempdir()) %>% st_as_sf() product_id <- "VNP46A3" year <- 2018 diff --git a/readme_figures/readme_test_1.R b/readme_figures/readme_test_1.R new file mode 100644 index 0000000..3810970 --- /dev/null +++ b/readme_figures/readme_test_1.R @@ -0,0 +1,17 @@ + +#### Setup +# Load packages +library(blackmarbler) +library(geodata) +library(sf) +library(raster) +library(ggplot2) + +#### Define NASA bearer token +bearer <- "BEARER-TOKEN-HERE" + +### ROI +# Define region of interest (roi). The roi must be (1) an sf polygon and (2) +# in the WGS84 (epsg:4326) coordinate reference system. Here, we use the +# getData function to load a polygon of Ghana +roi_sf <- gadm(country = "GHA", level=1, path = tempdir()) |> st_as_sf() \ No newline at end of file diff --git a/readme_figures/testing.R b/readme_figures/testing.R index 2579cb3..7982f4b 100644 --- a/readme_figures/testing.R +++ b/readme_figures/testing.R @@ -37,8 +37,11 @@ quiet = FALSE r_202110 <- bm_raster(roi_sf = roi_sf, product_id = "VNP46A3", + variable = "NearNadir_Composite_Snow_Free", date = "2021-10-01", - bearer = bearer) + bearer = bearer, + h5_dir = "~/Desktop/h5_test", + quiet = T) e_202110 <- bm_raster(roi_sf = roi_sf, product_id = "VNP46A3",